@@ -16,19 +16,15 @@ import qualified Cardano.Db as DB
1616import Cardano.DbSync.Api
1717import Cardano.DbSync.Api.Ledger
1818import Cardano.DbSync.Api.Types (ConsistentLevel (.. ), InsertOptions (.. ), LedgerEnv (.. ), SyncEnv (.. ), SyncOptions (.. ))
19- import Cardano.DbSync.Cache.Types (textShowStats )
2019import Cardano.DbSync.Epoch (epochHandler )
2120import Cardano.DbSync.Era.Byron.Insert (insertByronBlock )
22- import Cardano.DbSync.Era.Cardano.Insert (insertEpochSyncTime )
23- import Cardano.DbSync.Era.Shelley.Adjust (adjustEpochRewards )
2421import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
25- import Cardano.DbSync.Era.Shelley.Insert ( insertShelleyBlock )
26- import Cardano.DbSync.Era.Shelley.Insert.Certificate ( mkAdaPots )
27- import Cardano.DbSync.Era.Shelley .Insert.Epoch ( insertInstantRewards , insertPoolDepositRefunds , insertRewards )
28- import Cardano.DbSync.Era.Shelley.Validate ( validateEpochRewards )
22+ import Cardano.DbSync.Era.Universal.Block ( insertBlockUniversal )
23+ import Cardano.DbSync.Era.Universal.Epoch ( hasEpochStartEvent , hasNewEpochEvent )
24+ import Cardano.DbSync.Era.Universal .Insert.Certificate ( mkAdaPots )
25+ import Cardano.DbSync.Era.Universal.Insert.LedgerEvent ( insertBlockLedgerEvents )
2926import Cardano.DbSync.Error
3027import Cardano.DbSync.Fix.EpochStake
31- import Cardano.DbSync.Ledger.Event (LedgerEvent (.. ))
3228import Cardano.DbSync.Ledger.State (applyBlockAndSnapshot , defaultApplyResult )
3329import Cardano.DbSync.Ledger.Types (ApplyResult (.. ))
3430import Cardano.DbSync.LocalStateQuery
@@ -38,17 +34,15 @@ import Cardano.DbSync.Util
3834import Cardano.DbSync.Util.Constraint (addConstraintsIfNotExist )
3935import qualified Cardano.Ledger.Alonzo.Scripts as Ledger
4036import Cardano.Ledger.Shelley.AdaPots as Shelley
37+ import Cardano.Node.Configuration.Logging (Trace )
4138import Cardano.Prelude
4239import Cardano.Slotting.Slot (EpochNo (.. ), SlotNo )
4340import Control.Monad.Logger (LoggingT )
44- import Control.Monad.Trans.Control (MonadBaseControl )
4541import Control.Monad.Trans.Except.Extra (newExceptT )
4642import qualified Data.ByteString.Short as SBS
47- import qualified Data.Map.Strict as Map
4843import qualified Data.Set as Set
4944import qualified Data.Strict.Maybe as Strict
5045import Database.Persist.SqlBackend.Internal
51- import Database.Persist.SqlBackend.Internal.StatementCache
5246import Ouroboros.Consensus.Cardano.Block (HardForkBlock (.. ))
5347import qualified Ouroboros.Consensus.HardFork.Combinator as Consensus
5448import Ouroboros.Network.Block (blockHash , blockNo , getHeaderFields , headerFieldBlockNo , unBlockNo )
@@ -60,15 +54,16 @@ insertListBlocks ::
6054insertListBlocks synEnv blocks = do
6155 DB. runDbIohkLogging (envBackend synEnv) tracer
6256 . runExceptT
63- $ traverse_ (applyAndInsertBlockMaybe synEnv) blocks
57+ $ traverse_ (applyAndInsertBlockMaybe synEnv tracer ) blocks
6458 where
6559 tracer = getTrace synEnv
6660
6761applyAndInsertBlockMaybe ::
6862 SyncEnv ->
63+ Trace IO Text ->
6964 CardanoBlock ->
7065 ExceptT SyncNodeError (ReaderT SqlBackend (LoggingT IO )) ()
71- applyAndInsertBlockMaybe syncEnv cblk = do
66+ applyAndInsertBlockMaybe syncEnv tracer cblk = do
7267 bl <- liftIO $ isConsistent syncEnv
7368 (! applyRes, ! tookSnapshot) <- liftIO (mkApplyResult bl)
7469 if bl
@@ -101,8 +96,6 @@ applyAndInsertBlockMaybe syncEnv cblk = do
10196 liftIO $ logInfo tracer $ " Reached " <> textShow epochNo
10297 _ -> pure ()
10398 where
104- tracer = getTrace syncEnv
105-
10699 mkApplyResult :: Bool -> IO (ApplyResult , Bool )
107100 mkApplyResult isCons = do
108101 case envLedgerEnv syncEnv of
@@ -136,12 +129,12 @@ insertBlock syncEnv cblk applyRes firstAfterRollback tookSnapshot = do
136129 let ! details = apSlotDetails applyResult
137130 let ! withinTwoMin = isWithinTwoMin details
138131 let ! withinHalfHour = isWithinHalfHour details
139- insertLedgerEvents syncEnv (sdEpochNo details) (apEvents applyResult)
132+ insertBlockLedgerEvents syncEnv (sdEpochNo details) (apEvents applyResult)
140133 let isNewEpochEvent = hasNewEpochEvent (apEvents applyResult)
141134 let isStartEventOrRollback = hasEpochStartEvent (apEvents applyResult) || firstAfterRollback
142135 let isMember poolId = Set. member poolId (apPoolsRegistered applyResult)
143- let insertShelley blk =
144- insertShelleyBlock
136+ let insertBlockUniversal' blk =
137+ insertBlockUniversal
145138 syncEnv
146139 isStartEventOrRollback
147140 withinTwoMin
@@ -159,27 +152,27 @@ insertBlock syncEnv cblk applyRes firstAfterRollback tookSnapshot = do
159152 insertByronBlock syncEnv isStartEventOrRollback blk details
160153 BlockShelley blk ->
161154 newExceptT $
162- insertShelley $
155+ insertBlockUniversal' $
163156 Generic. fromShelleyBlock blk
164157 BlockAllegra blk ->
165158 newExceptT $
166- insertShelley $
159+ insertBlockUniversal' $
167160 Generic. fromAllegraBlock blk
168161 BlockMary blk ->
169162 newExceptT $
170- insertShelley $
163+ insertBlockUniversal' $
171164 Generic. fromMaryBlock blk
172165 BlockAlonzo blk ->
173166 newExceptT $
174- insertShelley $
167+ insertBlockUniversal' $
175168 Generic. fromAlonzoBlock (ioPlutusExtra iopts) (getPrices applyResult) blk
176169 BlockBabbage blk ->
177170 newExceptT $
178- insertShelley $
171+ insertBlockUniversal' $
179172 Generic. fromBabbageBlock (ioPlutusExtra iopts) (getPrices applyResult) blk
180173 BlockConway blk ->
181174 newExceptT $
182- insertShelley $
175+ insertBlockUniversal' $
183176 Generic. fromConwayBlock (ioPlutusExtra iopts) (getPrices applyResult) blk
184177 -- update the epoch
185178 updateEpoch details isNewEpochEvent
@@ -232,90 +225,3 @@ insertBlock syncEnv cblk applyRes firstAfterRollback tookSnapshot = do
232225 isWithinHalfHour sd = isSyncedWithinSeconds sd 1800 == SyncFollowing
233226
234227 blkNo = headerFieldBlockNo $ getHeaderFields cblk
235-
236- -- -------------------------------------------------------------------------------------------------
237-
238- insertLedgerEvents ::
239- (MonadBaseControl IO m , MonadIO m ) =>
240- SyncEnv ->
241- EpochNo ->
242- [LedgerEvent ] ->
243- ExceptT SyncNodeError (ReaderT SqlBackend m ) ()
244- insertLedgerEvents syncEnv currentEpochNo@ (EpochNo curEpoch) =
245- mapM_ handler
246- where
247- tracer = getTrace syncEnv
248- cache = envCache syncEnv
249- ntw = getNetwork syncEnv
250-
251- subFromCurrentEpoch :: Word64 -> EpochNo
252- subFromCurrentEpoch m =
253- if unEpochNo currentEpochNo >= m
254- then EpochNo $ unEpochNo currentEpochNo - m
255- else EpochNo 0
256-
257- toSyncState :: SyncState -> DB. SyncState
258- toSyncState SyncLagging = DB. SyncLagging
259- toSyncState SyncFollowing = DB. SyncFollowing
260-
261- handler ::
262- (MonadBaseControl IO m , MonadIO m ) =>
263- LedgerEvent ->
264- ExceptT SyncNodeError (ReaderT SqlBackend m ) ()
265- handler ev =
266- case ev of
267- LedgerNewEpoch en ss -> do
268- lift $
269- insertEpochSyncTime en (toSyncState ss) (envEpochSyncTime syncEnv)
270- sqlBackend <- lift ask
271- persistantCacheSize <- liftIO $ statementCacheSize $ connStmtMap sqlBackend
272- liftIO . logInfo tracer $ " Persistant SQL Statement Cache size is " <> textShow persistantCacheSize
273- stats <- liftIO $ textShowStats cache
274- liftIO . logInfo tracer $ stats
275- liftIO . logInfo tracer $ " Starting epoch " <> textShow (unEpochNo en)
276- LedgerStartAtEpoch en ->
277- -- This is different from the previous case in that the db-sync started
278- -- in this epoch, for example after a restart, instead of after an epoch boundary.
279- liftIO . logInfo tracer $ " Starting at epoch " <> textShow (unEpochNo en)
280- LedgerDeltaRewards _e rwd -> do
281- let rewards = Map. toList $ Generic. unRewards rwd
282- insertRewards syncEnv ntw (subFromCurrentEpoch 2 ) currentEpochNo cache (Map. toList $ Generic. unRewards rwd)
283- -- This event is only created when it's not empty, so we don't need to check for null here.
284- liftIO . logInfo tracer $ " Inserted " <> show (length rewards) <> " Delta rewards"
285- LedgerIncrementalRewards _ rwd -> do
286- let rewards = Map. toList $ Generic. unRewards rwd
287- insertRewards syncEnv ntw (subFromCurrentEpoch 1 ) (EpochNo $ curEpoch + 1 ) cache rewards
288- LedgerRestrainedRewards e rwd creds ->
289- lift $ adjustEpochRewards tracer ntw cache e rwd creds
290- LedgerTotalRewards _e rwd ->
291- lift $ validateEpochRewards tracer ntw (subFromCurrentEpoch 2 ) currentEpochNo rwd
292- LedgerAdaPots _ ->
293- pure () -- These are handled separately by insertBlock
294- LedgerMirDist rwd -> do
295- unless (Map. null rwd) $ do
296- let rewards = Map. toList rwd
297- insertInstantRewards ntw (subFromCurrentEpoch 1 ) currentEpochNo cache rewards
298- liftIO . logInfo tracer $ " Inserted " <> show (length rewards) <> " Mir rewards"
299- LedgerPoolReap en drs ->
300- unless (Map. null $ Generic. unRewards drs) $ do
301- insertPoolDepositRefunds syncEnv en drs
302- LedgerDeposits {} -> pure ()
303-
304- hasEpochStartEvent :: [LedgerEvent ] -> Bool
305- hasEpochStartEvent = any isNewEpoch
306- where
307- isNewEpoch :: LedgerEvent -> Bool
308- isNewEpoch le =
309- case le of
310- LedgerNewEpoch {} -> True
311- LedgerStartAtEpoch {} -> True
312- _otherwise -> False
313-
314- hasNewEpochEvent :: [LedgerEvent ] -> Bool
315- hasNewEpochEvent = any isNewEpoch
316- where
317- isNewEpoch :: LedgerEvent -> Bool
318- isNewEpoch le =
319- case le of
320- LedgerNewEpoch {} -> True
321- _otherwise -> False
0 commit comments