Abstract common patterns in tests

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

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

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"