wip, txList updated

This commit is contained in:
voidlizard 2025-01-15 15:13:11 +03:00
parent 339a7dce1d
commit 712063c5f9
2 changed files with 21 additions and 9 deletions

View File

@ -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

View File

@ -55,15 +55,17 @@ refLogRef = do
callRpcWaitMay @RpcRefLogGet (TimeoutSec 1) refLogAPI reflog
>>= orThrow RefLogNotSetException
txListAll :: forall m . ( HBS2GitPerks m
txList :: forall m . ( HBS2GitPerks m
, HasStorage m
, HasClientAPI RefLogAPI UNIX m
, HasGitRemoteKey m
)
=> Maybe HashRef
=> ( 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)