Simplify Schema migrations

cabal.project

@@ -7,6 +7,8 @@ packages:
   cardano-db-tool
   cardano-smash-server
   cardano-chain-gen
+--  ../persistent/persistent-postgresql
+--  ../persistent/persistent
 
 constraints:
     libsystemd-journal >= 1.4.4

cardano-chain-gen/test/Main.hs

@@ -36,8 +36,8 @@ tests iom = do
       testGroup
         "cardano-chain-gen"
           [
-            testProperty "QSM" $ Property.prop_empty_blocks iom knownMigrationsPlain
-          , Babbage.unitTests iom knownMigrationsPlain
+            Babbage.unitTests iom knownMigrationsPlain
+          , testProperty "QSM" $ Property.prop_empty_blocks iom knownMigrationsPlain
           , Alonzo.unitTests iom knownMigrationsPlain
           ]
   where

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

@@ -217,6 +217,7 @@ mkSyncNodeParams staticDir mutableDir = do
     , enpHasLedger = True
     , enpSkipFix = True
     , enpOnlyFix = False
+    , enpForceIndexes = False
     , enpMaybeRollback = Nothing
     }
 
@@ -244,7 +245,7 @@ withFullConfig' hasFingerprint config testLabel action iom migr = do
     fingerFile <- if hasFingerprint then Just <$> prepareFingerprintFile testLabel else pure Nothing
     let dbsyncParams = syncNodeParams cfg
     -- Set to True to disable logging, False to enable it.
-    trce <- if True
+    trce <- if False
               then pure nullTracer
               else configureLogging dbsyncParams "db-sync-node"
     let dbsyncRun = runDbSync emptyMetricsSetters migr iom trce dbsyncParams True 35 35

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

@@ -19,6 +19,7 @@ module Test.Cardano.Db.Mock.Property.Property
 import           Control.Monad (void, when)
 import           Control.Monad.Class.MonadSTM.Strict (MonadSTM (atomically))
 import           Data.Foldable
+import qualified Data.List as List
 import           Data.Text (Text)
 import           Data.TreeDiff (defaultExprViaShow)
 import           GHC.Generics (Generic, Generic1)
@@ -56,18 +57,39 @@ deriving stock instance Show (Command Symbolic)
 deriving stock instance Show (Command Concrete)
 
 data Model r = Model
