Skip to content

Commit 77cd794

Browse files
CmdvCmdv
authored
Merge pull request #1635 from IntersectMBO/cmdv-refactor-shelley-insert
Refactor Shelley/Insert.hs to "Universal" used by multiple eras
2 parents 15656e4 + 68dbf7b commit 77cd794

File tree

19 files changed

+2693
-2016
lines changed

19 files changed

+2693
-2016
lines changed

‎cardano-db-sync/cardano-db-sync.cabal‎

Lines changed: 14 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -63,17 +63,16 @@ library
6363
Cardano.DbSync.Era.Byron.Util
6464
Cardano.DbSync.Era.Cardano.Insert
6565
Cardano.DbSync.Era.Cardano.Util
66-
Cardano.DbSync.Era.Shelley.Adjust
6766
Cardano.DbSync.Era.Shelley.Generic
6867
Cardano.DbSync.Era.Shelley.Generic.Block
6968
Cardano.DbSync.Era.Shelley.Generic.EpochUpdate
69+
Cardano.DbSync.Era.Shelley.Generic.Metadata
70+
Cardano.DbSync.Era.Shelley.Generic.ParamProposal
7071
Cardano.DbSync.Era.Shelley.Generic.ProtoParams
7172
Cardano.DbSync.Era.Shelley.Generic.Rewards
7273
Cardano.DbSync.Era.Shelley.Generic.Script
7374
Cardano.DbSync.Era.Shelley.Generic.ScriptData
7475
Cardano.DbSync.Era.Shelley.Generic.StakeDist
75-
Cardano.DbSync.Era.Shelley.Generic.Metadata
76-
Cardano.DbSync.Era.Shelley.Generic.ParamProposal
7776
Cardano.DbSync.Era.Shelley.Generic.Tx
7877
Cardano.DbSync.Era.Shelley.Generic.Tx.Allegra
7978
Cardano.DbSync.Era.Shelley.Generic.Tx.Alonzo
@@ -85,11 +84,19 @@ library
8584
Cardano.DbSync.Era.Shelley.Generic.Util
8685
Cardano.DbSync.Era.Shelley.Generic.Witness
8786
Cardano.DbSync.Era.Shelley.Genesis
88-
Cardano.DbSync.Era.Shelley.Insert
89-
Cardano.DbSync.Era.Shelley.Insert.Epoch
90-
Cardano.DbSync.Era.Shelley.Insert.Grouped
9187
Cardano.DbSync.Era.Shelley.Query
92-
Cardano.DbSync.Era.Shelley.Validate
88+
Cardano.DbSync.Era.Universal.Adjust
89+
Cardano.DbSync.Era.Universal.Block
90+
Cardano.DbSync.Era.Universal.Epoch
91+
Cardano.DbSync.Era.Universal.Validate
92+
Cardano.DbSync.Era.Universal.Insert.Certificate
93+
Cardano.DbSync.Era.Universal.Insert.GovAction
94+
Cardano.DbSync.Era.Universal.Insert.Grouped
95+
Cardano.DbSync.Era.Universal.Insert.LedgerEvent
96+
Cardano.DbSync.Era.Universal.Insert.Other
97+
Cardano.DbSync.Era.Universal.Insert.Pool
98+
Cardano.DbSync.Era.Universal.Insert.Tx
99+
93100

94101
-- Temporary debugging validation
95102
Cardano.DbSync.Era.Shelley.ValidateWithdrawal

‎cardano-db-sync/src/Cardano/DbSync/Api/Ledger.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -13,8 +13,8 @@ import Cardano.DbSync.Api.Types
1313
import Cardano.DbSync.Era.Shelley.Generic.Tx.Babbage (fromTxOut)
1414
import Cardano.DbSync.Era.Shelley.Generic.Tx.Types (DBPlutusScript)
1515
import qualified Cardano.DbSync.Era.Shelley.Generic.Util as Generic
16-
import qualified Cardano.DbSync.Era.Shelley.Insert as Insert
17-
import Cardano.DbSync.Era.Shelley.Insert.Grouped
16+
import Cardano.DbSync.Era.Universal.Insert.Grouped
17+
import Cardano.DbSync.Era.Universal.Insert.Tx (insertTxOut)
1818
import Cardano.DbSync.Era.Util
1919
import Cardano.DbSync.Error
2020
import Cardano.DbSync.Ledger.State
@@ -171,7 +171,7 @@ prepareTxOut syncEnv txCache (TxIn txHash (TxIx index), txOut) = do
171171
let txHashByteString = Generic.safeHashToByteString $ unTxId txHash
172172
let genTxOut = fromTxOut index txOut
173173
txId <- queryTxIdWithCache txCache txHashByteString
174-
Insert.prepareTxOut trce cache iopts (txId, txHashByteString) genTxOut
174+
insertTxOut trce cache iopts (txId, txHashByteString) genTxOut
175175
where
176176
trce = getTrace syncEnv
177177
cache = envCache syncEnv

