@@ -35,6 +35,7 @@ module Cardano.DbSync.Ledger.State (
35
35
getStakeSlice ,
36
36
getSliceMeta ,
37
37
findProposedCommittee ,
38
+ trimLedgerState ,
38
39
) where
39
40
40
41
import Cardano.BM.Trace (Trace , logInfo , logWarning )
@@ -89,6 +90,7 @@ import qualified Data.Set as Set
89
90
import qualified Data.Strict.Maybe as Strict
90
91
import qualified Data.Text as Text
91
92
import Data.Time.Clock (UTCTime , diffUTCTime , getCurrentTime )
93
+ import GHC.Conc (unsafeIOToSTM )
92
94
import GHC.IO.Exception (userError )
93
95
import Lens.Micro ((%~) , (^.) , (^?) )
94
96
import Ouroboros.Consensus.Block (
@@ -132,7 +134,7 @@ import qualified Ouroboros.Network.Point as Point
132
134
import System.Directory (doesFileExist , listDirectory , removeFile )
133
135
import System.FilePath (dropExtension , takeExtension , (</>) )
134
136
import System.Mem (performMajorGC )
135
- import Prelude (String , id )
137
+ import Prelude (String , id , undefined )
136
138
137
139
-- Note: The decision on whether a ledger-state is written to disk is based on the block number
138
140
-- rather than the slot number because while the block number is fully populated (for every block
@@ -217,6 +219,7 @@ readStateUnsafe env = do
217
219
applyBlockAndSnapshot :: HasLedgerEnv -> CardanoBlock -> Bool -> IO (ApplyResult , Bool )
218
220
applyBlockAndSnapshot ledgerEnv blk isCons = do
219
221
(oldState, appResult) <- applyBlock ledgerEnv blk
222
+
220
223
tookSnapshot <- storeSnapshotAndCleanupMaybe ledgerEnv oldState appResult (blockNo blk) isCons (isSyncedWithinSeconds (apSlotDetails appResult) 600 )
221
224
pure (appResult, tookSnapshot)
222
225
@@ -233,10 +236,12 @@ applyBlock env blk = do
233
236
let ledgerEventsFull = mapMaybe (convertAuxLedgerEvent (leHasRewards env)) (lrEvents result)
234
237
let (ledgerEvents, deposits) = splitDeposits ledgerEventsFull
235
238
let ! newLedgerState = finaliseDrepDistr (lrResult result)
239
+
236
240
! details <- getSlotDetails env (ledgerState newLedgerState) time (cardanoBlockSlotNo blk)
237
241
! newEpoch <- fromEitherSTM $ mkOnNewEpoch (clsState oldState) newLedgerState (findAdaPots ledgerEvents)
238
242
let ! newEpochBlockNo = applyToEpochBlockNo (isJust $ blockIsEBB blk) (isJust newEpoch) (clsEpochBlockNo oldState)
239
243
let ! newState = CardanoLedgerState newLedgerState newEpochBlockNo
244
+ let ! newState' = maybe newState (trimOnNewEpoch newState) newEpoch
240
245
let ! ledgerDB' = pushLedgerDB ledgerDB newState
241
246
writeTVar (leStateVar env) (Strict. Just ledgerDB')
242
247
let ! appResult =
@@ -299,6 +304,9 @@ applyBlock env blk = do
299
304
finaliseDrepDistr ledger =
300
305
ledger & newEpochStateT %~ forceDRepPulsingState @ StandardConway
301
306
307
+ trimOnNewEpoch :: CardanoLedgerState -> Generic. NewEpoch -> CardanoLedgerState
308
+ trimOnNewEpoch ls ! _ = trimLedgerState ls
309
+
302
310
getGovState :: ExtLedgerState CardanoBlock -> Maybe (ConwayGovState StandardConway )
303
311
getGovState ls = case ledgerState ls of
304
312
LedgerStateConway cls ->
@@ -889,3 +897,6 @@ findProposedCommittee gaId cgs = do
889
897
UpdateCommittee _ toRemove toAdd q -> Right $ Ledger. SJust $ updatedCommittee toRemove toAdd q scommittee
890
898
_ -> Left " Unexpected gov action." -- Should never happen since the accumulator only includes UpdateCommittee
891
899
fromNothing err = maybe (Left err) Right
900
+
901
+ trimLedgerState :: CardanoLedgerState -> CardanoLedgerState
902
+ trimLedgerState = undefined
0 commit comments