Skip to content

Commit

Permalink
REBASEME: Add a trimLedgerState stub
Browse files Browse the repository at this point in the history
  • Loading branch information
sgillespie committed Aug 16, 2024
1 parent f8c76d8 commit c23a014
Showing 1 changed file with 12 additions and 1 deletion.
13 changes: 12 additions & 1 deletion cardano-db-sync/src/Cardano/DbSync/Ledger/State.hs
Original file line number Diff line number Diff line change
Expand Up @@ -35,6 +35,7 @@ module Cardano.DbSync.Ledger.State (
getStakeSlice,
getSliceMeta,
findProposedCommittee,
trimLedgerState,
) where

import Cardano.BM.Trace (Trace, logInfo, logWarning)
Expand Down Expand Up @@ -89,6 +90,7 @@ import qualified Data.Set as Set
import qualified Data.Strict.Maybe as Strict
import qualified Data.Text as Text
import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime)
import GHC.Conc (unsafeIOToSTM)
import GHC.IO.Exception (userError)
import Lens.Micro ((%~), (^.), (^?))
import Ouroboros.Consensus.Block (
Expand Down Expand Up @@ -132,7 +134,7 @@ import qualified Ouroboros.Network.Point as Point
import System.Directory (doesFileExist, listDirectory, removeFile)
import System.FilePath (dropExtension, takeExtension, (</>))
import System.Mem (performMajorGC)
import Prelude (String, id)
import Prelude (String, id, undefined)

-- Note: The decision on whether a ledger-state is written to disk is based on the block number
-- rather than the slot number because while the block number is fully populated (for every block
Expand Down Expand Up @@ -217,6 +219,7 @@ readStateUnsafe env = do
applyBlockAndSnapshot :: HasLedgerEnv -> CardanoBlock -> Bool -> IO (ApplyResult, Bool)
applyBlockAndSnapshot ledgerEnv blk isCons = do
(oldState, appResult) <- applyBlock ledgerEnv blk

tookSnapshot <- storeSnapshotAndCleanupMaybe ledgerEnv oldState appResult (blockNo blk) isCons (isSyncedWithinSeconds (apSlotDetails appResult) 600)
pure (appResult, tookSnapshot)

Expand All @@ -233,10 +236,12 @@ applyBlock env blk = do
let ledgerEventsFull = mapMaybe (convertAuxLedgerEvent (leHasRewards env)) (lrEvents result)
let (ledgerEvents, deposits) = splitDeposits ledgerEventsFull
let !newLedgerState = finaliseDrepDistr (lrResult result)

!details <- getSlotDetails env (ledgerState newLedgerState) time (cardanoBlockSlotNo blk)
!newEpoch <- fromEitherSTM $ mkOnNewEpoch (clsState oldState) newLedgerState (findAdaPots ledgerEvents)
let !newEpochBlockNo = applyToEpochBlockNo (isJust $ blockIsEBB blk) (isJust newEpoch) (clsEpochBlockNo oldState)
let !newState = CardanoLedgerState newLedgerState newEpochBlockNo
let !newState' = maybe newState (trimOnNewEpoch newState) newEpoch
let !ledgerDB' = pushLedgerDB ledgerDB newState
writeTVar (leStateVar env) (Strict.Just ledgerDB')
let !appResult =
Expand Down Expand Up @@ -299,6 +304,9 @@ applyBlock env blk = do
finaliseDrepDistr ledger =
ledger & newEpochStateT %~ forceDRepPulsingState @StandardConway

trimOnNewEpoch :: CardanoLedgerState -> Generic.NewEpoch -> CardanoLedgerState
trimOnNewEpoch ls !_ = trimLedgerState ls

getGovState :: ExtLedgerState CardanoBlock -> Maybe (ConwayGovState StandardConway)
getGovState ls = case ledgerState ls of
LedgerStateConway cls ->
Expand Down Expand Up @@ -889,3 +897,6 @@ findProposedCommittee gaId cgs = do
UpdateCommittee _ toRemove toAdd q -> Right $ Ledger.SJust $ updatedCommittee toRemove toAdd q scommittee
_ -> Left "Unexpected gov action." -- Should never happen since the accumulator only includes UpdateCommittee
fromNothing err = maybe (Left err) Right

trimLedgerState :: CardanoLedgerState -> CardanoLedgerState
trimLedgerState = undefined

0 comments on commit c23a014

Please sign in to comment.