‎cardano-db-sync/src/Cardano/DbSync/Default.hs‎

Lines changed: 17 additions & 110 deletions
Original file line numberDiff line numberDiff line change
@@ -16,18 +16,15 @@ import qualified Cardano.Db as DB
1616
import Cardano.DbSync.Api
1717
import Cardano.DbSync.Api.Ledger
1818
import Cardano.DbSync.Api.Types (ConsistentLevel (..), InsertOptions (..), LedgerEnv (..), SyncEnv (..), SyncOptions (..))
19-
import Cardano.DbSync.Cache.Types (textShowStats)
2019
import Cardano.DbSync.Epoch (epochHandler)
2120
import Cardano.DbSync.Era.Byron.Insert (insertByronBlock)
22-
import Cardano.DbSync.Era.Cardano.Insert (insertEpochSyncTime)
23-
import Cardano.DbSync.Era.Shelley.Adjust (adjustEpochRewards)
2421
import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
25-
import Cardano.DbSync.Era.Shelley.Insert (insertShelleyBlock, mkAdaPots)
26-
import Cardano.DbSync.Era.Shelley.Insert.Epoch (insertInstantRewards, insertPoolDepositRefunds, insertRewards)
27-
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)
2826
import Cardano.DbSync.Error
2927
import Cardano.DbSync.Fix.EpochStake
30-
import Cardano.DbSync.Ledger.Event (LedgerEvent (..))
3128
import Cardano.DbSync.Ledger.State (applyBlockAndSnapshot, defaultApplyResult)
3229
import Cardano.DbSync.Ledger.Types (ApplyResult (..))
3330
import Cardano.DbSync.LocalStateQuery
@@ -37,17 +34,15 @@ import Cardano.DbSync.Util
3734
import Cardano.DbSync.Util.Constraint (addConstraintsIfNotExist)
3835
import qualified Cardano.Ledger.Alonzo.Scripts as Ledger
3936
import Cardano.Ledger.Shelley.AdaPots as Shelley
37+
import Cardano.Node.Configuration.Logging (Trace)
4038
import Cardano.Prelude
4139
import Cardano.Slotting.Slot (EpochNo (..), SlotNo)
4240
import Control.Monad.Logger (LoggingT)
43-
import Control.Monad.Trans.Control (MonadBaseControl)
4441
import Control.Monad.Trans.Except.Extra (newExceptT)
4542
import qualified Data.ByteString.Short as SBS
46-
import qualified Data.Map.Strict as Map
4743
import qualified Data.Set as Set
4844
import qualified Data.Strict.Maybe as Strict
4945
import Database.Persist.SqlBackend.Internal
50-
import Database.Persist.SqlBackend.Internal.StatementCache
5146
import Ouroboros.Consensus.Cardano.Block (HardForkBlock (..))
5247
import qualified Ouroboros.Consensus.HardFork.Combinator as Consensus
5348
import Ouroboros.Network.Block (blockHash, blockNo, getHeaderFields, headerFieldBlockNo, unBlockNo)
@@ -59,15 +54,16 @@ insertListBlocks ::
5954
insertListBlocks synEnv blocks = do
6055
DB.runDbIohkLogging (envBackend synEnv) tracer
6156
. runExceptT
62-
$ traverse_ (applyAndInsertBlockMaybe synEnv) blocks
57+
$ traverse_ (applyAndInsertBlockMaybe synEnv tracer) blocks
6358
where
6459
tracer = getTrace synEnv
6560

