diff --git a/cardano-chain-gen/src/Cardano/Mock/Forging/Interpreter.hs b/cardano-chain-gen/src/Cardano/Mock/Forging/Interpreter.hs index ae9757bae..685100ae5 100644 --- a/cardano-chain-gen/src/Cardano/Mock/Forging/Interpreter.hs +++ b/cardano-chain-gen/src/Cardano/Mock/Forging/Interpreter.hs @@ -11,7 +11,8 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Mock.Forging.Interpreter - ( CardanoBlock + ( Interpreter (..) + , CardanoBlock , MockBlock (..) , NodeId (..) , initInterpreter 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 4c329b717..9b78d5160 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs @@ -1,12 +1,17 @@ +{-# LANGUAGE TypeApplications #-} + module Test.Cardano.Db.Mock.Config where import Cardano.Prelude (panic) +import Control.Concurrent.Async import Control.Monad.Extra (eitherM) import Control.Monad.Trans.Except (runExceptT) +import Control.Tracer (nullTracer) import Data.Text (Text) import qualified Data.Text as Text import System.FilePath.Posix (()) +import System.Directory import Ouroboros.Consensus.Config import qualified Ouroboros.Consensus.Node.ProtocolInfo as Consensus @@ -84,5 +89,24 @@ emptyMetricsSetters = MetricSetters , metricsSetDbSlotHeight = \_ -> pure () } +withFullConfig :: FilePath -> FilePath + -> (Interpreter -> ServerHandle IO CardanoBlock -> IO (Async ()) -> IO ()) + -> IOManager -> [(Text, Text)] -> IO () +withFullConfig staticDir mutableDir action iom migr = do + recreateDir mutableDir + cfg <- mkConfig staticDir mutableDir + interpreter <- initInterpreter (protocolInfoForging cfg) nullTracer + let initSt = Consensus.pInfoInitLedger $ protocolInfo cfg + -- TODO: get 42 from config + mockServer <- forkServerThread @CardanoBlock iom (topLevelConfig cfg) initSt (NetworkMagic 42) $ unSocketPath (enpSocketPath $ syncNodeParams cfg) + -- we dont forge dbsync here. Just prepare it as an action + let dbSync = async $ runDbSyncNode emptyMetricsSetters True migr (syncNodeParams cfg) + action interpreter mockServer dbSync + +recreateDir :: FilePath -> IO () +recreateDir path = do + removePathForcibly path + createDirectoryIfMissing True path + textShow :: Show a => a -> Text textShow = Text.pack . show diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit.hs index 29b3ff7c6..29706949d 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit.hs @@ -2,29 +2,16 @@ module Test.Cardano.Db.Mock.Unit where -import Cardano.Prelude (throwIO) - - import Control.Tracer (nullTracer) -import Control.Concurrent (threadDelay) import Control.Concurrent.Async import Control.Monad -import Control.Monad.IO.Class import Control.Monad.Class.MonadSTM.Strict import Data.Text (Text) -import qualified Data.Text as Text -import System.Directory import System.FilePath hiding (isValid) import Cardano.Ledger.Slot (BlockNo (..)) -import qualified Ouroboros.Consensus.Node.ProtocolInfo as Consensus - import Ouroboros.Network.Block (blockNo, blockPoint) -import Ouroboros.Network.Magic - -import Cardano.DbSync (runDbSyncNode) -import Cardano.DbSync.Config.Types hiding (CardanoBlock) import Cardano.Mock.ChainSync.Server import Cardano.Mock.Forging.Interpreter @@ -40,7 +27,7 @@ unitTests :: IOManager -> [(Text, Text)] -> TestTree unitTests iom knownMigrations = testGroup "unit tests" [ testCase "Forge some blocks" forgeBlocks - , testCase "Add one Simple block" (simpleRollback iom knownMigrations) + , testCase "Add one Simple block" (bigChainRestart iom knownMigrations) ] rootTestDir :: FilePath @@ -51,7 +38,6 @@ configDir = rootTestDir "config" forgeBlocks :: IO () forgeBlocks = do - let testDir = rootTestDir "temp/forgeBlocks" recreateDir testDir cfg <- mkConfig configDir testDir interpreter <- initInterpreter (protocolInfoForging cfg) nullTracer @@ -61,154 +47,114 @@ forgeBlocks = do let blkNo = blockNo block2 assertBool (show blkNo <> " /= " <> "2") $ blkNo == BlockNo 2 + where + testDir = rootTestDir "temp/forgeBlocks" addSimple :: IOManager -> [(Text, Text)] -> IO () -addSimple iom knownMigrations = do - let testDir = rootTestDir "temp/addSimple" - recreateDir testDir - -- create all keys, configs and genesis files from a template - -- Normally these will be already hard-coded. - when False $ - setupTestsDir testDir - -- create the configuration for dbsync and the interpreter - cfg <- mkConfig configDir testDir - -- initiate the interpreter - interpreter <- initInterpreter (protocolInfoForging cfg) nullTracer - -- translate the block to a real Cardano block. - blk <- forgeNext interpreter mockBlock0 - let initSt = Consensus.pInfoInitLedger $ protocolInfo cfg - -- fork the mocked chainsync server - mockServer <- liftIO $ forkServerThread @CardanoBlock iom (topLevelConfig cfg) initSt (NetworkMagic 42) $ unSocketPath (enpSocketPath $ syncNodeParams cfg) - atomically $ addBlock mockServer blk - -- start db-sync and let it sync - dbSync <- liftIO $ async $ runDbSyncNode emptyMetricsSetters True knownMigrations (syncNodeParams cfg) - assertBlockNoBackoff 0 +addSimple = + withFullConfig configDir testDir $ \interpreter mockServer asyncDBSync -> do + -- translate the block to a real Cardano block. + blk <- forgeNext interpreter mockBlock0 + atomically $ addBlock mockServer blk + -- start db-sync and let it sync + _ <- asyncDBSync + assertBlockNoBackoff 0 + where + testDir = rootTestDir "temp/addSimple" addSimpleChain :: IOManager -> [(Text, Text)] -> IO () -addSimpleChain iom knownMigrations = do - let testDir = rootTestDir "temp/addSimpleChain" - recreateDir testDir - -- create all keys, configs and genesis files from a template - -- Normally these will be already hard-coded. - when False $ - setupTestsDir testDir - -- create the configuration for dbsync and the interpreter - cfg <- mkConfig configDir testDir - -- initiate the interpreter - interpreter <- initInterpreter (protocolInfoForging cfg) nullTracer - -- translate the block to a real Cardano block. - blk0 <- forgeNext interpreter mockBlock0 - blk1 <- forgeNext interpreter mockBlock1 - blk2 <- forgeNext interpreter mockBlock2 - let initSt = Consensus.pInfoInitLedger $ protocolInfo cfg - -- fork the mocked chainsync server - mockServer <- liftIO $ forkServerThread @CardanoBlock iom (topLevelConfig cfg) initSt (NetworkMagic 42) $ unSocketPath (enpSocketPath $ syncNodeParams cfg) - atomically $ addBlock mockServer blk0 - -- start db-sync and let it sync - dbSync <- liftIO $ async $ runDbSyncNode emptyMetricsSetters True knownMigrations (syncNodeParams cfg) - atomically $ addBlock mockServer blk1 - atomically $ addBlock mockServer blk2 - assertBlockNoBackoff 2 +addSimpleChain = + withFullConfig configDir testDir $ \interpreter mockServer asyncDBSync -> do + -- translate the blocks to real Cardano blocks. + blk0 <- forgeNext interpreter mockBlock0 + blk1 <- forgeNext interpreter mockBlock1 + blk2 <- forgeNext interpreter mockBlock2 + atomically $ addBlock mockServer blk0 + -- start db-sync and let it sync + _ <- asyncDBSync + -- add more blocks + atomically $ addBlock mockServer blk1 + atomically $ addBlock mockServer blk2 + assertBlockNoBackoff 2 + where + testDir = rootTestDir "temp/addSimpleChain" restartDBSync :: IOManager -> [(Text, Text)] -> IO () -restartDBSync iom knownMigrations = do - let testDir = rootTestDir "temp/restartDBSync" - recreateDir testDir - -- create all keys, configs and genesis files from a template - -- Normally these will be already hard-coded. - when False $ - setupTestsDir testDir - -- create the configuration for dbsync and the interpreter - cfg <- mkConfig configDir testDir - -- initiate the interpreter - interpreter <- initInterpreter (protocolInfoForging cfg) nullTracer - -- translate the block to a real Cardano block. - blk <- forgeNext interpreter mockBlock0 - -- fork the mocked chainsync server - let initSt = Consensus.pInfoInitLedger $ protocolInfo cfg - mockServer <- liftIO $ forkServerThread @CardanoBlock iom (topLevelConfig cfg) initSt (NetworkMagic 42) $ unSocketPath (enpSocketPath $ syncNodeParams cfg) - atomically $ addBlock mockServer blk - -- start db-sync and let it sync - dbSync <- async $ runDbSyncNode emptyMetricsSetters True knownMigrations (syncNodeParams cfg) - assertBlockNoBackoff 0 - cancel dbSync - _dbSync' <- async $ runDbSyncNode emptyMetricsSetters True knownMigrations (syncNodeParams cfg) - assertBlockNoBackoff 0 +restartDBSync = + withFullConfig configDir testDir $ \interpreter mockServer asyncDBSync -> do + -- translate the block to a real Cardano block. + blk <- forgeNext interpreter mockBlock0 + atomically $ addBlock mockServer blk + -- start db-sync and let it sync + dbSync <- asyncDBSync + assertBlockNoBackoff 0 + + cancel dbSync + -- The server sees a separate client here + _dbSync' <- asyncDBSync + assertBlockNoBackoff 0 + where + testDir = rootTestDir "temp/restartDBSync" simpleRollback :: IOManager -> [(Text, Text)] -> IO () -simpleRollback iom knownMigrations = do - let testDir = rootTestDir "temp/simpleRollback" - recreateDir testDir - -- create all keys, configs and genesis files from a template - -- Normally these will be already hard-coded. - when False $ - setupTestsDir testDir - -- create the configuration for dbsync and the interpreter - cfg <- mkConfig configDir testDir - -- initiate the interpreter - interpreter <- initInterpreter (protocolInfoForging cfg) nullTracer - -- translate the block to a real Cardano block. - blk0 <- forgeNext interpreter mockBlock0 - blk1 <- forgeNext interpreter mockBlock1 - blk2 <- forgeNext interpreter mockBlock2 - let initSt = Consensus.pInfoInitLedger $ protocolInfo cfg - -- fork the mocked chainsync server - mockServer <- forkServerThread @CardanoBlock iom (topLevelConfig cfg) initSt (NetworkMagic 42) $ unSocketPath (enpSocketPath $ syncNodeParams cfg) - atomically $ addBlock mockServer blk0 - -- start db-sync and let it sync - _ <- async $ runDbSyncNode emptyMetricsSetters True knownMigrations (syncNodeParams cfg) - atomically $ addBlock mockServer blk1 - atomically $ addBlock mockServer blk2 - assertBlockNoBackoff 2 - atomically $ rollback mockServer (blockPoint blk1) - assertBlockNoBackoff 1 +simpleRollback = do + withFullConfig configDir testDir $ \interpreter mockServer asyncDBSync -> do + blk0 <- forgeNext interpreter mockBlock0 + blk1 <- forgeNext interpreter mockBlock1 + blk2 <- forgeNext interpreter mockBlock2 + atomically $ addBlock mockServer blk0 + -- start db-sync and let it sync + _ <- asyncDBSync + atomically $ addBlock mockServer blk1 + atomically $ addBlock mockServer blk2 + assertBlockNoBackoff 2 + + atomically $ rollback mockServer (blockPoint blk1) + assertBlockNoBackoff 1 + where + testDir = rootTestDir "temp/simpleRollback" bigChain :: IOManager -> [(Text, Text)] -> IO () -bigChain iom knownMigrations = do - let testDir = rootTestDir "temp/bigChain" - recreateDir testDir - cfg <- mkConfig configDir testDir - interpreter <- initInterpreter (protocolInfoForging cfg) nullTracer - let initSt = Consensus.pInfoInitLedger $ protocolInfo cfg - mockServer <- forkServerThread @CardanoBlock iom (topLevelConfig cfg) initSt (NetworkMagic 42) $ unSocketPath (enpSocketPath $ syncNodeParams cfg) - blks <- forM (take 101 $ repeat mockBlock0) (forgeNext interpreter) - atomically $ forM_ blks $ addBlock mockServer - _ <- async $ runDbSyncNode emptyMetricsSetters True knownMigrations (syncNodeParams cfg) - assertBlockNoBackoff 100 - blks' <- forM (take 100 $ repeat mockBlock1) (forgeNext interpreter) - atomically $ forM_ blks' $ addBlock mockServer - assertBlockNoBackoff 200 - blks'' <- forM (take 5 $ repeat mockBlock2) (forgeNext interpreter) - atomically $ forM_ blks'' $ addBlock mockServer - assertBlockNoBackoff 205 - atomically $ rollback mockServer (blockPoint $ last blks') - assertBlockNoBackoff 200 +bigChain = + withFullConfig configDir testDir $ \interpreter mockServer asyncDBSync -> do + blks <- forM (take 101 $ repeat mockBlock0) (forgeNext interpreter) + atomically $ forM_ blks $ addBlock mockServer + _ <- asyncDBSync + assertBlockNoBackoff 100 + + blks' <- forM (take 100 $ repeat mockBlock1) (forgeNext interpreter) + atomically $ forM_ blks' $ addBlock mockServer + assertBlockNoBackoff 200 + + blks'' <- forM (take 5 $ repeat mockBlock2) (forgeNext interpreter) + atomically $ forM_ blks'' $ addBlock mockServer + assertBlockNoBackoff 205 + + atomically $ rollback mockServer (blockPoint $ last blks') + assertBlockNoBackoff 200 + where + testDir = rootTestDir "temp/bigChain" bigChainRestart :: IOManager -> [(Text, Text)] -> IO () -bigChainRestart iom knownMigrations = do - let testDir = rootTestDir "temp/bigChainRestart" - recreateDir testDir - cfg <- mkConfig configDir testDir - interpreter <- initInterpreter (protocolInfoForging cfg) nullTracer - let initSt = Consensus.pInfoInitLedger $ protocolInfo cfg - mockServer <- forkServerThread @CardanoBlock iom (topLevelConfig cfg) initSt (NetworkMagic 42) $ unSocketPath (enpSocketPath $ syncNodeParams cfg) - blks <- forM (take 101 $ repeat mockBlock0) (forgeNext interpreter) - atomically $ forM_ blks $ addBlock mockServer - dbSync <- async $ runDbSyncNode emptyMetricsSetters True knownMigrations (syncNodeParams cfg) - assertBlockNoBackoff 100 - blks' <- forM (take 100 $ repeat mockBlock1) (forgeNext interpreter) - atomically $ forM_ blks' $ addBlock mockServer - assertBlockNoBackoff 200 - blks'' <- forM (take 5 $ repeat mockBlock2) (forgeNext interpreter) - atomically $ forM_ blks'' $ addBlock mockServer - assertBlockNoBackoff 205 - cancel dbSync - atomically $ rollback mockServer (blockPoint $ last blks') - _ <- async $ runDbSyncNode emptyMetricsSetters True knownMigrations (syncNodeParams cfg) - assertBlockNoBackoff 200 - -recreateDir :: FilePath -> IO () -recreateDir path = do - removePathForcibly path - createDirectoryIfMissing True path +bigChainRestart = + withFullConfig configDir testDir $ \interpreter mockServer asyncDBSync -> do + blks <- forM (take 101 $ repeat mockBlock0) (forgeNext interpreter) + atomically $ forM_ blks $ addBlock mockServer + dbSync <- asyncDBSync + assertBlockNoBackoff 100 + + blks' <- forM (take 100 $ repeat mockBlock1) (forgeNext interpreter) + atomically $ forM_ blks' $ addBlock mockServer + assertBlockNoBackoff 200 + + blks'' <- forM (take 5 $ repeat mockBlock2) (forgeNext interpreter) + atomically $ forM_ blks'' $ addBlock mockServer + assertBlockNoBackoff 205 + + cancel dbSync + atomically $ rollback mockServer (blockPoint $ last blks') + _ <- asyncDBSync + assertBlockNoBackoff 200 + where + testDir = rootTestDir "temp/bigChainRestart" \ No newline at end of file