-    { serverTip :: Maybe BlockNo
-    , dbSyncTip :: Maybe BlockNo
+    { serverChain :: [Int]
+    , dbSyncChain :: [Int]
+    , eventualDbSyncChain :: [Int]
     , dbSynsIsOn :: Bool
     , dbSynsHasSynced :: Bool -- This is used just to avoid restarting the node too early.
     }
     deriving stock (Generic, Show)
 
+serverTip :: Model r -> Maybe BlockNo
+serverTip m = case serverChain m of
+    [] -> Nothing
+    ls -> Just $ BlockNo $ fromIntegral $ length ls
+
+dbSyncTip :: Model r -> Maybe BlockNo
+dbSyncTip m = case dbSyncChain m of
+    [] -> Nothing
+    ls ->
+          let tp = fromIntegral $ length ls
+              tp' = fromIntegral $ length $ eventualDbSyncChain m
+          in fst <$> Just (BlockNo tp, BlockNo tp') -- TODO return both and fix
+
+rollbackChain :: Maybe BlockNo -> [Int] -> [Int]
+rollbackChain Nothing _ = []
+rollbackChain (Just blkNo) ls
+    | len <- fromIntegral (unBlockNo blkNo), length ls >= len
+    =  take len ls
+rollbackChain _ _ = error "failed to rollback"
+
 instance ToExpr (Model Symbolic)
 instance ToExpr (Model Concrete)
 
 initModel :: Model r
-initModel = Model Nothing Nothing False False
+initModel = Model [] [] [] False False
 
 instance ToExpr BlockNo where
     toExpr = defaultExprViaShow
@@ -83,32 +105,39 @@ deriving stock instance Show (Response Symbolic)
 deriving stock instance Read (Response Symbolic)
 deriving stock instance Show (Response Concrete)
 
+transitionConsistency :: [Int] -> [Int] -> [Int]
+transitionConsistency sChain dbChain =
+    if sChain `List.isPrefixOf` dbChain
+    then dbChain
+    else sChain
+
 transition :: Model r -> Command r -> Response r -> Model r
 transition m cmd resp = case (cmd, resp) of
     (_, Error msg) -> error msg
-    (RollForward _, _) | dbSynsIsOn m ->
-        m { serverTip = nextTip $ serverTip m, dbSyncTip = nextTip $ dbSyncTip m}
-    (RollForward _, _) ->
-        m { serverTip = nextTip $ serverTip m}
-    (RollBack blkNo, _) | dbSynsIsOn m ->
-        m { serverTip = blkNo, dbSyncTip = blkNo }
+    (RollForward n, _) | dbSynsIsOn m ->
+        let serverChain' = serverChain m ++ [n]
+            dbSyncChain' = transitionConsistency serverChain' (dbSyncChain m)
+        in m { serverChain = serverChain'
+             , dbSyncChain = dbSyncChain'
+             }
+    (RollForward n, _) ->
+        m { serverChain = serverChain m ++ [n] }
     (RollBack blkNo, _) ->
-        m { serverTip = blkNo }
+        m { serverChain = rollbackChain blkNo (serverChain m) }
     (StopDBSync, _) | dbSynsIsOn m ->
         m { dbSynsIsOn = False }
     (StopDBSync, _) ->
         error "Tried to stop stopped DBSync"
     (StartDBSync, _) | dbSynsIsOn m ->
         error "Tried to start started DBSync"
     (StartDBSync, _) ->
-        m { dbSyncTip = serverTip m, dbSynsIsOn = True , dbSynsHasSynced = False }
+        m { dbSyncChain = transitionConsistency (serverChain m) (dbSyncChain m)
+          , dbSynsIsOn = True
+          , dbSynsHasSynced = False }
     (RestartNode, _) ->
         m
     (AssertBlockNo _, _) ->
         m { dbSynsHasSynced = True}
-  where
-    nextTip Nothing = Just $ BlockNo 1
-    nextTip (Just b) = Just $ b + 1
 
 precondition :: Model Symbolic -> Command Symbolic -> Logic
 precondition m cmd = case cmd of

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

@@ -10,7 +10,6 @@ import qualified Cardano.Crypto.Hash as Crypto
 
 import qualified Cardano.Db as DB
 
-import           Cardano.DbSync.Era.Shelley.Generic.Block (blockHash)
 import           Cardano.DbSync.Era.Shelley.Generic.Util
 
 import           Cardano.Ledger.Alonzo.Data
@@ -33,12 +32,9 @@ import           Cardano.Mock.Forging.Types
 
 import           Cardano.SMASH.Server.PoolDataLayer
 import           Cardano.SMASH.Server.Types
-
 import           Control.Monad
 import           Control.Monad.Class.MonadSTM.Strict
 
-import           Data.ByteString (ByteString)
-import qualified Data.ByteString as BS
 import qualified Data.Map as Map
 import           Data.Text (Text)
 
@@ -65,12 +61,6 @@ unitTests iom knownMigrations =
           , test "restart db-sync" restartDBSync
           , test "sync small chain" addSimpleChain
           ]
-      , testGroup "rollbacks"
-          [ test "simple rollback" simpleRollback
-          , test "sync bigger chain" bigChain
-          , test "rollback while db-sync is off" restartAndRollback
-          , test "rollback further" rollbackFurther
-          ]
       , testGroup "blocks with txs"
           [ test "simple tx" addSimpleTx
           , test "consume utxo same block" consumeSameBlock
@@ -197,97 +187,6 @@ restartDBSync =
   where
     testLabel = "restartDBSync-alonzo"
 
-simpleRollback :: IOManager -> [(Text, Text)] -> Assertion
-simpleRollback = do
-    withFullConfig alonzoConfigDir testLabel $ \interpreter mockServer dbSync -> do
-      blk0 <- forgeNext interpreter mockBlock0
-      blk1 <- forgeNext interpreter mockBlock1
-      blk2 <- forgeNext interpreter mockBlock2
-      atomically $ addBlock mockServer blk0
-      startDBSync dbSync
-      atomically $ addBlock mockServer blk1
-      atomically $ addBlock mockServer blk2
-      assertBlockNoBackoff dbSync 3
-
-      atomically $ rollback mockServer (blockPoint blk1)
-      assertBlockNoBackoff dbSync 2
-  where
-    testLabel = "simpleRollback-alonzo"
-
-bigChain :: IOManager -> [(Text, Text)] -> Assertion
-bigChain =
-    withFullConfig alonzoConfigDir testLabel $ \interpreter mockServer dbSync -> do
-      replicateM_ 101 (forgeNextFindLeaderAndSubmit interpreter mockServer [])
-      startDBSync dbSync
-      assertBlockNoBackoff dbSync 101
-
-      blks' <- replicateM 100 (forgeNextFindLeaderAndSubmit interpreter mockServer [])
-      assertBlockNoBackoff dbSync 201
-
-      replicateM_ 5 (forgeNextFindLeaderAndSubmit interpreter mockServer [])
-      assertBlockNoBackoff dbSync 206
-
-      atomically $ rollback mockServer (blockPoint $ last blks')
-      assertBlockNoBackoff dbSync 201
-  where
-    testLabel = "bigChain-alonzo"
-
-restartAndRollback :: IOManager -> [(Text, Text)] -> Assertion
-restartAndRollback =
-    withFullConfig alonzoConfigDir testLabel $ \interpreter mockServer dbSync -> do
-      forM_ (replicate 101 mockBlock0) (forgeNextAndSubmit interpreter mockServer)
-      startDBSync dbSync
-      assertBlockNoBackoff dbSync 101
-
-      blks <- forM (replicate 100 mockBlock0) (forgeNextAndSubmit interpreter mockServer)
-      assertBlockNoBackoff dbSync 201
-
-      forM_ (replicate 5 mockBlock2) (forgeNextAndSubmit interpreter mockServer)
-      assertBlockNoBackoff dbSync 206
-
-      stopDBSync dbSync
-      atomically $ rollback mockServer (blockPoint $ last blks)
-      startDBSync dbSync
-      assertBlockNoBackoff dbSync 201
-  where
-    testLabel = "restartAndRollback-alonzo"
-
--- wibble
-rollbackFurther :: IOManager -> [(Text, Text)] -> Assertion
-rollbackFurther =
-  withFullConfig alonzoConfigDir testLabel $ \interpreter mockServer dbSync -> do
-    blks <- replicateM 80 (forgeNextFindLeaderAndSubmit interpreter mockServer [])
-    startDBSync dbSync
-    assertBlockNoBackoff dbSync 80
-
-    -- We want to test that db-sync rollbacks temporarily to block 34
-    -- and then syncs further. We add references to blocks 34 and 35, to
-    -- validate later that one is deleted through cascade, but the other was not
-    -- because a checkpoint was found.
-    let blockHash1 = hfBlockHash (blks !! 33)
-    Right bid1 <- queryDBSync dbSync $ DB.queryBlockId blockHash1
-    cm1 <- queryDBSync dbSync $ DB.insertCostModel $ DB.CostModel (BS.pack $ replicate 32 1) "{\"1\" : 1}" bid1
-
-    let blockHash2 = hfBlockHash (blks !! 34)
-    Right bid2 <- queryDBSync dbSync $ DB.queryBlockId blockHash2
-    cm2 <- queryDBSync dbSync $ DB.insertCostModel $ DB.CostModel (BS.pack $ replicate 32 2) "{\"2\" : 2}" bid2
-
-    -- Note that there is no epoch change, which would add a new entry, since we have
-    -- 80 blocks and not 100, which is the expected blocks/epoch. This also means there
-    -- no epoch snapshots
-    assertEqQuery dbSync DB.queryCostModel [cm1, cm2] "Unexpected CostModels"
-
-    -- server tells db-sync to rollback to point 50. However db-sync only has
-    -- a snapshot at block 34, 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 !! 50)
-    assertBlockNoBackoff dbSync 51
-
-    assertEqQuery dbSync DB.queryCostModel [cm1] "Unexpected CostModel"
-  where
-    testLabel = "rollbackFurther-alonzo"
-
 addSimpleTx :: IOManager -> [(Text, Text)] -> Assertion
 addSimpleTx =
     withFullConfig alonzoConfigDir testLabel $ \interpreter mockServer dbSync -> do
@@ -1479,11 +1378,3 @@ poolDelist =
       assertPoolLayerCounters dbSync (1,1) [(PoolIndexNew 0, (Right True, True, False))] st
   where
     testLabel = "poolDelist-alonzo"
-
-
-hfBlockHash :: CardanoBlock -> ByteString
-hfBlockHash blk =
-  case blk of
-    BlockShelley sblk -> blockHash sblk
-    BlockAlonzo ablk -> blockHash ablk
-    _ -> error "hfBlockHash: unsupported block type"