debug `readBundleRefs`

hbs2-core/lib/HBS2/Merkle/Walk.hs

@@ -22,6 +22,15 @@ import HBS2.Data.Types.Refs
 import HBS2.Hash
 import HBS2.Merkle
 
+walkMerkleDem
+    :: forall a m
+     . (Serialise (MTree a), Serialise (MTreeAnn a), Serialise a, Monad m)
+    => Hash HbSync
+    -> (Hash HbSync -> m (Maybe BSL.ByteString))
+    -> (Either WalkMerkleError a -> m ())
+    -> m ()
+walkMerkleDem h flookup sink = walkMerkleV2 flookup sink h
+
 walkMerkleV2
     :: forall a m
      . (Serialise (MTree a), Serialise (MTreeAnn a), Serialise a, Monad m)

hbs2-git/hbs2-git-client-lib/HBS2/Git/Data/Tx/Git.hs

@@ -20,6 +20,7 @@ import HBS2.Git.Data.GK
 import HBS2.Git.Data.RepoHead
 
 import HBS2.Git.Local
+import HBS2.Merkle.Walk
 
 
 import Data.Maybe
@@ -267,18 +268,12 @@ readBundleRefs :: (MonadIO m)
                -> m (Either [HashRef] [HashRef])
 
 readBundleRefs sto bunh = do
-  r <- S.toList_ $
-      walkMerkle @[HashRef] (fromHashRef bunh) (getBlock sto) $ \case
-        Left h -> S.yield (Left h)
-        Right ( bundles :: [HashRef] ) -> do
-          mapM_ (S.yield . Right) bundles
-
-  let missed = lefts r
-
-  if not (null missed) then do
-    pure (Left (fmap HashRef missed))
-  else do
-    pure (Right $ rights r)
+  (hs S.:> er) <- S.toList $ streamMerkle @HashRef (getBlock sto) (fromHashRef bunh)
+  case er of
+      Left wme -> case wme of
+          MerkleHashNotFound h -> pure (Left [HashRef h])
+          MerkleDeserialiseFailure h _ -> pure (Left [HashRef h])
+      Right () -> pure (Right hs)
 
 
 type GitPack = LBS.ByteString