diff --git a/hbs2-git3/app/Main.hs b/hbs2-git3/app/Main.hs index 4ecdb24e..9f89b089 100644 --- a/hbs2-git3/app/Main.hs +++ b/hbs2-git3/app/Main.hs @@ -962,7 +962,7 @@ theDict = do rv <- refLogRef - hxs <- txListAll rv <&> filter (not . flip HS.member excl . fst) + hxs <- txList ( pure . not . flip HS.member excl ) rv forConcurrently_ hxs $ \case (_, TxCheckpoint{}) -> none diff --git a/hbs2-git3/lib/HBS2/Git3/State/RefLog.hs b/hbs2-git3/lib/HBS2/Git3/State/RefLog.hs index 5009c350..c8b468bf 100644 --- a/hbs2-git3/lib/HBS2/Git3/State/RefLog.hs +++ b/hbs2-git3/lib/HBS2/Git3/State/RefLog.hs @@ -55,15 +55,17 @@ refLogRef = do callRpcWaitMay @RpcRefLogGet (TimeoutSec 1) refLogAPI reflog >>= orThrow RefLogNotSetException -txListAll :: forall m . ( HBS2GitPerks m - , HasStorage m - , HasClientAPI RefLogAPI UNIX m - , HasGitRemoteKey m - ) - => Maybe HashRef +txList :: forall m . ( HBS2GitPerks m + , HasStorage m + , HasClientAPI RefLogAPI UNIX m + , HasGitRemoteKey m + ) + => ( HashRef -> m Bool ) + -> Maybe HashRef -> m [(HashRef, GitTx)] -txListAll mhref = do +txList filt mhref = do + sto <- getStorage fromMaybe mempty <$> runMaybeT do @@ -74,9 +76,19 @@ txListAll mhref = do hxs <- S.toList_ $ walkMerkle @[HashRef] (coerce rv) (getBlock sto) $ \case Left{} -> throwIO MissedBlockError - Right hs -> S.each hs + Right hs -> filterM (lift . lift . filt) hs >>= S.each S.toList_ $ for_ hxs $ \h -> do tx <- liftIO (readTxMay sto h) maybe none (S.yield . (h,)) tx +txListAll :: forall m . ( HBS2GitPerks m + , HasStorage m + , HasClientAPI RefLogAPI UNIX m + , HasGitRemoteKey m + ) + => Maybe HashRef + -> m [(HashRef, GitTx)] + +txListAll = txList (const $ pure True) +