6661
applyAndInsertBlockMaybe ::
6762
SyncEnv ->
63+
Trace IO Text ->
6864
CardanoBlock ->
6965
ExceptT SyncNodeError (ReaderT SqlBackend (LoggingT IO)) ()
70-
applyAndInsertBlockMaybe syncEnv cblk = do
66+
applyAndInsertBlockMaybe syncEnv tracer cblk = do
7167
bl <- liftIO $ isConsistent syncEnv
7268
(!applyRes, !tookSnapshot) <- liftIO (mkApplyResult bl)
7369
if bl
@@ -100,8 +96,6 @@ applyAndInsertBlockMaybe syncEnv cblk = do
10096
liftIO $ logInfo tracer $ "Reached " <> textShow epochNo
10197
_ -> pure ()
10298
where
103-
tracer = getTrace syncEnv
104-
10599
mkApplyResult :: Bool -> IO (ApplyResult, Bool)
106100
mkApplyResult isCons = do
107101
case envLedgerEnv syncEnv of
@@ -135,12 +129,12 @@ insertBlock syncEnv cblk applyRes firstAfterRollback tookSnapshot = do
135129
let !details = apSlotDetails applyResult
136130
let !withinTwoMin = isWithinTwoMin details
137131
let !withinHalfHour = isWithinHalfHour details
138-
insertLedgerEvents syncEnv (sdEpochNo details) (apEvents applyResult)
132+
insertBlockLedgerEvents syncEnv (sdEpochNo details) (apEvents applyResult)
139133
let isNewEpochEvent = hasNewEpochEvent (apEvents applyResult)
140134
let isStartEventOrRollback = hasEpochStartEvent (apEvents applyResult) || firstAfterRollback
141135
let isMember poolId = Set.member poolId (apPoolsRegistered applyResult)
142-
let insertShelley blk =
143-
insertShelleyBlock
136+
let insertBlockUniversal' blk =
137+
insertBlockUniversal
144138
syncEnv
145139
isStartEventOrRollback
146140
withinTwoMin
@@ -158,27 +152,27 @@ insertBlock syncEnv cblk applyRes firstAfterRollback tookSnapshot = do
158152
insertByronBlock syncEnv isStartEventOrRollback blk details
159153
BlockShelley blk ->
160154
newExceptT $
161-
insertShelley $
155+
insertBlockUniversal' $
162156
Generic.fromShelleyBlock blk
163157
BlockAllegra blk ->
164158
newExceptT $
165-
insertShelley $
159+
insertBlockUniversal' $
166160
Generic.fromAllegraBlock blk
167161
BlockMary blk ->
168162
newExceptT $
169-
insertShelley $
163+
insertBlockUniversal' $
170164
Generic.fromMaryBlock blk
171165
BlockAlonzo blk ->
172166
newExceptT $
173-
insertShelley $
167+
insertBlockUniversal' $
174168
Generic.fromAlonzoBlock (ioPlutusExtra iopts) (getPrices applyResult) blk
175169
BlockBabbage blk ->
176170
newExceptT $
177-
insertShelley $
171+
insertBlockUniversal' $
178172
Generic.fromBabbageBlock (ioPlutusExtra iopts) (getPrices applyResult) blk
179173
BlockConway blk ->
180174
newExceptT $
181-
insertShelley $
175+
insertBlockUniversal' $
182176
Generic.fromConwayBlock (ioPlutusExtra iopts) (getPrices applyResult) blk
183177
-- update the epoch
184178
updateEpoch details isNewEpochEvent
@@ -231,90 +225,3 @@ insertBlock syncEnv cblk applyRes firstAfterRollback tookSnapshot = do
231225
isWithinHalfHour sd = isSyncedWithinSeconds sd 1800 == SyncFollowing
232226

