Merge pull request #1460 from input-output-hk/tests-command-line-args

Tests more command line args

Author: Cmdv

cardano-chain-gen/cardano-chain-gen.cabal

@@ -165,7 +165,10 @@ test-suite cardano-chain-gen
                         Test.Cardano.Db.Mock.Unit.Alonzo.Stake
                         Test.Cardano.Db.Mock.Unit.Alonzo.Tx
                         Test.Cardano.Db.Mock.Unit.Babbage
-                        Test.Cardano.Db.Mock.Unit.Babbage.Flag.ConsumedTxOut
+                        Test.Cardano.Db.Mock.Unit.Babbage.CommandLineArg.ConfigFile
+                        Test.Cardano.Db.Mock.Unit.Babbage.CommandLineArg.EpochDisabled
+                        Test.Cardano.Db.Mock.Unit.Babbage.CommandLineArg.ForceIndex
+                        Test.Cardano.Db.Mock.Unit.Babbage.CommandLineArg.MigrateConsumedPruneTxOut
                         Test.Cardano.Db.Mock.Unit.Babbage.InlineAndReference
                         Test.Cardano.Db.Mock.Unit.Babbage.Other
                         Test.Cardano.Db.Mock.Unit.Babbage.Plutus
@@ -209,6 +212,7 @@ test-suite cardano-chain-gen
                       , stm
                       , strict-stm
                       , tasty
+                      , tasty-expected-failure
                       , tasty-quickcheck
                       , text
                       , transformers

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

