Arboricx bundle format 1.1

We don't need SHA verification or Merkle dags in our transport bundle. Content
stores can handle both bundle and term verification and hashing.

src/Server.hs

@@ -4,9 +4,9 @@ module Server
   ) where
 
 import ContentStore (initContentStore, initContentStoreWithPath, nameToTerm, hashToTerm, listStoredTerms,
-                     parseNameList, StoredTerm(..), termHash)
+                     parseNameList, StoredTerm(..), termHash, loadTree)
 import Database.SQLite.Simple (Connection, close)
-import Wire (exportNamedBundle)
+import Wire (buildBundle, encodeBundle)
 
 import Control.Monad (when, void)
 import Data.Maybe (catMaybes)
@@ -19,6 +19,7 @@ import Data.String (fromString)
 import Data.Text (Text)
 import Data.Text.Encoding (encodeUtf8, decodeUtf8)
 import Data.Char (isHexDigit, toLower)
+import Data.ByteString (ByteString)
 import Data.ByteString.Char8 (unpack)
 import Data.ByteString.Lazy (fromStrict)
 import qualified Data.Text as T
@@ -103,7 +104,7 @@ rootsHandler mkConn request respond = do
     close conn
     void $ respond resp
   -- Build and return the bundle
-  bundleData <- exportNamedBundle conn allNamedHashes
+  bundleData <- buildAndEncodeBundle conn allNamedHashes
   let firstHash = snd (head allNamedHashes)
       cd = T.pack "attachment; filename=roots.bundle"
   close conn
@@ -123,7 +124,7 @@ nameHandler mkConn nameText = do
     Just term' -> do
       let th = termHash term'
           namedHashes = [(firstOrRoot (termNames term'), th)]
-      bundleData <- exportNamedBundle conn namedHashes
+      bundleData <- buildAndEncodeBundle conn namedHashes
       let cd = T.pack $ "attachment; filename=" ++ safeFileName (T.unpack nameText) ++ ".bundle"
       close conn
       return $ responseLBS status200 (bundleHeaders th cd) (fromStrict bundleData)
@@ -144,12 +145,24 @@ hashHandler mkConn hashText =
             Just term' -> do
               let th = termHash term'
                   namedHashes' = [(firstOrRoot (termNames term'), th)]
-              bundleData <- exportNamedBundle conn namedHashes'
+              bundleData <- buildAndEncodeBundle conn namedHashes'
               close conn
               return $ responseLBS status200
                 (bundleHeaders th "attachment; filename=hash.bundle")
                 (fromStrict bundleData)
 
+-- | Helper: load terms by hash and build an indexed bundle.
+buildAndEncodeBundle :: Connection -> [(Text, Text)] -> IO ByteString
+buildAndEncodeBundle conn namedHashes = do
+  terms <- mapM (\(_, h) -> do
+    maybeTree <- loadTree conn h
+    case maybeTree of
+      Nothing -> error $ "Server: hash not found in store: " ++ T.unpack h
+      Just tree -> return tree) namedHashes
+  let namedTerms = zip (map fst namedHashes) terms
+      bundle = buildBundle namedTerms
+  return $ encodeBundle bundle
+
 -- | GET /terms
 termsResponse :: IO Connection -> IO Response
 termsResponse mkConn = do