233227
blkNo = headerFieldBlockNo $ getHeaderFields cblk
234-
235-
-- -------------------------------------------------------------------------------------------------
236-
237-
insertLedgerEvents ::
238-
(MonadBaseControl IO m, MonadIO m) =>
239-
SyncEnv ->
240-
EpochNo ->
241-
[LedgerEvent] ->
242-
ExceptT SyncNodeError (ReaderT SqlBackend m) ()
243-
insertLedgerEvents syncEnv currentEpochNo@(EpochNo curEpoch) =
244-
mapM_ handler
245-
where
246-
tracer = getTrace syncEnv
247-
cache = envCache syncEnv
248-
ntw = getNetwork syncEnv
249-
250-
subFromCurrentEpoch :: Word64 -> EpochNo
251-
subFromCurrentEpoch m =
252-
if unEpochNo currentEpochNo >= m
253-
then EpochNo $ unEpochNo currentEpochNo - m
254-
else EpochNo 0
255-
256-
toSyncState :: SyncState -> DB.SyncState
257-
toSyncState SyncLagging = DB.SyncLagging
258-
toSyncState SyncFollowing = DB.SyncFollowing
259-
260-
handler ::
261-
(MonadBaseControl IO m, MonadIO m) =>
262-
LedgerEvent ->
263-
ExceptT SyncNodeError (ReaderT SqlBackend m) ()
264-
handler ev =
265-
case ev of
266-
LedgerNewEpoch en ss -> do
267-
lift $
268-
insertEpochSyncTime en (toSyncState ss) (envEpochSyncTime syncEnv)
269-
sqlBackend <- lift ask
270-
persistantCacheSize <- liftIO $ statementCacheSize $ connStmtMap sqlBackend
271-
liftIO . logInfo tracer $ "Persistant SQL Statement Cache size is " <> textShow persistantCacheSize
272-
stats <- liftIO $ textShowStats cache
273-
liftIO . logInfo tracer $ stats
274-
liftIO . logInfo tracer $ "Starting epoch " <> textShow (unEpochNo en)
275-
LedgerStartAtEpoch en ->
276-
-- This is different from the previous case in that the db-sync started
277-
-- in this epoch, for example after a restart, instead of after an epoch boundary.
278-
liftIO . logInfo tracer $ "Starting at epoch " <> textShow (unEpochNo en)
279-
LedgerDeltaRewards _e rwd -> do
280-
let rewards = Map.toList $ Generic.unRewards rwd
281-
insertRewards syncEnv ntw (subFromCurrentEpoch 2) currentEpochNo cache (Map.toList $ Generic.unRewards rwd)
282-
-- This event is only created when it's not empty, so we don't need to check for null here.
283-
liftIO . logInfo tracer $ "Inserted " <> show (length rewards) <> " Delta rewards"
284-
LedgerIncrementalRewards _ rwd -> do
285-
let rewards = Map.toList $ Generic.unRewards rwd
286-
insertRewards syncEnv ntw (subFromCurrentEpoch 1) (EpochNo $ curEpoch + 1) cache rewards
287-
LedgerRestrainedRewards e rwd creds ->
288-
lift $ adjustEpochRewards tracer ntw cache e rwd creds
289-
LedgerTotalRewards _e rwd ->
290-
lift $ validateEpochRewards tracer ntw (subFromCurrentEpoch 2) currentEpochNo rwd
291-
LedgerAdaPots _ ->
292-
pure () -- These are handled separately by insertBlock
293-
LedgerMirDist rwd -> do
294-
unless (Map.null rwd) $ do
295-
let rewards = Map.toList rwd
296-
insertInstantRewards ntw (subFromCurrentEpoch 1) currentEpochNo cache rewards
297-
liftIO . logInfo tracer $ "Inserted " <> show (length rewards) <> " Mir rewards"
298-
LedgerPoolReap en drs ->
299-
unless (Map.null $ Generic.unRewards drs) $ do
300-
insertPoolDepositRefunds syncEnv en drs
301-
LedgerDeposits {} -> pure ()
302-
303-
hasEpochStartEvent :: [LedgerEvent] -> Bool
304-
hasEpochStartEvent = any isNewEpoch
305-
where
306-
isNewEpoch :: LedgerEvent -> Bool
307-
isNewEpoch le =
308-
case le of
309-
LedgerNewEpoch {} -> True
310-
LedgerStartAtEpoch {} -> True
311-
_otherwise -> False
312-
313-
hasNewEpochEvent :: [LedgerEvent] -> Bool
314-
hasNewEpochEvent = any isNewEpoch
315-
where
316-
isNewEpoch :: LedgerEvent -> Bool
317-
isNewEpoch le =
318-
case le of
319-
LedgerNewEpoch {} -> True
320-
_otherwise -> False

0 commit comments

Comments
 (0)