@@ -1,11 +1,14 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE RecordWildCards #-}
 
 module Test.Cardano.Db.Mock.Config (
   Config (..),
   DBSyncEnv (..),
-  TxOutParam(..),
+  CommandLineArgs(..),
+  TxOutParam (..),
+  initCommandLineArgs,
   babbageConfigDir,
   alonzoConfigDir,
   emptyMetricsSetters,
@@ -30,7 +33,8 @@ module Test.Cardano.Db.Mock.Config (
   startDBSync,
   withDBSyncEnv,
   withFullConfig,
-  withTxOutParamConfig,
+  withCustomConfig,
+  withCustomConfigAndLogs,
   withFullConfig',
 ) where
 
@@ -93,8 +97,26 @@ data DBSyncEnv = DBSyncEnv
 
 -- used for testing of tx out pruning feature
 data TxOutParam = TxOutParam
-  { paramMigrateConsumed :: Bool,
-    paramPruneTxOut :: Bool
+  { paramMigrateConsumed :: Bool
+  , paramPruneTxOut :: Bool
+  }
+
+data CommandLineArgs = CommandLineArgs
+  { claHasConfigFile :: Bool
+  , claEpochDisabled :: Bool
+  , claHasCache :: Bool
+  , claShouldUseLedger :: Bool
+  , claSkipFix :: Bool
+  , claOnlyFix :: Bool
+  , claForceIndexes :: Bool
+  , claHasMultiAssets :: Bool
+  , claHasMetadata :: Bool
+  , claHasPlutusExtra :: Bool
+  , claHasOfflineData :: Bool
+  , claTurboMode :: Bool
+  , claFullMode :: Bool
+  , claMigrateConsumed :: Bool
+  , claPruneTxOut :: Bool
   }
 
 babbageConfigDir :: FilePath
@@ -203,14 +225,14 @@ setupTestsDir dir = do
           0
           Nothing
 
-mkConfig :: FilePath -> FilePath -> Maybe TxOutParam -> IO Config
-mkConfig staticDir mutableDir mTxOutParam = do
+mkConfig :: FilePath -> FilePath -> CommandLineArgs -> IO Config
+mkConfig staticDir mutableDir cmdLineArgs = do
   config <- readSyncNodeConfig $ ConfigFile (staticDir </> "test-db-sync-config.json")
   genCfg <- either (error . Text.unpack . renderSyncNodeError) id <$> runExceptT (readCardanoGenesisConfig config)
   let pInfoDbSync = mkProtocolInfoCardano genCfg []
   creds <- mkShelleyCredentials $ staticDir </> "pools" </> "bulk1.creds"
   let pInfoForger = mkProtocolInfoCardano genCfg creds
-  syncPars <- mkSyncNodeParams staticDir mutableDir mTxOutParam
+  syncPars <- mkSyncNodeParams staticDir mutableDir cmdLineArgs
   pure $ Config (Consensus.pInfoConfig pInfoDbSync) pInfoDbSync pInfoForger syncPars
 
 mkShelleyCredentials :: FilePath -> IO [ShelleyLeaderCredentials StandardCrypto]
@@ -228,35 +250,55 @@ mkShelleyCredentials bulkFile = do
         }
 
 -- | staticDir can be shared by tests running in parallel. mutableDir not.
-mkSyncNodeParams :: FilePath -> FilePath -> Maybe TxOutParam -> IO SyncNodeParams
-mkSyncNodeParams staticDir mutableDir mTxOutParam = do
+mkSyncNodeParams :: FilePath -> FilePath -> CommandLineArgs -> IO SyncNodeParams
+mkSyncNodeParams staticDir mutableDir CommandLineArgs{..} = do
   pgconfig <- orDie Db.renderPGPassError $ newExceptT Db.readPGPassDefault
   pure $
     SyncNodeParams
-      { enpConfigFile = ConfigFile $ staticDir </> "test-db-sync-config.json"
+      { enpConfigFile = ConfigFile $ staticDir </> (if claHasConfigFile then "test-db-sync-config.json" else "")
       , enpSocketPath = SocketPath $ mutableDir </> ".socket"
       , enpMaybeLedgerStateDir = Just $ LedgerStateDir $ mutableDir </> "ledger-states"
       , enpMigrationDir = MigrationDir "../schema"
       , enpPGPassSource = Db.PGPassCached pgconfig
-      , enpExtended = True
-      , enpHasCache = True
-      , enpShouldUseLedger = True
-      , enpSkipFix = True
-      , enpOnlyFix = False
-      , enpForceIndexes = False
-      , enpHasMultiAssets = True
-      , enpHasMetadata = True
+      , enpEpochDisabled = claEpochDisabled
+      , enpHasCache = claHasCache
+      , enpShouldUseLedger = claShouldUseLedger
+      , enpSkipFix = claSkipFix
+      , enpOnlyFix = claOnlyFix
+      , enpForceIndexes = claForceIndexes
+      , enpHasMultiAssets = claHasMultiAssets
+      , enpHasMetadata = claHasMetadata
       , enpHasPlutusExtra = True
       , enpHasOfflineData = True
       , enpTurboMode = False
       , enpFullMode = True
-      , enpMigrateConsumed = maybe False paramMigrateConsumed mTxOutParam
-      , enpPruneTxOut = maybe False paramPruneTxOut mTxOutParam
+      , enpMigrateConsumed = claMigrateConsumed
+      , enpPruneTxOut = claPruneTxOut
       , enpSnEveryFollowing = 35
       , enpSnEveryLagging = 35
       , enpMaybeRollback = Nothing
       }
 
+initCommandLineArgs :: CommandLineArgs
+initCommandLineArgs =
+  CommandLineArgs
+  { claHasConfigFile = True
+  , claEpochDisabled = True
+  , claHasCache = True
+  , claShouldUseLedger = True
+  , claSkipFix = True
+  , claOnlyFix = False
+  , claForceIndexes = False
+  , claHasMultiAssets = True
+  , claHasMetadata = True
+  , claHasPlutusExtra = True
+  , claHasOfflineData = True
+  , claTurboMode = False
+  , claFullMode = True
+  , claMigrateConsumed = True
+  , claPruneTxOut = True
+  }
+
 emptyMetricsSetters :: MetricSetters
 emptyMetricsSetters =
   MetricSetters
@@ -273,37 +315,49 @@ withFullConfig ::
   IOManager ->
   [(Text, Text)] ->
   IO a
-withFullConfig = withFullConfig' True Nothing
+withFullConfig = withFullConfig' True False initCommandLineArgs
+
+withCustomConfig ::
+  CommandLineArgs ->
+  FilePath ->
+  FilePath ->
+  (Interpreter -> ServerHandle IO CardanoBlock -> DBSyncEnv -> IO a) ->
+  IOManager ->
+  [(Text, Text)] ->
+  IO a
+withCustomConfig = withFullConfig' True False
 
-withTxOutParamConfig ::
-  TxOutParam ->
+-- when wanting to check for a failure in a test for some reason logging has to be enabled
+withCustomConfigAndLogs ::
+  CommandLineArgs ->
   FilePath ->
   FilePath ->
   (Interpreter -> ServerHandle IO CardanoBlock -> DBSyncEnv -> IO a) ->
   IOManager ->
   [(Text, Text)] ->
   IO a
-withTxOutParamConfig txOutParam = withFullConfig' True (Just txOutParam)
+withCustomConfigAndLogs = withFullConfig' True True
 
 withFullConfig' ::
   Bool ->
-  Maybe TxOutParam ->
+  Bool ->
+  CommandLineArgs ->
   FilePath ->
   FilePath ->
   (Interpreter -> ServerHandle IO CardanoBlock -> DBSyncEnv -> IO a) ->
   IOManager ->
   [(Text, Text)] ->
   IO a
-withFullConfig' hasFingerprint mTxOutParam config testLabel action iom migr = do
+withFullConfig' hasFingerprint shouldLog cmdLineArgs config testLabel action iom migr = do
   recreateDir mutableDir
-  cfg <- mkConfig configDir mutableDir mTxOutParam
+  cfg <- mkConfig configDir mutableDir cmdLineArgs
   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
-      then pure nullTracer
-      else configureLogging dbsyncParams "db-sync-node"
+    if shouldLog
+      then configureLogging dbsyncParams "db-sync-node"
+      else pure nullTracer
   let dbsyncRun = runDbSync emptyMetricsSetters migr iom trce dbsyncParams True
   let initSt = Consensus.pInfoInitLedger $ protocolInfo cfg
   withInterpreter (protocolInfoForging cfg) nullTracer fingerFile $ \interpreter -> do

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

@@ -273,4 +273,4 @@ prop_empty_blocks iom knownMigrations = withMaxSuccess 20 $ noShrinking $ forAll
   prettyCommands smSymbolic hist (checkCommandNames cmds (res === Ok))
   where
     smSymbolic = sm (error "inter") (error "mockServer") (error "dbSync")
-    runAction action = withFullConfig' False Nothing "config" "qsm" action iom knownMigrations
+    runAction action = withFullConfig' False False initCommandLineArgs "config" "qsm" action iom knownMigrations

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

@@ -9,9 +9,13 @@ module Test.Cardano.Db.Mock.Unit.Babbage (
 import Cardano.Mock.ChainSync.Server (IOManager)
 import Data.Text (Text)
 import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.ExpectedFailure (expectFail)
 import Test.Tasty.HUnit (Assertion, testCase)
 
-import qualified Test.Cardano.Db.Mock.Unit.Babbage.Flag.ConsumedTxOut as FlagConsumedTxOut
+import qualified Test.Cardano.Db.Mock.Unit.Babbage.CommandLineArg.ConfigFile as ConfigFile
+import qualified Test.Cardano.Db.Mock.Unit.Babbage.CommandLineArg.EpochDisabled as EpochDisabled
+import qualified Test.Cardano.Db.Mock.Unit.Babbage.CommandLineArg.ForceIndex as ForceIndex
+import qualified Test.Cardano.Db.Mock.Unit.Babbage.CommandLineArg.MigrateConsumedPruneTxOut as MigrateConsumedPruneTxOut
 import qualified Test.Cardano.Db.Mock.Unit.Babbage.InlineAndReference as BabInlineRef
 import qualified Test.Cardano.Db.Mock.Unit.Babbage.Other as BabOther
 import qualified Test.Cardano.Db.Mock.Unit.Babbage.Plutus as BabPlutus
@@ -35,19 +39,33 @@ unitTests iom knownMigrations =
         , test "node restart boundary" BabSimple.nodeRestartBoundary
         ]
     , testGroup
-        "flags"
+        "Command Line Arguments"
         [ testGroup
-            "consumed-tx-out"
-                [ test "flag check" FlagConsumedTxOut.flagCheck
-                , test "basic prune" FlagConsumedTxOut.basicPrune
-                , test "prune with simple rollback" FlagConsumedTxOut.pruneWithSimpleRollback
-                , test "prune with full tx rollback" FlagConsumedTxOut.pruneWithFullTxRollback
-                , test "pruning should keep some tx" FlagConsumedTxOut.pruningShouldKeepSomeTx
-                , test "prune and rollback one block" FlagConsumedTxOut.pruneAndRollBackOneBlock
-                , test "no pruning and rollback" FlagConsumedTxOut.noPruneAndRollBack
-                , test "prune same block" FlagConsumedTxOut.pruneSameBlock
-                , test "no pruning same block" FlagConsumedTxOut.noPruneSameBlock
-                ]
+            "consumed-tx-out + prune-tx-out"
+            [ test "flag check" MigrateConsumedPruneTxOut.commandLineArgCheck
+            , test "basic prune" MigrateConsumedPruneTxOut.basicPrune
+            , test "prune with simple rollback" MigrateConsumedPruneTxOut.pruneWithSimpleRollback
+            , test "prune with full tx rollback" MigrateConsumedPruneTxOut.pruneWithFullTxRollback
+            , test "pruning should keep some tx" MigrateConsumedPruneTxOut.pruningShouldKeepSomeTx
+            , test "prune and rollback one block" MigrateConsumedPruneTxOut.pruneAndRollBackOneBlock
+            , test "no pruning and rollback" MigrateConsumedPruneTxOut.noPruneAndRollBack
+            , test "prune same block" MigrateConsumedPruneTxOut.pruneSameBlock
+            , test "no pruning same block" MigrateConsumedPruneTxOut.noPruneSameBlock
+            ]
+        , testGroup
+            "config"
+            [ expectFail $ test "fails if incorrect or no config file given" ConfigFile.checkConfigFileArg
+            ]
+        , testGroup
+            "disable-epoch"
+            [ test "Epoch doesn't update when disabled" EpochDisabled.checkEpochDisabledArg
+            , test "Epoch updates when enabled" EpochDisabled.checkEpochEnabled
+            ]
+        , testGroup
+            "force-indexes"
+            [ test "check force-index adds indexes" ForceIndex.checkForceIndexesArg
+            , test "check no force-index doesn't add indexes" ForceIndex.checkNoForceIndexesArg
+            ]
         ]
     , testGroup
         "rollbacks"

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

@@ -0,0 +1,18 @@
+module Test.Cardano.Db.Mock.Unit.Babbage.CommandLineArg.ConfigFile (
+  checkConfigFileArg,
+)
+where
+
+import Cardano.Mock.ChainSync.Server (IOManager)
+import Data.Text (Text)
+import Test.Cardano.Db.Mock.Config (CommandLineArgs (..), babbageConfigDir, initCommandLineArgs, withCustomConfigAndLogs)
+import Test.Tasty.HUnit (Assertion)
+
+-- this test fails as incorrect configuration file given
+checkConfigFileArg :: IOManager -> [(Text, Text)] -> Assertion
+checkConfigFileArg =
+  withCustomConfigAndLogs commandLineConfigArgs babbageConfigDir testLabel $ \_ _ _ -> do
+    pure ()
+  where
+    testLabel = "CLAcheckConfigFileArg"
+    commandLineConfigArgs = initCommandLineArgs {claHasConfigFile = False}

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

@@ -0,0 +1,50 @@
+module Test.Cardano.Db.Mock.Unit.Babbage.CommandLineArg.EpochDisabled (
+  checkEpochDisabledArg,
+  checkEpochEnabled,
+)
+where
+
+import qualified Cardano.Db as DB
+import Cardano.Mock.ChainSync.Server (IOManager)
+import qualified Cardano.Mock.Forging.Tx.Babbage as Babbage
+import Cardano.Mock.Forging.Types (UTxOIndex (..))
+import Control.Monad (void)
+import Data.Text (Text)
+import Test.Cardano.Db.Mock.Config (CommandLineArgs (..), babbageConfigDir, startDBSync, withCustomConfig, initCommandLineArgs)
+import Test.Cardano.Db.Mock.UnifiedApi (forgeAndSubmitBlocks, withBabbageFindLeaderAndSubmitTx)
+import Test.Cardano.Db.Mock.Validate (assertBlockNoBackoff, assertEqQuery)
+import Test.Tasty.HUnit (Assertion)
+
+mkCommandLineArgs :: Bool -> CommandLineArgs
+mkCommandLineArgs epochDisabled = initCommandLineArgs {claEpochDisabled = epochDisabled}
+
+-- this test fails as incorrect configuration file given
+checkEpochDisabledArg :: IOManager -> [(Text, Text)] -> Assertion
+checkEpochDisabledArg =
+  withCustomConfig (mkCommandLineArgs True) babbageConfigDir testLabel $ \interpreter mockServer dbSyncEnv -> do
+    startDBSync dbSyncEnv
+    b1 <- forgeAndSubmitBlocks interpreter mockServer 50
+    -- add 2 blocks with tx
+    void $ withBabbageFindLeaderAndSubmitTx interpreter mockServer $ Babbage.mkPaymentTx (UTxOIndex 0) (UTxOIndex 1) 10000 10000
+    void $ withBabbageFindLeaderAndSubmitTx interpreter mockServer $ Babbage.mkPaymentTx (UTxOIndex 1) (UTxOIndex 0) 10000 10000
+    b2 <- forgeAndSubmitBlocks interpreter mockServer 60
+
+    assertBlockNoBackoff dbSyncEnv (fromIntegral $ length (b1 <> b2) + 2)
+    assertEqQuery dbSyncEnv DB.queryEpochCount 0 "new epoch didn't prune tx_out column that are null"
+  where
+    testLabel = "CLAcheckEpochDisabledArg "
+
+checkEpochEnabled :: IOManager -> [(Text, Text)] -> Assertion
+checkEpochEnabled =
+  withCustomConfig (mkCommandLineArgs False) babbageConfigDir testLabel $ \interpreter mockServer dbSyncEnv -> do
+    startDBSync dbSyncEnv
+    b1 <- forgeAndSubmitBlocks interpreter mockServer 50
+    -- add 2 blocks with tx
+    void $ withBabbageFindLeaderAndSubmitTx interpreter mockServer $ Babbage.mkPaymentTx (UTxOIndex 0) (UTxOIndex 1) 10000 10000
+    void $ withBabbageFindLeaderAndSubmitTx interpreter mockServer $ Babbage.mkPaymentTx (UTxOIndex 1) (UTxOIndex 0) 10000 10000
+    b2 <- forgeAndSubmitBlocks interpreter mockServer 60
+
+    assertBlockNoBackoff dbSyncEnv (fromIntegral $ length (b1 <> b2) + 2)
+    assertEqQuery dbSyncEnv DB.queryEpochCount 1 "new epoch didn't prune tx_out column that are null"
+  where
+    testLabel = "CLAcheckEpochDisabledArg "

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

@@ -0,0 +1,37 @@
+{-# LANGUAGE NumericUnderscores #-}
+
+module Test.Cardano.Db.Mock.Unit.Babbage.CommandLineArg.ForceIndex (
+  checkForceIndexesArg,
+  checkNoForceIndexesArg
+)
+where
+
+import Cardano.Mock.ChainSync.Server (IOManager)
+import Data.Text (Text)
+import Test.Cardano.Db.Mock.Config (CommandLineArgs (..), babbageConfigDir, initCommandLineArgs, withCustomConfig, startDBSync)
+import Test.Tasty.HUnit (Assertion)
+import qualified Cardano.Db as DB
+import Test.Cardano.Db.Mock.Validate (assertEqQuery)
+import GHC.Conc.IO (threadDelay)
+
+checkForceIndexesArg :: IOManager -> [(Text, Text)] -> Assertion
+checkForceIndexesArg =
+  withCustomConfig commandLineForceIndexArgs babbageConfigDir testLabel $ \_ _ dbSyncEnv -> do
+    startDBSync dbSyncEnv
+    -- assertBlockNoBackoff dbSyncEnv 0
+    threadDelay 3_000_000
+    assertEqQuery dbSyncEnv DB.queryPgIndexesCount 143 "there wasn't the correct number of indexes"
+  where
+    testLabel = "CLAcheckForceIndexesArg"
+    commandLineForceIndexArgs = initCommandLineArgs {claForceIndexes = True}
+
+checkNoForceIndexesArg :: IOManager -> [(Text, Text)] -> Assertion
+checkNoForceIndexesArg =
+  withCustomConfig commandLineNoForceIndexArgs babbageConfigDir testLabel $ \_ _ dbSyncEnv -> do
+    startDBSync dbSyncEnv
+    -- assertBlockNoBackoff dbSyncEnv 0
+    threadDelay 3_000_000
+    assertEqQuery dbSyncEnv DB.queryPgIndexesCount 78 "there wasn't the correct number of indexes"
+  where
+    testLabel = "CLAcheckNoForceIndexesArg"
+    commandLineNoForceIndexArgs = initCommandLineArgs {claForceIndexes = False}