Add rollback further test

cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit.hs

@@ -1,17 +1,25 @@
 {-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Test.Cardano.Db.Mock.Unit where
 
 import           Control.Concurrent
 import           Control.Exception
 import           Control.Monad
 import           Control.Monad.Class.MonadSTM.Strict
+import           Data.ByteString (ByteString)
 import           Data.Text (Text)
 
 import           Cardano.Ledger.Slot (BlockNo (..))
 
+import           Ouroboros.Consensus.Cardano.Block hiding (CardanoBlock)
+
 import           Ouroboros.Network.Block (blockNo, blockPoint)
 
+import qualified Cardano.Db as DB
+
+import           Cardano.DbSync.Era.Shelley.Generic.Block (blockHash)
+
 import           Cardano.Mock.ChainSync.Server
 import           Cardano.Mock.Forging.Interpreter
 import           Cardano.Mock.Forging.Types
@@ -35,6 +43,7 @@ unitTests iom knownMigrations =
       , test "simple rollback" simpleRollback
       , test "sync bigger chain" bigChain
       , test "rollback while db-sync is off" restartAndRollback
+      , test "rollback further" rollbackFurther
       , test "genesis config without pool" configNoPools
       , test "genesis config without stakes" configNoStakes
       , test "simple tx" addSimpleTx
@@ -169,6 +178,39 @@ restartAndRollback =
   where
     testLabel = "restartAndRollback"
 
+rollbackFurther :: IOManager -> [(Text, Text)] -> Assertion
+rollbackFurther =
+    withFullConfig defaultConfigDir testLabel $ \interpreter mockServer dbSync -> do
+    blks <- forM (replicate 201 mockBlock0) (forgeNext interpreter)
+    atomically $ forM_ blks $ addBlock mockServer
+    startDBSync dbSync
+    assertBlockNoBackoff dbSync 200
+
+    -- We want to test that db-sync rollbacks temporarily to block 99
+    -- and then syncs further. We add references to blocks 99 and 100, to
+    -- validate later that one is deleted through cascade, but the other was not
+    -- because a checkpoint was found.
+    let blockHash1 = hfBlockHash $ (blks !! 99)
+    Right bid1 <- queryDBSync dbSync $ DB.queryBlockId blockHash1
+    cm1 <- queryDBSync dbSync $ DB.insertCostModel $ DB.CostModel "{\"1\" : 1}" bid1
+
+    let blockHash2 = hfBlockHash $ (blks !! 100)
+    Right bid2 <- queryDBSync dbSync $ DB.queryBlockId blockHash2
+    cm2 <- queryDBSync dbSync $ DB.insertCostModel $ DB.CostModel "{\"2\" : 2}" bid2
+
+    assertEqQuery dbSync DB.queryCostModel [cm1, cm2] "Unexpected CostModels"
+
+    -- server tells db-sync to rollback to point 150. However db-sync only haa
+    -- a snapshot at block 99, so it will go there first. There is no proper way
+    -- to test that db-sync temporarily is there, that's why we have this trick
+    -- with references.
+    atomically $ rollback mockServer (blockPoint $ blks !! 150)
+    assertBlockNoBackoff dbSync 150
+
+    assertEqQuery dbSync DB.queryCostModel [cm1] "Unexpected CostModel"
+  where
+    testLabel = "rollbackFurther"
+
 configNoPools :: IOManager -> [(Text, Text)] -> Assertion
 configNoPools =
     withFullConfig "config2" testLabel $ \_ _ dbSync -> do
@@ -322,3 +364,17 @@ fillEpochEqually interpreter mockServer = do
   where
     thirdEpoch = div 150 3
     skipSlots = 228
+
+hfBlockHash :: CardanoBlock -> ByteString
+hfBlockHash blk = case blk of
+  BlockShelley sblk -> blockHash sblk
+  BlockAlonzo ablk -> blockHash ablk
+  _ -> error "not supported block type"
+
+
+throwLeft :: Exception err => IO (Either err a) -> IO a
+throwLeft action = do
+  ma <- action
+  case ma of
+    Left err -> throwIO err
+    Right a -> pure a

cardano-chain-gen/test/Test/Cardano/Db/Mock/Validate.hs

@@ -43,6 +43,10 @@ assertBlockNoBackoff env blockNo =
 defaultDelays :: [Int]
 defaultDelays = [1,2,4,8,16,32,64]
 
+assertEqQuery :: (Eq a, Show a) => DBSyncEnv -> ReaderT SqlBackend (NoLoggingT IO) a -> a -> String -> IO ()
+assertEqQuery env query a msg = do
+    assertEqBackoff env query a [] msg
+
 assertEqBackoff :: (Eq a, Show a) => DBSyncEnv -> ReaderT SqlBackend (NoLoggingT IO) a -> a -> [Int] -> String -> IO ()
 assertEqBackoff env query a delays msg = do
     assertBackoff env query delays (== a) (\a' -> msg <> ": " <> show a' <> " /= " <> show a)

cardano-chain-gen/test/testfiles/fingerprint/rollbackFurther

@@ -0,0 +1 @@
+[74,147,200,230,277,286,290,381,403,434,564,617,660,764,867,879,908,1159,1193,1207,1213,1224,1237,1246,1262,1280,1285,1493,1494,1522,1653,1670,1873,2109,2111,2447,2468,2491,2537,2541,2581,2623,2682,2733,2766,2782,2814,2854,2862,2928,2967,3032,3080,3111,3128,3167,3176,3266,3320,3422,3455,3583,3591,3634,3696,3702,3750,3856,4029,4162,4246,4266,4368,4408,4415,4449,4608,4874,4890,4954,4988,4991,4999,5005,5071,5088,5101,5150,5194,5365,5417,5440,5542,5545,5662,5681,5772,5796,5892,5932,5947,5968,5977,5990,6111,6168,6235,6356,6400,6414,6427,6524,6580,6587,6649,6684,6695,6767,6863,6872,6965,6972,6987,7009,7051,7053,7096,7266,7284,7320,7408,7445,7506,7608,7683,7685,7744,7763,7846,7902,7950,8064,8100,8113,8168,8173,8215,8259,8283,8325,8328,8357,8409,8420,8490,8497,8513,8575,8576,8591,8607,8621,8626,8772,8785,8821,8850,8919,8932,8994,9013,9131,9133,9171,9210,9242,9251,9508,9534,9547,9585,9743,9744,9770,9775,9782,9915,9963,10012,10082,10088,10096,10140,10171,10217,10232,10329,10412,10427,10451,10519]

cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Block.hs

@@ -12,6 +12,7 @@ module Cardano.DbSync.Era.Shelley.Generic.Block
   , fromMaryBlock
   , fromAlonzoBlock
 
+  , blockHash
   , slotLeaderHash
   ) where
 

