@@ -20,7 +20,7 @@ import Control.Category ((>>>))
2020import Control.Concurrent.Class.MonadMVar
2121import Control.Concurrent.Class.MonadSTM.TSem
2222import Control.Exception (assert )
23- import Control.Monad (forever , guard , replicateM , unless , when )
23+ import Control.Monad (forever , guard , replicateM , unless , when , void )
2424import Control.Monad.Class.MonadAsync
2525import Control.Monad.Class.MonadFork
2626import Control.Monad.Class.MonadThrow
@@ -692,7 +692,10 @@ leiosNode tracer cfg followers peers = do
692692 let pruningThreads =
693693 concat
694694 [ [ pruneExpiredVotes tracer cfg leiosState
695- | CleanupExpiredVote `isEnabledIn` cfg. leios. cleanupPolicies
695+ | Linear /= cfg. leios. variant && CleanupExpiredVote `isEnabledIn` cfg. leios. cleanupPolicies
696+ ]
697+ , [ pruneExpiredLinearVotes tracer cfg leiosState
698+ | Linear == cfg. leios. variant && CleanupExpiredVote `isEnabledIn` cfg. leios. cleanupPolicies
696699 ]
697700 , [ pruneExpiredUncertifiedEBs tracer cfg leiosState
698701 | CleanupExpiredUncertifiedEb `isEnabledIn` cfg. leios. cleanupPolicies
@@ -879,6 +882,28 @@ pruneExpiredVotes _tracer LeiosNodeConfig{leios = leios@LeiosConfig{pipeline = _
879882 -- traceWith tracer $! LeiosNodeEvent Pruned (EventVote $ snd vt)
880883 go (succ p)
881884
885+ -- | Prune votes 30 seconds after the supported EB. TODO magic number
886+ pruneExpiredLinearVotes ::
887+ (Monad m , MonadDelay m , MonadTime m , MonadSTM m ) =>
888+ Tracer m LeiosNodeEvent ->
889+ LeiosNodeConfig ->
890+ LeiosNodeState m ->
891+ m ()
892+ pruneExpiredLinearVotes _tracer cfg st = go (SlotNo 0 )
893+ where
894+ go pruneTo = do
895+ _ <- waitNextSlot cfg. slotConfig (SlotNo $ unSlotNo pruneTo + 30 ) -- TODO magic number
896+ _votesPruned <- atomically $ do
897+ writeTVar st. prunedVoteStateToVar $! pruneTo
898+ partitionRBVar st. relayVoteState. relayBufferVar $
899+ \ voteEntry ->
900+ let voteSlot = (snd voteEntry. value). slot
901+ in voteSlot < pruneTo
902+ -- TODO: batch these, too many events.
903+ -- for_ votesPruned $ \vt -> do
904+ -- traceWith tracer $! LeiosNodeEvent Pruned (EventVote $ snd vt)
905+ go (succ pruneTo)
906+
882907referencedEBs :: MonadSTM m => LeiosConfig -> LeiosNodeState m -> Set EndorseBlockId -> STM m [EndorseBlockId ]
883908referencedEBs cfg st ebIds0
884909 | null ebIds0 = return []
@@ -1149,15 +1174,15 @@ dispatchValidationSTM tracer cfg leiosState req =
11491174 -- NOTE: block references are only inspected during voting.
11501175 return [valEB eb completion | eb <- ebs]
11511176 ValidateLinearEBs ibs completion -> do
1152- let ifNoCert :: InputBlockId -> STM m ( ) -> STM m ()
1177+ let ifNoCert :: InputBlockId -> ( Bool -> STM m a ) -> STM m ()
11531178 ifNoCert ibId k = do
11541179 votesForEB <- readTVar leiosState. votesForEBVar
1155- case Map. lookup (convertLinearId ibId) votesForEB of
1156- Just Certified {} -> pure ()
1157- _ -> k
1180+ void $ k $ case Map. lookup (convertLinearId ibId) votesForEB of
1181+ Just Certified {} -> True
1182+ _ -> False
11581183 waitFor
11591184 leiosState. waitingForTipVar
1160- [ (rbHash, [ifNoCert ib. id $ queue [valLinearEB ib False (const (pure () ))]])
1185+ [ (rbHash, [ifNoCert ib. id $ \ alreadyCertified -> queue [valLinearEB ib alreadyCertified (const (pure () ))]])
11611186 | ib <- ibs
11621187 , BlockHash rbHash <- [ib. header. rankingBlock]
11631188 ]
@@ -1365,7 +1390,11 @@ mkBuffersView cfg st = BuffersView{..}
13651390 -- TODO: start from votesForEB, would allow to drop EBs from relayBuffer as soon as Endorse ends.
13661391 $ bufferEB
13671392 }
1368- newIBData = do
1393+ newIBData
1394+ | Linear <- cfg. leios. variant = do
1395+ let txsPayload = cfg. leios. sizes. endorseBlockBodyAvgSize
1396+ return $ NewInputBlockData {referenceRankingBlock = GenesisHash {- dummy value, ignored -} , txsPayload}
1397+ | otherwise = do
13691398 ledgerState <- readTVar st. ledgerStateVar
13701399 referenceRankingBlock <-
13711400 Chain. headHash . Chain. dropUntil (flip Map. member ledgerState . blockHash)
0 commit comments