diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs index 12e512b70..d2bdecac2 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs @@ -36,6 +36,7 @@ module Test.Cardano.Db.Mock.Config ( withDBSyncEnv, withFullConfig, withFullConfigAndDropDB, + withFullConfigLogsDropDB, withFullConfigAndLogs, withCustomConfigAndLogsAndDropDB, withCustomConfig, @@ -354,6 +355,26 @@ withFullConfigAndDropDB = initCommandLineArgs Nothing +withFullConfigLogsDropDB :: + -- | config filepath + FilePath -> + -- | test label + FilePath -> + (Interpreter -> ServerHandle IO CardanoBlock -> DBSyncEnv -> IO a) -> + IOManager -> + [(Text, Text)] -> + IO a +withFullConfigLogsDropDB = + withFullConfig' + ( WithConfigArgs + { hasFingerprint = True + , shouldLog = True + , shouldDropDB = True + } + ) + initCommandLineArgs + Nothing + withFullConfigAndLogs :: -- | config filepath FilePath -> diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Alonzo/Stake.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Alonzo/Stake.hs index 3f5fdd0c4..9325ea02d 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Alonzo/Stake.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Alonzo/Stake.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE NumericUnderscores #-} + module Test.Cardano.Db.Mock.Unit.Alonzo.Stake ( -- stake addresses registrationTx, @@ -24,7 +26,7 @@ import qualified Cardano.Mock.Forging.Tx.Alonzo as Alonzo import Cardano.Mock.Forging.Tx.Alonzo.Scenarios (delegateAndSendBlocks) import Cardano.Mock.Forging.Types (StakeIndex (..), UTxOIndex (..)) import Control.Concurrent.Class.MonadSTM.Strict (MonadSTM (atomically)) -import Control.Monad (forM_, replicateM_, void) +import Control.Monad (forM_, void) import Data.Text (Text) import Ouroboros.Network.Block (blockSlot) import Test.Cardano.Db.Mock.Config (alonzoConfigDir, startDBSync, withFullConfig, withFullConfigAndDropDB) @@ -33,7 +35,6 @@ import Test.Cardano.Db.Mock.UnifiedApi ( fillUntilNextEpoch, forgeAndSubmitBlocks, forgeNextFindLeaderAndSubmit, - forgeNextSkipSlotsFindLeaderAndSubmit, getAlonzoLedgerState, withAlonzoFindLeaderAndSubmit, withAlonzoFindLeaderAndSubmitTx, @@ -215,126 +216,128 @@ stakeDistGenesis :: IOManager -> [(Text, Text)] -> Assertion stakeDistGenesis = withFullConfigAndDropDB alonzoConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - a <- fillUntilNextEpoch interpreter mockServer - assertBlockNoBackoff dbSync (fromIntegral $ length a) - -- There are 5 delegations in genesis - assertEpochStake dbSync 5 + blks <- fillUntilNextEpoch interpreter mockServer + assertBlockNoBackoff dbSync (fromIntegral $ length blks) + -- There are 10 delegations in genesis + assertEpochStakeEpoch dbSync 1 5 + assertEpochStakeEpoch dbSync 2 5 where testLabel = "stakeDistGenesis-alonzo" delegations2000 :: IOManager -> [(Text, Text)] -> Assertion delegations2000 = - withFullConfig alonzoConfigDir testLabel $ \interpreter mockServer dbSync -> do + withFullConfigAndDropDB alonzoConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - a <- delegateAndSendBlocks 1995 interpreter - forM_ a $ atomically . addBlock mockServer - b <- fillUntilNextEpoch interpreter mockServer - c <- forgeAndSubmitBlocks interpreter mockServer 10 - - assertBlockNoBackoff dbSync (fromIntegral $ length a + length b + length c) - -- There are exactly 2000 entries on the second epoch, 5 from genesis and 1995 manually added + blks <- delegateAndSendBlocks 1995 interpreter + forM_ blks (atomically . addBlock mockServer) + -- Fill the rest of the epoch + epoch <- fillUntilNextEpoch interpreter mockServer + -- Wait for them to sync + assertBlockNoBackoff dbSync (length blks + length epoch) + assertEpochStakeEpoch dbSync 1 5 + -- Add some more blocks + blks' <- forgeAndSubmitBlocks interpreter mockServer 10 + -- Wait for it to sync + assertBlockNoBackoff dbSync (length blks + length epoch + length blks') assertEpochStakeEpoch dbSync 2 2000 - + -- Forge another block void $ forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertBlockNoBackoff dbSync (fromIntegral $ length a + length b + length c + 1) + -- Wait for it to sync + assertBlockNoBackoff dbSync (length blks + length epoch + length blks' + 1) + -- There are still 2000 entries assertEpochStakeEpoch dbSync 2 2000 where testLabel = "delegations2000-alonzo" delegations2001 :: IOManager -> [(Text, Text)] -> Assertion delegations2001 = - withFullConfig alonzoConfigDir testLabel $ \interpreter mockServer dbSync -> do + withFullConfigAndDropDB alonzoConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - a <- delegateAndSendBlocks 1996 interpreter - forM_ a $ atomically . addBlock mockServer - b <- fillUntilNextEpoch interpreter mockServer - c <- forgeAndSubmitBlocks interpreter mockServer 9 - - assertBlockNoBackoff dbSync (fromIntegral $ length a + length b + length c) - assertEpochStakeEpoch dbSync 2 0 + -- We want exactly 2001 delegations, 5 from genesis and 1996 manually added + blks <- delegateAndSendBlocks 1996 interpreter + forM_ blks (atomically . addBlock mockServer) + -- Fill the rest of the epoch + epoch <- fillUntilNextEpoch interpreter mockServer + -- Add some more blocks + blks' <- forgeAndSubmitBlocks interpreter mockServer 9 + -- Wait for it to sync + assertBlockNoBackoff dbSync (length blks + length epoch + length blks') + assertEpochStakeEpoch dbSync 1 5 + -- The next 2000 entries is inserted on the next block void $ forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertBlockNoBackoff dbSync (fromIntegral $ length a + length b + length c + 1) - assertEpochStakeEpoch dbSync 2 2000 - -- The remaining entry is inserted on the next block. + assertBlockNoBackoff dbSync (length blks + length epoch + length blks' + 1) + assertEpochStakeEpoch dbSync 2 2001 + -- The remaining entry is inserted on the next block void $ forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertBlockNoBackoff dbSync (fromIntegral $ length a + length b + length c + 2) + assertBlockNoBackoff dbSync (length blks + length epoch + length blks' + 2) assertEpochStakeEpoch dbSync 2 2001 where testLabel = "delegations2001-alonzo" delegations8000 :: IOManager -> [(Text, Text)] -> Assertion delegations8000 = - withFullConfig alonzoConfigDir testLabel $ \interpreter mockServer dbSync -> do + withFullConfigAndDropDB alonzoConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - a <- delegateAndSendBlocks 7995 interpreter - forM_ a $ atomically . addBlock mockServer - b <- fillEpochs interpreter mockServer 2 - c <- forgeAndSubmitBlocks interpreter mockServer 10 - - assertBlockNoBackoff dbSync (fromIntegral $ length a + length b + length c) - assertEpochStakeEpoch dbSync 3 2000 - - void $ forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertEpochStakeEpoch dbSync 3 4000 - - void $ forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertEpochStakeEpoch dbSync 3 6000 - - void $ forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertEpochStakeEpoch dbSync 3 8000 - - void $ forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertEpochStakeEpoch dbSync 3 8000 + -- We want exactly 8000 delegations, 5 from genesis and 7995 manually added + blks <- delegateAndSendBlocks 7995 interpreter + forM_ blks (atomically . addBlock mockServer) + -- Fill the rest of the epoch + epoch <- fillEpochs interpreter mockServer 2 + -- Add some more blocks + blks' <- forgeAndSubmitBlocks interpreter mockServer 10 + -- Wait for it to sync + assertBlockNoBackoff dbSync (length blks + length epoch + length blks') + assertEpochStakeEpoch dbSync 1 5 + assertEpochStakeEpoch dbSync 2 8000 where testLabel = "delegations8000-alonzo" delegationsMany :: IOManager -> [(Text, Text)] -> Assertion delegationsMany = - withFullConfig alonzoConfigDir testLabel $ \interpreter mockServer dbSync -> do + withFullConfigAndDropDB alonzoConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - a <- delegateAndSendBlocks 40000 interpreter - forM_ a $ atomically . addBlock mockServer - b <- fillEpochs interpreter mockServer 4 - c <- forgeAndSubmitBlocks interpreter mockServer 10 - - -- too long. We cannot use default delays - assertBlockNoBackoffTimes (repeat 10) dbSync (fromIntegral $ length a + length b + length c) - -- The slice size here is - -- 1 + div (delegationsLen * 5) expectedBlocks = 2001 - -- instead of 2000, because there are many delegations - assertEpochStakeEpoch dbSync 7 2001 - - void $ forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertEpochStakeEpoch dbSync 7 4002 - - void $ forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertEpochStakeEpoch dbSync 7 6003 + -- Forge many delegations + blks <- delegateAndSendBlocks 40_000 interpreter + forM_ blks (atomically . addBlock mockServer) + -- Fill some epochs + epochs <- fillEpochs interpreter mockServer 4 + -- Add some more blocks + blks' <- forgeAndSubmitBlocks interpreter mockServer 10 + -- We can't use default delays because this takes too long + assertBlockNoBackoffTimes + (repeat 10) + dbSync + (length blks + length epochs + length blks') + assertEpochStakeEpoch dbSync 6 40_005 + assertEpochStakeEpoch dbSync 7 40_005 where testLabel = "delegationsMany-alonzo" delegationsManyNotDense :: IOManager -> [(Text, Text)] -> Assertion delegationsManyNotDense = - withFullConfig alonzoConfigDir testLabel $ \interpreter mockServer dbSync -> do + withFullConfigAndDropDB alonzoConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - a <- delegateAndSendBlocks 40000 interpreter - forM_ a $ atomically . addBlock mockServer - b <- fillEpochs interpreter mockServer 4 - c <- forgeAndSubmitBlocks interpreter mockServer 10 - - -- too long. We cannot use default delays - assertBlockNoBackoffTimes (repeat 10) dbSync (fromIntegral $ length a + length b + length c) - -- The slice size here is - -- 1 + div (delegationsLen * 5) expectedBlocks = 2001 - -- instead of 2000, because there are many delegations - assertEpochStakeEpoch dbSync 7 2001 - - -- Blocks come on average every 5 slots. If we skip 15 slots before each block, - -- we are expected to get only 1/4 of the expected blocks. The adjusted slices - -- should still be long enough to cover everything. - replicateM_ 40 $ - forgeNextSkipSlotsFindLeaderAndSubmit interpreter mockServer 15 [] - - -- Even if the chain is sparse, all distributions are inserted. - assertEpochStakeEpoch dbSync 7 40005 + -- Forge many delegations + blks <- delegateAndSendBlocks 40_000 interpreter + forM_ blks (atomically . addBlock mockServer) + -- Fill some epochs + epochs <- fillEpochs interpreter mockServer 4 + -- Add some more blocks + blks' <- forgeAndSubmitBlocks interpreter mockServer 10 + -- We can't use default delays because this takes too long + assertBlockNoBackoffTimes + (repeat 10) + dbSync + (length blks + length epochs + length blks') + -- check the stake distribution for each epoch + assertEpochStakeEpoch dbSync 1 5 + assertEpochStakeEpoch dbSync 2 12_505 + assertEpochStakeEpoch dbSync 3 40_005 + assertEpochStakeEpoch dbSync 4 40_005 + assertEpochStakeEpoch dbSync 5 40_005 + assertEpochStakeEpoch dbSync 6 40_005 + assertEpochStakeEpoch dbSync 7 40_005 + -- check the sum of stake distribution for all epochs + assertEpochStake dbSync 212_535 where testLabel = "delegationsManyNotDense-alonzo" diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Babbage/Stake.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Babbage/Stake.hs index 6a7f51a68..e0b6196be 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Babbage/Stake.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Babbage/Stake.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE NumericUnderscores #-} + module Test.Cardano.Db.Mock.Unit.Babbage.Stake ( -- stake address registrationTx, @@ -25,7 +27,7 @@ import qualified Cardano.Mock.Forging.Tx.Babbage as Babbage import Cardano.Mock.Forging.Tx.Babbage.Scenarios (delegateAndSendBlocks) import Cardano.Mock.Forging.Types (StakeIndex (..), UTxOIndex (..)) import Control.Concurrent.Class.MonadSTM.Strict (MonadSTM (..)) -import Control.Monad (forM_, replicateM_, void) +import Control.Monad (forM_, void) import Data.Text (Text) import Ouroboros.Network.Block (blockSlot) import Test.Cardano.Db.Mock.Config (babbageConfigDir, startDBSync, withFullConfig, withFullConfigAndDropDB) @@ -34,7 +36,6 @@ import Test.Cardano.Db.Mock.UnifiedApi ( fillUntilNextEpoch, forgeAndSubmitBlocks, forgeNextFindLeaderAndSubmit, - forgeNextSkipSlotsFindLeaderAndSubmit, getBabbageLedgerState, withBabbageFindLeaderAndSubmit, withBabbageFindLeaderAndSubmitTx, @@ -215,10 +216,11 @@ stakeDistGenesis :: IOManager -> [(Text, Text)] -> Assertion stakeDistGenesis = withFullConfigAndDropDB babbageConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - a <- fillUntilNextEpoch interpreter mockServer - assertBlockNoBackoff dbSync (fromIntegral $ length a) - -- There are 5 delegations in genesis - assertEpochStake dbSync 5 + blks <- fillUntilNextEpoch interpreter mockServer + assertBlockNoBackoff dbSync (fromIntegral $ length blks) + -- There are 10 delegations in genesis + assertEpochStakeEpoch dbSync 1 5 + assertEpochStakeEpoch dbSync 2 5 where testLabel = "stakeDistGenesis" @@ -226,17 +228,23 @@ delegations2000 :: IOManager -> [(Text, Text)] -> Assertion delegations2000 = withFullConfig babbageConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - a <- delegateAndSendBlocks 1995 interpreter - forM_ a $ atomically . addBlock mockServer - b <- fillUntilNextEpoch interpreter mockServer - c <- forgeAndSubmitBlocks interpreter mockServer 10 - - assertBlockNoBackoff dbSync (fromIntegral $ length a + length b + length c) - -- There are exactly 2000 entries on the second epoch, 5 from genesis and 1995 manually added + blks <- delegateAndSendBlocks 1995 interpreter + forM_ blks (atomically . addBlock mockServer) + -- Fill the rest of the epoch + epoch <- fillUntilNextEpoch interpreter mockServer + -- Wait for them to sync + assertBlockNoBackoff dbSync (length blks + length epoch) + assertEpochStakeEpoch dbSync 1 5 + -- Add some more blocks + blks' <- forgeAndSubmitBlocks interpreter mockServer 10 + -- Wait for it to sync + assertBlockNoBackoff dbSync (length blks + length epoch + length blks') assertEpochStakeEpoch dbSync 2 2000 - + -- Forge another block void $ forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertBlockNoBackoff dbSync (fromIntegral $ length a + length b + length c + 1) + -- Wait for it to sync + assertBlockNoBackoff dbSync (length blks + length epoch + length blks' + 1) + -- There are still 2000 entries assertEpochStakeEpoch dbSync 2 2000 where testLabel = "delegations2000" @@ -245,19 +253,23 @@ delegations2001 :: IOManager -> [(Text, Text)] -> Assertion delegations2001 = withFullConfig babbageConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - a <- delegateAndSendBlocks 1996 interpreter - forM_ a $ atomically . addBlock mockServer - b <- fillUntilNextEpoch interpreter mockServer - c <- forgeAndSubmitBlocks interpreter mockServer 9 - - assertBlockNoBackoff dbSync (fromIntegral $ length a + length b + length c) - assertEpochStakeEpoch dbSync 2 0 + -- We want exactly 2001 delegations, 5 from genesis and 1996 manually added + blks <- delegateAndSendBlocks 1996 interpreter + forM_ blks (atomically . addBlock mockServer) + -- Fill the rest of the epoch + epoch <- fillUntilNextEpoch interpreter mockServer + -- Add some more blocks + blks' <- forgeAndSubmitBlocks interpreter mockServer 9 + -- Wait for it to sync + assertBlockNoBackoff dbSync (length blks + length epoch + length blks') + assertEpochStakeEpoch dbSync 1 5 + -- The next 2000 entries is inserted on the next block void $ forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertBlockNoBackoff dbSync (fromIntegral $ length a + length b + length c + 1) - assertEpochStakeEpoch dbSync 2 2000 - -- The remaining entry is inserted on the next block. + assertBlockNoBackoff dbSync (length blks + length epoch + length blks' + 1) + assertEpochStakeEpoch dbSync 2 2001 + -- The remaining entry is inserted on the next block void $ forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertBlockNoBackoff dbSync (fromIntegral $ length a + length b + length c + 2) + assertBlockNoBackoff dbSync (length blks + length epoch + length blks' + 2) assertEpochStakeEpoch dbSync 2 2001 where testLabel = "delegations2001" @@ -266,25 +278,17 @@ delegations8000 :: IOManager -> [(Text, Text)] -> Assertion delegations8000 = withFullConfig babbageConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - a <- delegateAndSendBlocks 7995 interpreter - forM_ a $ atomically . addBlock mockServer - b <- fillEpochs interpreter mockServer 2 - c <- forgeAndSubmitBlocks interpreter mockServer 10 - - assertBlockNoBackoff dbSync (fromIntegral $ length a + length b + length c) - assertEpochStakeEpoch dbSync 3 2000 - - void $ forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertEpochStakeEpoch dbSync 3 4000 - - void $ forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertEpochStakeEpoch dbSync 3 6000 - - void $ forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertEpochStakeEpoch dbSync 3 8000 - - void $ forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertEpochStakeEpoch dbSync 3 8000 + -- We want exactly 8000 delegations, 5 from genesis and 7995 manually added + blks <- delegateAndSendBlocks 7995 interpreter + forM_ blks (atomically . addBlock mockServer) + -- Fill the rest of the epoch + epoch <- fillEpochs interpreter mockServer 2 + -- Add some more blocks + blks' <- forgeAndSubmitBlocks interpreter mockServer 10 + -- Wait for it to sync + assertBlockNoBackoff dbSync (length blks + length epoch + length blks') + assertEpochStakeEpoch dbSync 1 5 + assertEpochStakeEpoch dbSync 2 8000 where testLabel = "delegations8000" @@ -292,23 +296,20 @@ delegationsMany :: IOManager -> [(Text, Text)] -> Assertion delegationsMany = withFullConfig babbageConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - a <- delegateAndSendBlocks 40000 interpreter - forM_ a $ atomically . addBlock mockServer - b <- fillEpochs interpreter mockServer 4 - c <- forgeAndSubmitBlocks interpreter mockServer 10 - - -- too long. We cannot use default delays - assertBlockNoBackoffTimes (repeat 10) dbSync (fromIntegral $ length a + length b + length c) - -- The slice size here is - -- 1 + div (delegationsLen * 5) expectedBlocks = 2001 - -- instead of 2000, because there are many delegations - assertEpochStakeEpoch dbSync 7 2001 - - void $ forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertEpochStakeEpoch dbSync 7 4002 - - void $ forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertEpochStakeEpoch dbSync 7 6003 + -- Forge many delegations + blks <- delegateAndSendBlocks 40_000 interpreter + forM_ blks (atomically . addBlock mockServer) + -- Fill some epochs + epochs <- fillEpochs interpreter mockServer 4 + -- Add some more blocks + blks' <- forgeAndSubmitBlocks interpreter mockServer 10 + -- We can't use default delays because this takes too long + assertBlockNoBackoffTimes + (repeat 10) + dbSync + (length blks + length epochs + length blks') + assertEpochStakeEpoch dbSync 6 40_005 + assertEpochStakeEpoch dbSync 7 40_005 where testLabel = "delegationsMany" @@ -316,25 +317,27 @@ delegationsManyNotDense :: IOManager -> [(Text, Text)] -> Assertion delegationsManyNotDense = withFullConfig babbageConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - a <- delegateAndSendBlocks 40000 interpreter - forM_ a $ atomically . addBlock mockServer - b <- fillEpochs interpreter mockServer 4 - c <- forgeAndSubmitBlocks interpreter mockServer 10 - - -- too long. We cannot use default delays - assertBlockNoBackoffTimes (repeat 10) dbSync (fromIntegral $ length a + length b + length c) - -- The slice size here is - -- 1 + div (delegationsLen * 5) expectedBlocks = 2001 - -- instead of 2000, because there are many delegations - assertEpochStakeEpoch dbSync 7 2001 - - -- Blocks come on average every 5 slots. If we skip 15 slots before each block, - -- we are expected to get only 1/4 of the expected blocks. The adjusted slices - -- should still be long enough to cover everything. - replicateM_ 40 $ - forgeNextSkipSlotsFindLeaderAndSubmit interpreter mockServer 15 [] - - -- Even if the chain is sparse, all distributions are inserted. - assertEpochStakeEpoch dbSync 7 40005 + -- Forge many delegations + blks <- delegateAndSendBlocks 40_000 interpreter + forM_ blks (atomically . addBlock mockServer) + -- Fill some epochs + epochs <- fillEpochs interpreter mockServer 4 + -- Add some more blocks + blks' <- forgeAndSubmitBlocks interpreter mockServer 10 + -- We can't use default delays because this takes too long + assertBlockNoBackoffTimes + (repeat 10) + dbSync + (length blks + length epochs + length blks') + -- check the stake distribution for each epoch + assertEpochStakeEpoch dbSync 1 5 + assertEpochStakeEpoch dbSync 2 6005 + assertEpochStakeEpoch dbSync 3 40_005 + assertEpochStakeEpoch dbSync 4 40_005 + assertEpochStakeEpoch dbSync 5 40_005 + assertEpochStakeEpoch dbSync 6 40_005 + assertEpochStakeEpoch dbSync 7 40_005 + -- check the sum of stake distribution for all epochs + assertEpochStake dbSync 206_035 where testLabel = "delegationsManyNotDense" diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Stake.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Stake.hs index ab9dce6c7..ca821b245 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Stake.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Stake.hs @@ -230,36 +230,32 @@ stakeDistGenesis :: IOManager -> [(Text, Text)] -> Assertion stakeDistGenesis = withFullConfigAndDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - -- Forge an entire epoch blks <- Api.fillUntilNextEpoch interpreter mockServer - -- Wait for it to sync assertBlockNoBackoff dbSync (fromIntegral $ length blks) - -- There are 5 delegations in genesis - assertEpochStake dbSync 5 + -- There are 10 delegations in genesis + assertEpochStakeEpoch dbSync 1 5 + assertEpochStakeEpoch dbSync 2 5 where testLabel = "conwayStakeDistGenesis" delegations2000 :: IOManager -> [(Text, Text)] -> Assertion delegations2000 = - withFullConfig conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withFullConfigAndDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - - -- We want exactly 2000 delegations, 5 from genesis and 1995 manually added blks <- Conway.delegateAndSendBlocks 1995 interpreter forM_ blks (atomically . addBlock mockServer) -- Fill the rest of the epoch epoch <- Api.fillUntilNextEpoch interpreter mockServer + -- Wait for them to sync + assertBlockNoBackoff dbSync (length blks + length epoch) + assertEpochStakeEpoch dbSync 1 5 -- Add some more blocks blks' <- Api.forgeAndSubmitBlocks interpreter mockServer 10 - -- Wait for it to sync assertBlockNoBackoff dbSync (length blks + length epoch + length blks') - -- There are exactly 2000 entries on the second epoch, 5 from genesis and 1995 - -- manually added assertEpochStakeEpoch dbSync 2 2000 - -- Forge another block void $ Api.forgeNextFindLeaderAndSubmit interpreter mockServer [] -- Wait for it to sync @@ -271,9 +267,8 @@ delegations2000 = delegations2001 :: IOManager -> [(Text, Text)] -> Assertion delegations2001 = - withFullConfig conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withFullConfigAndDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - -- We want exactly 2001 delegations, 5 from genesis and 1996 manually added blks <- Conway.delegateAndSendBlocks 1996 interpreter forM_ blks (atomically . addBlock mockServer) @@ -281,14 +276,13 @@ delegations2001 = epoch <- Api.fillUntilNextEpoch interpreter mockServer -- Add some more blocks blks' <- Api.forgeAndSubmitBlocks interpreter mockServer 9 - -- Wait for it to sync assertBlockNoBackoff dbSync (length blks + length epoch + length blks') - assertEpochStakeEpoch dbSync 2 0 + assertEpochStakeEpoch dbSync 1 5 -- The next 2000 entries is inserted on the next block void $ Api.forgeNextFindLeaderAndSubmit interpreter mockServer [] assertBlockNoBackoff dbSync (length blks + length epoch + length blks' + 1) - assertEpochStakeEpoch dbSync 2 2000 + assertEpochStakeEpoch dbSync 2 2001 -- The remaining entry is inserted on the next block void $ Api.forgeNextFindLeaderAndSubmit interpreter mockServer [] assertBlockNoBackoff dbSync (length blks + length epoch + length blks' + 2) @@ -298,9 +292,8 @@ delegations2001 = delegations8000 :: IOManager -> [(Text, Text)] -> Assertion delegations8000 = - withFullConfig conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withFullConfigAndDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - -- We want exactly 8000 delegations, 5 from genesis and 7995 manually added blks <- Conway.delegateAndSendBlocks 7995 interpreter forM_ blks (atomically . addBlock mockServer) @@ -308,31 +301,17 @@ delegations8000 = epoch <- Api.fillEpochs interpreter mockServer 2 -- Add some more blocks blks' <- Api.forgeAndSubmitBlocks interpreter mockServer 10 - -- Wait for it to sync assertBlockNoBackoff dbSync (length blks + length epoch + length blks') - assertEpochStakeEpoch dbSync 3 2000 - - -- Each block will add 2000 more - void $ Api.forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertEpochStakeEpoch dbSync 3 4000 - - void $ Api.forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertEpochStakeEpoch dbSync 3 6000 - - void $ Api.forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertEpochStakeEpoch dbSync 3 8000 - - void $ Api.forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertEpochStakeEpoch dbSync 3 8000 + assertEpochStakeEpoch dbSync 1 5 + assertEpochStakeEpoch dbSync 2 8000 where testLabel = "conwayDelegations8000" delegationsMany :: IOManager -> [(Text, Text)] -> Assertion delegationsMany = - withFullConfig conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withFullConfigAndDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - -- Forge many delegations blks <- Conway.delegateAndSendBlocks 40_000 interpreter forM_ blks (atomically . addBlock mockServer) @@ -340,30 +319,20 @@ delegationsMany = epochs <- Api.fillEpochs interpreter mockServer 4 -- Add some more blocks blks' <- Api.forgeAndSubmitBlocks interpreter mockServer 10 - -- We can't use default delays because this takes too long assertBlockNoBackoffTimes (repeat 10) dbSync (length blks + length epochs + length blks') - -- The slice size here is 1 + div (delegationsLen * 5) expectedBlocks = 2001 - -- instead of 2000, because there are many delegations - assertEpochStakeEpoch dbSync 7 2001 - - -- Each block will add 2001 more - void $ Api.forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertEpochStakeEpoch dbSync 7 4002 - - void $ Api.forgeNextFindLeaderAndSubmit interpreter mockServer [] - assertEpochStakeEpoch dbSync 7 6003 + assertEpochStakeEpoch dbSync 6 40_005 + assertEpochStakeEpoch dbSync 7 40_005 where testLabel = "conwayDelegationsMany" delegationsManyNotDense :: IOManager -> [(Text, Text)] -> Assertion delegationsManyNotDense = - withFullConfig conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withFullConfigAndDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - -- Forge many delegations blks <- Conway.delegateAndSendBlocks 40_000 interpreter forM_ blks (atomically . addBlock mockServer) @@ -371,24 +340,21 @@ delegationsManyNotDense = epochs <- Api.fillEpochs interpreter mockServer 4 -- Add some more blocks blks' <- Api.forgeAndSubmitBlocks interpreter mockServer 10 - -- We can't use default delays because this takes too long assertBlockNoBackoffTimes (repeat 10) dbSync (length blks + length epochs + length blks') - -- The slice size here is 1 + div (delegationsLen * 5) expectedBlocks = 2001 - -- instead of 2000, because there are many delegations - assertEpochStakeEpoch dbSync 7 2001 - - -- Blocks come on average every 5 slots. If we skip 15 slots before each block, - -- we are expected to get only 1/4 of the expected blocks. The adjusted slices - -- should still be long enough to cover everything. - replicateM_ 40 $ - Api.forgeNextSkipSlotsFindLeaderAndSubmit interpreter mockServer 15 [] - - -- Even if the chain is sparse, all distributions are inserted. + -- check the stake distribution for each epoch + assertEpochStakeEpoch dbSync 1 5 + assertEpochStakeEpoch dbSync 2 9505 + assertEpochStakeEpoch dbSync 3 40_005 + assertEpochStakeEpoch dbSync 4 40_005 + assertEpochStakeEpoch dbSync 5 40_005 + assertEpochStakeEpoch dbSync 6 40_005 assertEpochStakeEpoch dbSync 7 40_005 + -- check the sum of stake distribution for all epochs + assertEpochStake dbSync 209_535 where testLabel = "conwayDelegationsManyNotDense" diff --git a/cardano-db-sync/src/Cardano/DbSync/Default.hs b/cardano-db-sync/src/Cardano/DbSync/Default.hs index 0285533c1..c474f1b38 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Default.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Default.hs @@ -94,7 +94,7 @@ applyAndInsertBlockMaybe syncEnv tracer cblk = do Right _ | Just epochNo <- getNewEpoch applyRes -> liftIO $ logInfo tracer $ "Reached " <> textShow epochNo - _ -> pure () + _otherwise -> pure () where mkApplyResult :: Bool -> IO (ApplyResult, Bool) mkApplyResult isCons = do diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/StakeDist.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/StakeDist.hs index 3246ddc9d..d5a20f50f 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/StakeDist.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/StakeDist.hs @@ -3,7 +3,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeOperators #-} @@ -46,15 +45,13 @@ import Prelude (id) data StakeSliceRes = Slice !StakeSlice !Bool -- True if this is the final slice for this epoch. Can be used for logging. | NoSlices + deriving (Show) data StakeSlice = StakeSlice { sliceEpochNo :: !EpochNo , sliceDistr :: !(Map StakeCred (Coin, PoolKeyHash)) } - deriving (Eq) - -emptySlice :: EpochNo -> StakeSlice -emptySlice epoch = StakeSlice epoch Map.empty + deriving (Show, Eq) getSecurityParameter :: ConsensusProtocol (BlockProtocol blk) => @@ -62,44 +59,36 @@ getSecurityParameter :: Word64 getSecurityParameter = maxRollbacks . configSecurityParam . pInfoConfig --- 'sliceIndex' can match the epochBlockNo for every block. --- --- 'minSliceSize' has to be constant or it could cause missing data. --- If this value is too small it will be adjusted to a 'defaultEpochSliceSize' --- which is big enough to cover all delegations. --- On mainnet, for a value minSliceSize = 2000, it will be used as the actual size of slices --- until the size of delegations grows up to 8.6M, in which case, the size of slices --- will be adjusted. +-- | Get the stake distribution for the given epoch. getStakeSlice :: - ConsensusProtocol (BlockProtocol blk) => - ProtocolInfo blk -> Word64 -> ExtLedgerState CardanoBlock -> Bool -> StakeSliceRes -getStakeSlice pInfo !epochBlockNo els isMigration = +getStakeSlice !epochBlockNo els isMigration = case ledgerState els of LedgerStateByron _ -> NoSlices - LedgerStateShelley sls -> genericStakeSlice pInfo epochBlockNo sls isMigration - LedgerStateAllegra als -> genericStakeSlice pInfo epochBlockNo als isMigration - LedgerStateMary mls -> genericStakeSlice pInfo epochBlockNo mls isMigration - LedgerStateAlonzo als -> genericStakeSlice pInfo epochBlockNo als isMigration - LedgerStateBabbage bls -> genericStakeSlice pInfo epochBlockNo bls isMigration - LedgerStateConway cls -> genericStakeSlice pInfo epochBlockNo cls isMigration + LedgerStateShelley sls -> genericStakeSlice epochBlockNo sls isMigration + LedgerStateAllegra als -> genericStakeSlice epochBlockNo als isMigration + LedgerStateMary mls -> genericStakeSlice epochBlockNo mls isMigration + LedgerStateAlonzo als -> genericStakeSlice epochBlockNo als isMigration + LedgerStateBabbage bls -> genericStakeSlice epochBlockNo bls isMigration + LedgerStateConway cls -> genericStakeSlice epochBlockNo cls isMigration genericStakeSlice :: - forall era c blk p. - (c ~ StandardCrypto, EraCrypto era ~ c, ConsensusProtocol (BlockProtocol blk)) => - ProtocolInfo blk -> - Word64 -> + forall era c p. + (c ~ StandardCrypto, EraCrypto era ~ c) => + Word64 -> -- epochBlockNo LedgerState (ShelleyBlock p era) -> - Bool -> + Bool -> -- isMigration StakeSliceRes -genericStakeSlice pInfo epochBlockNo lstate isMigration - | index > delegationsLen = NoSlices - | index == delegationsLen = Slice (emptySlice epoch) True - | index + size > delegationsLen = Slice (mkSlice (delegationsLen - index)) True - | otherwise = Slice (mkSlice size) False +genericStakeSlice epochBlockNo lstate isMigration = + case compare index delegationsLen of + GT -> NoSlices + EQ -> Slice (emptySlice epoch) True + LT -> case compare (index + sliceSize) delegationsLen of + GT -> Slice (mkSlice (delegationsLen - index)) True + _otherwise -> Slice (mkSlice sliceSize) False where epoch :: EpochNo epoch = EpochNo $ 1 + unEpochNo (Shelley.nesEL (Consensus.shelleyLedgerState lstate)) @@ -107,13 +96,9 @@ genericStakeSlice pInfo epochBlockNo lstate isMigration minSliceSize :: Word64 minSliceSize = 2000 - -- On mainnet this is 2160 - k :: Word64 - k = getSecurityParameter pInfo + maxSliceSize :: Word64 + maxSliceSize = 10000 - -- We use 'ssStakeMark' here. That means that when these values - -- are added to the database, the epoch number where they become active is the current - -- epoch plus one. stakeSnapshot :: Ledger.SnapShot c stakeSnapshot = Ledger.ssStakeMark . Shelley.esSnapshots . Shelley.nesEs $ @@ -131,34 +116,11 @@ genericStakeSlice pInfo epochBlockNo lstate isMigration lookupStake :: Credential 'Staking c -> Maybe Coin lookupStake cred = Ledger.fromCompact <$> VMap.lookup cred stakes - -- This is deterministic for the whole epoch and is the constant size of slices - -- until the data are over. This means the last slice could be of smaller size and slices - -- after that will be empty. - epochSliceSize :: Word64 - epochSliceSize = - max minSliceSize defaultEpochSliceSize - where - -- On mainnet this is 21600 - expectedBlocks :: Word64 - expectedBlocks = 10 * k - - -- This size of slices is enough to cover the whole list, even if only - -- the 20% of the expected blocks appear in an epoch. - defaultEpochSliceSize :: Word64 - defaultEpochSliceSize = 1 + div (delegationsLen * 5) expectedBlocks + sliceSize :: Word64 + sliceSize = max minSliceSize (min maxSliceSize (delegationsLen `div` 10)) - -- The starting index of the data in the delegation vector. index :: Word64 - index - | isMigration = 0 - | epochBlockNo < k = delegationsLen + 1 -- so it creates the empty Slice. - | otherwise = (epochBlockNo - k) * epochSliceSize - - size :: Word64 - size - | isMigration, epochBlockNo + 1 < k = 0 - | isMigration = (epochBlockNo + 1 - k) * epochSliceSize - | otherwise = epochSliceSize + index = if isMigration then 0 else epochBlockNo * sliceSize mkSlice :: Word64 -> StakeSlice mkSlice actualSize = @@ -167,15 +129,15 @@ genericStakeSlice pInfo epochBlockNo lstate isMigration , sliceDistr = distribution } where - delegationsSliced :: VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c) delegationsSliced = VMap $ VG.slice (fromIntegral index) (fromIntegral actualSize) delegations - - distribution :: Map StakeCred (Coin, PoolKeyHash) distribution = VMap.toMap $ VMap.mapMaybe id $ VMap.mapWithKey (\a p -> (,p) <$> lookupStake a) delegationsSliced + emptySlice :: EpochNo -> StakeSlice + emptySlice e = StakeSlice {sliceEpochNo = e, sliceDistr = Map.empty} + getPoolDistr :: ExtLedgerState CardanoBlock -> Maybe (Map PoolKeyHash (Coin, Word64), Map PoolKeyHash Natural) diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Epoch.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Epoch.hs index cc1f86205..8eb2b46a2 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Epoch.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Epoch.hs @@ -198,15 +198,21 @@ insertStakeSlice :: SyncEnv -> Generic.StakeSliceRes -> ExceptT SyncNodeError (ReaderT SqlBackend m) () -insertStakeSlice _ Generic.NoSlices = pure () -insertStakeSlice syncEnv (Generic.Slice slice finalSlice) = do - insertEpochStake syncEnv network (Generic.sliceEpochNo slice) (Map.toList $ Generic.sliceDistr slice) - when finalSlice $ do - lift $ DB.updateSetComplete $ unEpochNo $ Generic.sliceEpochNo slice - size <- lift $ DB.queryEpochStakeCount (unEpochNo $ Generic.sliceEpochNo slice) - liftIO - . logInfo tracer - $ mconcat ["Inserted ", show size, " EpochStake for ", show (Generic.sliceEpochNo slice)] +insertStakeSlice syncEnv stakeSliceRes = do + case stakeSliceRes of + Generic.NoSlices -> pure () + Generic.Slice slice isfinalSlice -> do + insertEpochStake + syncEnv + network + (Generic.sliceEpochNo slice) + (Map.toList $ Generic.sliceDistr slice) + when isfinalSlice $ do + lift $ DB.updateSetComplete $ unEpochNo $ Generic.sliceEpochNo slice + size <- lift $ DB.queryEpochStakeCount (unEpochNo $ Generic.sliceEpochNo slice) + liftIO + . logInfo tracer + $ mconcat ["Inserted ", show size, " EpochStake for ", show (Generic.sliceEpochNo slice)] where tracer :: Trace IO Text tracer = getTrace syncEnv @@ -368,8 +374,11 @@ splittRecordsEvery val = go where go [] = [] go ys = - let (as, bs) = splitAt val ys - in as : go bs + if length ys > val + then + let (as, bs) = splitAt val ys + in as : go bs + else [ys] insertPoolDepositRefunds :: (MonadBaseControl IO m, MonadIO m) => diff --git a/cardano-db-sync/src/Cardano/DbSync/Fix/EpochStake.hs b/cardano-db-sync/src/Cardano/DbSync/Fix/EpochStake.hs index c1ff28caf..c5f46fb58 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Fix/EpochStake.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Fix/EpochStake.hs @@ -20,12 +20,12 @@ import Database.Persist.Sql (SqlBackend) migrateStakeDistr :: (MonadIO m, MonadBaseControl IO m) => SyncEnv -> Strict.Maybe CardanoLedgerState -> ExceptT SyncNodeError (ReaderT SqlBackend m) Bool migrateStakeDistr env mcls = - case (envLedgerEnv env, mcls) of - (HasLedger lenv, Strict.Just cls) -> do + case mcls of + (Strict.Just cls) -> do ems <- lift DB.queryAllExtraMigrations runWhen (not $ DB.isStakeDistrComplete ems) $ do liftIO $ logInfo trce "Starting Stake Distribution migration on table epoch_stake" - let stakeSlice = getStakeSlice lenv cls True + let stakeSlice = getStakeSlice cls True case stakeSlice of NoSlices -> liftIO $ logInsert 0 @@ -40,9 +40,9 @@ migrateStakeDistr env mcls = lift $ DB.insertEpochStakeProgress (mkProgress True <$> [minEpoch .. (maxEpoch - 1)]) lift $ DB.insertEpochStakeProgress [mkProgress isFinal maxEpoch] - _ -> pure () + _otherwise -> pure () lift $ DB.insertExtraMigration DB.StakeDistrEnded - _ -> pure False + _otherwise -> pure False where trce = getTrace env mkProgress isCompleted e = diff --git a/cardano-db-sync/src/Cardano/DbSync/Ledger/State.hs b/cardano-db-sync/src/Cardano/DbSync/Ledger/State.hs index 8df2f9a65..6b67eab1f 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Ledger/State.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Ledger/State.hs @@ -250,7 +250,7 @@ applyBlock env blk = do , apOldLedger = Strict.Just oldState , apDeposits = maybeToStrict $ Generic.getDeposits newLedgerState , apSlotDetails = details - , apStakeSlice = getStakeSlice env newState False + , apStakeSlice = getStakeSlice newState False , apEvents = ledgerEvents , apGovActionState = getGovState newLedgerState , apDepositsMap = DepositsMap deposits @@ -305,16 +305,15 @@ getGovState ls = case ledgerState ls of Just $ Consensus.shelleyLedgerState cls ^. Shelley.newEpochStateGovStateL _ -> Nothing -getStakeSlice :: HasLedgerEnv -> CardanoLedgerState -> Bool -> Generic.StakeSliceRes -getStakeSlice env cls isMigration = +getStakeSlice :: CardanoLedgerState -> Bool -> Generic.StakeSliceRes +getStakeSlice cls isMigration = case clsEpochBlockNo cls of EpochBlockNo n -> Generic.getStakeSlice - (leProtocolInfo env) n (clsState cls) isMigration - _ -> Generic.NoSlices + _otherwise -> Generic.NoSlices getSliceMeta :: Generic.StakeSliceRes -> Maybe (Bool, EpochNo) getSliceMeta (Generic.Slice (Generic.StakeSlice epochNo _) isFinal) = Just (isFinal, epochNo) diff --git a/cardano-db-sync/src/Cardano/DbSync/Rollback.hs b/cardano-db-sync/src/Cardano/DbSync/Rollback.hs index 7f677f265..a53ed9779 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Rollback.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Rollback.hs @@ -55,6 +55,7 @@ rollbackFromBlockNo syncEnv blkNo = do DB.deleteDrepDistr epochNo DB.deleteRewardRest epochNo DB.deletePoolStat epochNo + DB.deleteEpochStake epochNo DB.setNullEnacted epochNo DB.setNullRatified epochNo DB.setNullDropped epochNo diff --git a/cardano-db/src/Cardano/Db/Delete.hs b/cardano-db/src/Cardano/Db/Delete.hs index d26a32e65..ce1e85293 100644 --- a/cardano-db/src/Cardano/Db/Delete.hs +++ b/cardano-db/src/Cardano/Db/Delete.hs @@ -19,6 +19,7 @@ module Cardano.Db.Delete ( deletePoolStat, deleteAdaPots, deleteTxOut, + deleteEpochStake, -- for testing queryFirstAndDeleteAfter, ) where @@ -255,3 +256,7 @@ deleteAdaPots blkId = do deleteTxOut :: MonadIO m => ReaderT SqlBackend m Int64 deleteTxOut = deleteWhereCount ([] :: [Filter TxOut]) + +deleteEpochStake :: MonadIO m => Word64 -> ReaderT SqlBackend m () +deleteEpochStake epochNum = + deleteWhere [EpochStakeEpochNo >=. epochNum]