cardano-db/src/Cardano/Db/Query.hs

@@ -53,6 +53,7 @@ module Cardano.Db.Query
   , queryUtxoAtBlockNo
   , queryUtxoAtSlotNo
   , queryWithdrawalsUpToBlockNo
+  , queryCostModel
   , queryAdaPots
   , queryPoolOfflineData
   , queryPoolRegister
@@ -106,7 +107,7 @@ import           Database.Esqueleto.Legacy (Entity (..), From, InnerJoin (..), L
                    entityKey, entityVal, exists, from, in_, isNothing, just, limit, max_, min_,
                    notExists, not_, on, orderBy, select, subList_select, sum_, unSqlBackendKey,
                    unValue, val, where_, (&&.), (<=.), (==.), (>.), (>=.), (^.), (||.))
-import           Database.Persist.Sql (SqlBackend, selectList)
+import           Database.Persist.Sql (SelectOpt (Asc), SqlBackend, selectList)
 
 import           Cardano.Db.Error
 import           Cardano.Db.Schema
@@ -636,6 +637,10 @@ queryWithdrawalsUpToBlockNo blkNo = do
             pure $ sum_ (withDraw ^. WithdrawalAmount)
   pure $ unValueSumAda (listToMaybe res)
 
+queryCostModel :: MonadIO m => ReaderT SqlBackend m [CostModelId]
+queryCostModel =
+  fmap entityKey <$> selectList [] [Asc CostModelId]
+
 queryAdaPots :: MonadIO m => BlockId -> ReaderT SqlBackend m (Maybe AdaPots)
 queryAdaPots blkId = do
   res <- select . from $ \ adaPots -> do