diff --git a/hbs2-core/lib/HBS2/Merkle/Walk.hs b/hbs2-core/lib/HBS2/Merkle/Walk.hs index 56df50fb..fd566066 100644 --- a/hbs2-core/lib/HBS2/Merkle/Walk.hs +++ b/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) diff --git a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Data/Tx/Git.hs b/hbs2-git/hbs2-git-client-lib/HBS2/Git/Data/Tx/Git.hs index 03968aab..5a1206eb 100644 --- a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Data/Tx/Git.hs +++ b/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