tricu

An interpreted language for exploring Tree Calculus
Log | Files | Refs | README | LICENSE

Bundle.hs (1472B)

      1 module ContentStore.Bundle
      2   ( packBundleFromStore
      3   , unpackBundleToStore
      4   ) where
      5 
      6 import ContentStore.Arboricx
      7 import ContentStore.Object
      8 import Wire
      9 
     10 import Control.Monad (forM)
     11 import Data.ByteString (ByteString)
     12 import Data.Text (Text)
     13 import qualified Data.Vector as V
     14 
     15 -- | Pack named CAS tree terms into an indexed Arboricx transport bundle.
     16 packBundleFromStore :: StorePath -> [(Text, ObjectHash)] -> IO Bundle
     17 packBundleFromStore store exports = do
     18   terms <- forM exports $ \(name, root) -> do
     19     mt <- getTreeTerm store root
     20     case mt of
     21       Nothing -> fail $ "CAS tree term not found: " ++ show root
     22       Just term -> return (name, term)
     23   return (buildBundle terms)
     24 
     25 -- | Unpack an indexed Arboricx transport bundle into CAS tree terms.
     26 -- Returns each manifest export name paired with its stored CAS tree-term hash.
     27 unpackBundleToStore :: StorePath -> ByteString -> IO [(Text, ObjectHash)]
     28 unpackBundleToStore store bs = case decodeBundle bs of
     29   Left err -> fail $ "ContentStore.Bundle.unpackBundleToStore decode: " ++ err
     30   Right bundle -> case verifyBundle bundle of
     31     Left err -> fail $ "ContentStore.Bundle.unpackBundleToStore verify: " ++ err
     32     Right () -> do
     33       let terms = reconstructBundleTerms (bundleNodes bundle)
     34       forM (manifestExports $ bundleManifest bundle) $ \exported -> do
     35         let term = terms V.! fromIntegral (exportRoot exported)
     36         root <- putTreeTerm store term
     37         return (exportName exported, root)