module Main (main) where
import qualified Cardano.Tools.DBAnalyser.Block.Cardano as Cardano
import qualified Cardano.Tools.DBAnalyser.Run as DBAnalyser
import Cardano.Tools.DBAnalyser.Types
import qualified Cardano.Tools.DBImmutaliser.Run as DBImmutaliser
import qualified Cardano.Tools.DBSynthesizer.Run as DBSynthesizer
import Cardano.Tools.DBSynthesizer.Types
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Cardano.Block
import qualified Test.Cardano.Tools.Headers
import Test.Tasty
import Test.Tasty.HUnit
import Test.Util.TestEnv
nodeConfig, chainDB :: FilePath
nodeConfig :: [Char]
nodeConfig = [Char]
"ouroboros-consensus-cardano/test/tools-test/disk/config/config.json"
chainDB :: [Char]
chainDB = [Char]
"ouroboros-consensus-cardano/test/tools-test/disk/chaindb"
testSynthOptionsCreate :: DBSynthesizerOptions
testSynthOptionsCreate :: DBSynthesizerOptions
testSynthOptionsCreate =
DBSynthesizerOptions
{ synthLimit :: ForgeLimit
synthLimit = Word64 -> ForgeLimit
ForgeLimitEpoch Word64
1
, synthOpenMode :: DBSynthesizerOpenMode
synthOpenMode = DBSynthesizerOpenMode
OpenCreateForce
}
testSynthOptionsAppend :: DBSynthesizerOptions
testSynthOptionsAppend :: DBSynthesizerOptions
testSynthOptionsAppend =
DBSynthesizerOptions
{ synthLimit :: ForgeLimit
synthLimit = SlotNo -> ForgeLimit
ForgeLimitSlot SlotNo
8192
, synthOpenMode :: DBSynthesizerOpenMode
synthOpenMode = DBSynthesizerOpenMode
OpenAppend
}
testNodeFilePaths :: NodeFilePaths
testNodeFilePaths :: NodeFilePaths
testNodeFilePaths =
NodeFilePaths
{ nfpConfig :: [Char]
nfpConfig = [Char]
nodeConfig
, nfpChainDB :: [Char]
nfpChainDB = [Char]
chainDB
}
testNodeCredentials :: NodeCredentials
testNodeCredentials :: NodeCredentials
testNodeCredentials =
NodeCredentials
{ credCertFile :: Maybe [Char]
credCertFile = Maybe [Char]
forall a. Maybe a
Nothing
, credVRFFile :: Maybe [Char]
credVRFFile = Maybe [Char]
forall a. Maybe a
Nothing
, credKESFile :: Maybe [Char]
credKESFile = Maybe [Char]
forall a. Maybe a
Nothing
, credBulkFile :: Maybe [Char]
credBulkFile = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"ouroboros-consensus-cardano/test/tools-test/disk/config/bulk-creds-k2.json"
}
testImmutaliserConfig :: DBImmutaliser.Opts
testImmutaliserConfig :: Opts
testImmutaliserConfig =
DBImmutaliser.Opts
{ dbDirs :: DBDirs [Char]
DBImmutaliser.dbDirs =
DBImmutaliser.DBDirs
{ immDBDir :: [Char]
DBImmutaliser.immDBDir = [Char]
chainDB [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"/immutable"
, volDBDir :: [Char]
DBImmutaliser.volDBDir = [Char]
chainDB [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"/volatile"
}
, configFile :: [Char]
DBImmutaliser.configFile = [Char]
nodeConfig
, verbose :: Bool
DBImmutaliser.verbose = Bool
False
, dotOut :: Maybe [Char]
DBImmutaliser.dotOut = Maybe [Char]
forall a. Maybe a
Nothing
, dryRun :: Bool
DBImmutaliser.dryRun = Bool
False
}
testAnalyserConfig :: DBAnalyserConfig
testAnalyserConfig :: DBAnalyserConfig
testAnalyserConfig =
DBAnalyserConfig
{ dbDir :: [Char]
dbDir = [Char]
chainDB
, ldbBackend :: LedgerDBBackend
ldbBackend = LedgerDBBackend
V2InMem
, verbose :: Bool
verbose = Bool
False
, selectDB :: SelectDB
selectDB = WithOrigin SlotNo -> SelectDB
SelectImmutableDB WithOrigin SlotNo
forall t. WithOrigin t
Origin
, validation :: Maybe ValidateBlocks
validation = ValidateBlocks -> Maybe ValidateBlocks
forall a. a -> Maybe a
Just ValidateBlocks
ValidateAllBlocks
, analysis :: AnalysisName
analysis = AnalysisName
CountBlocks
, confLimit :: Limit
confLimit = Limit
Unlimited
}
testBlockArgs :: Cardano.Args (CardanoBlock StandardCrypto)
testBlockArgs :: Args (CardanoBlock StandardCrypto)
testBlockArgs = [Char]
-> Maybe PBftSignatureThreshold
-> Args (CardanoBlock StandardCrypto)
Cardano.CardanoBlockArgs [Char]
nodeConfig Maybe PBftSignatureThreshold
forall a. Maybe a
Nothing
blockCountTest :: (String -> IO ()) -> Assertion
blockCountTest :: ([Char] -> IO ()) -> IO ()
blockCountTest [Char] -> IO ()
logStep = do
[Char] -> IO ()
logStep [Char]
"running synthesis - create"
(options, protocol) <-
([Char]
-> IO (DBSynthesizerConfig, CardanoProtocolParams StandardCrypto))
-> ((DBSynthesizerConfig, CardanoProtocolParams StandardCrypto)
-> IO (DBSynthesizerConfig, CardanoProtocolParams StandardCrypto))
-> Either
[Char] (DBSynthesizerConfig, CardanoProtocolParams StandardCrypto)
-> IO (DBSynthesizerConfig, CardanoProtocolParams StandardCrypto)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char]
-> IO (DBSynthesizerConfig, CardanoProtocolParams StandardCrypto)
forall a. HasCallStack => [Char] -> IO a
assertFailure (DBSynthesizerConfig, CardanoProtocolParams StandardCrypto)
-> IO (DBSynthesizerConfig, CardanoProtocolParams StandardCrypto)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Either
[Char] (DBSynthesizerConfig, CardanoProtocolParams StandardCrypto)
-> IO (DBSynthesizerConfig, CardanoProtocolParams StandardCrypto))
-> IO
(Either
[Char] (DBSynthesizerConfig, CardanoProtocolParams StandardCrypto))
-> IO (DBSynthesizerConfig, CardanoProtocolParams StandardCrypto)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NodeFilePaths
-> NodeCredentials
-> DBSynthesizerOptions
-> IO
(Either
[Char] (DBSynthesizerConfig, CardanoProtocolParams StandardCrypto))
DBSynthesizer.initialize
NodeFilePaths
testNodeFilePaths
NodeCredentials
testNodeCredentials
DBSynthesizerOptions
testSynthOptionsCreate
resultCreate <- DBSynthesizer.synthesize genTxs options protocol
let blockCountCreate = ForgeResult -> Int
resultForged ForgeResult
resultCreate
blockCountCreate > 0 @? "no blocks have been forged during create step"
logStep "running synthesis - append"
resultAppend <-
DBSynthesizer.synthesize genTxs options{confOptions = testSynthOptionsAppend} protocol
let blockCountAppend = ForgeResult -> Int
resultForged ForgeResult
resultAppend
blockCountAppend > 0 @? "no blocks have been forged during append step"
logStep "copy volatile to immutable DB"
DBImmutaliser.run testImmutaliserConfig
logStep "running analysis"
resultAnalysis <- DBAnalyser.analyse testAnalyserConfig testBlockArgs
let blockCount = Int
blockCountCreate Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
blockCountAppend
resultAnalysis == Just (ResultCountBlock blockCount)
@? "wrong number of blocks encountered during analysis \
\ (counted: "
++ show resultAnalysis
++ "; expected: "
++ show blockCount
++ ")"
where
genTxs :: p -> p -> p -> p -> f [a]
genTxs p
_ p
_ p
_ p
_ = [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
tests :: TestTree
tests :: TestTree
tests =
[Char] -> [TestTree] -> TestTree
testGroup
[Char]
"cardano-tools"
[ [Char] -> (([Char] -> IO ()) -> IO ()) -> TestTree
testCaseSteps [Char]
"synthesize and analyse: blockCount\n" ([Char] -> IO ()) -> IO ()
blockCountTest
, TestTree
Test.Cardano.Tools.Headers.tests
]
main :: IO ()
IO ()
main = TestEnvConfig -> TestTree -> IO ()
defaultMainWithTestEnv TestEnvConfig
defaultTestEnvConfig TestTree
tests