{-# LANGUAGE PatternSynonyms #-}

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           Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy
                     (pattern NoDoDiskSnapshotChecksum)
import qualified Test.Cardano.Tools.Headers
import           Test.Tasty
import           Test.Tasty.HUnit
import           Test.Util.TestEnv


nodeConfig, chainDB :: FilePath
nodeConfig :: FilePath
nodeConfig  = FilePath
"test/tools-test/disk/config/config.json"
chainDB :: FilePath
chainDB     = FilePath
"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 :: FilePath
nfpConfig   = FilePath
nodeConfig
      , nfpChainDB :: FilePath
nfpChainDB  = FilePath
chainDB
    }

testNodeCredentials :: NodeCredentials
testNodeCredentials :: NodeCredentials
testNodeCredentials =
    NodeCredentials {
        credCertFile :: Maybe FilePath
credCertFile  = Maybe FilePath
forall a. Maybe a
Nothing
      , credVRFFile :: Maybe FilePath
credVRFFile   = Maybe FilePath
forall a. Maybe a
Nothing
      , credKESFile :: Maybe FilePath
credKESFile   = Maybe FilePath
forall a. Maybe a
Nothing
      , credBulkFile :: Maybe FilePath
credBulkFile  = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"test/tools-test/disk/config/bulk-creds-k2.json"
    }

testImmutaliserConfig :: DBImmutaliser.Opts
testImmutaliserConfig :: Opts
testImmutaliserConfig =
  DBImmutaliser.Opts {
      dbDirs :: DBDirs FilePath
DBImmutaliser.dbDirs = DBImmutaliser.DBDirs {
          immDBDir :: FilePath
DBImmutaliser.immDBDir = FilePath
chainDB FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/immutable"
        , volDBDir :: FilePath
DBImmutaliser.volDBDir = FilePath
chainDB FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/volatile"
        }
   , configFile :: FilePath
DBImmutaliser.configFile = FilePath
nodeConfig
   }

testAnalyserConfig :: DBAnalyserConfig
testAnalyserConfig :: DBAnalyserConfig
testAnalyserConfig =
  DBAnalyserConfig {
      dbDir :: FilePath
dbDir                      = FilePath
chainDB
    , 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
    , diskSnapshotChecksumOnRead :: Flag "DoDiskSnapshotChecksum"
diskSnapshotChecksumOnRead = Flag "DoDiskSnapshotChecksum"
NoDoDiskSnapshotChecksum
    }

testBlockArgs :: Cardano.Args (CardanoBlock StandardCrypto)
testBlockArgs :: Args (CardanoBlock StandardCrypto)
testBlockArgs = FilePath
-> Maybe PBftSignatureThreshold
-> Args (CardanoBlock StandardCrypto)
Cardano.CardanoBlockArgs FilePath
nodeConfig Maybe PBftSignatureThreshold
forall a. Maybe a
Nothing

-- | A multi-step test including synthesis and analaysis 'SomeConsensusProtocol' using the Cardano instance.
--
-- 1. step: synthesize a ChainDB from scratch and count the amount of blocks forged.
-- 2. step: append to the previous ChainDB and coutn the amount of blocks forged.
-- 3. step: copy the VolatileDB into the ImmutableDB.
-- 3. step: analyze the ImmutableDB resulting from previous steps and confirm the total block count.

--
blockCountTest :: (String -> IO ()) -> Assertion
blockCountTest :: (FilePath -> IO ()) -> IO ()
blockCountTest FilePath -> IO ()
logStep = do
    FilePath -> IO ()
logStep FilePath
"running synthesis - create"
    (DBSynthesizerConfig
options, CardanoProtocolParams StandardCrypto
protocol) <- (FilePath
 -> IO (DBSynthesizerConfig, CardanoProtocolParams StandardCrypto))
-> ((DBSynthesizerConfig, CardanoProtocolParams StandardCrypto)
    -> IO (DBSynthesizerConfig, CardanoProtocolParams StandardCrypto))
-> Either
     FilePath
     (DBSynthesizerConfig, CardanoProtocolParams StandardCrypto)
-> IO (DBSynthesizerConfig, CardanoProtocolParams StandardCrypto)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath
-> IO (DBSynthesizerConfig, CardanoProtocolParams StandardCrypto)
forall a. HasCallStack => FilePath -> 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
   FilePath
   (DBSynthesizerConfig, CardanoProtocolParams StandardCrypto)
 -> IO (DBSynthesizerConfig, CardanoProtocolParams StandardCrypto))
-> IO
     (Either
        FilePath
        (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
        FilePath
        (DBSynthesizerConfig, CardanoProtocolParams StandardCrypto))
DBSynthesizer.initialize
          NodeFilePaths
testNodeFilePaths
          NodeCredentials
testNodeCredentials
          DBSynthesizerOptions
testSynthOptionsCreate
    ForgeResult
resultCreate <- (TopLevelConfig (CardanoBlock StandardCrypto)
 -> GenTxs (CardanoBlock StandardCrypto))
-> DBSynthesizerConfig
-> CardanoProtocolParams StandardCrypto
-> IO ForgeResult
DBSynthesizer.synthesize TopLevelConfig (CardanoBlock StandardCrypto)
-> GenTxs (CardanoBlock StandardCrypto)
forall {f :: * -> *} {p} {p} {p} {a}.
Applicative f =>
p -> p -> p -> f [a]
genTxs DBSynthesizerConfig
options CardanoProtocolParams StandardCrypto
protocol
    let blockCountCreate :: Int
blockCountCreate = ForgeResult -> Int
resultForged ForgeResult
resultCreate
    Int
blockCountCreate Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> FilePath -> IO ()
forall t.
(AssertionPredicable t, HasCallStack) =>
t -> FilePath -> IO ()
@? FilePath
"no blocks have been forged during create step"

    FilePath -> IO ()
logStep FilePath
"running synthesis - append"
    ForgeResult
resultAppend <- (TopLevelConfig (CardanoBlock StandardCrypto)
 -> GenTxs (CardanoBlock StandardCrypto))
-> DBSynthesizerConfig
-> CardanoProtocolParams StandardCrypto
-> IO ForgeResult
DBSynthesizer.synthesize TopLevelConfig (CardanoBlock StandardCrypto)
-> GenTxs (CardanoBlock StandardCrypto)
forall {f :: * -> *} {p} {p} {p} {a}.
Applicative f =>
p -> p -> p -> f [a]
genTxs DBSynthesizerConfig
options {confOptions = testSynthOptionsAppend} CardanoProtocolParams StandardCrypto
protocol
    let blockCountAppend :: Int
blockCountAppend = ForgeResult -> Int
resultForged ForgeResult
resultAppend
    Int
blockCountAppend Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> FilePath -> IO ()
forall t.
(AssertionPredicable t, HasCallStack) =>
t -> FilePath -> IO ()
@? FilePath
"no blocks have been forged during append step"

    FilePath -> IO ()
logStep FilePath
"copy volatile to immutable DB"
    Opts -> IO ()
DBImmutaliser.run Opts
testImmutaliserConfig

    FilePath -> IO ()
logStep FilePath
"running analysis"
    Maybe AnalysisResult
resultAnalysis <- DBAnalyserConfig
-> Args (CardanoBlock StandardCrypto) -> IO (Maybe AnalysisResult)
forall blk.
(RunNode blk, Show (Header blk), HasAnalysis blk,
 HasProtocolInfo blk, HasTxs blk) =>
DBAnalyserConfig -> Args blk -> IO (Maybe AnalysisResult)
DBAnalyser.analyse DBAnalyserConfig
testAnalyserConfig Args (CardanoBlock StandardCrypto)
testBlockArgs

    let blockCount :: Int
blockCount = Int
blockCountCreate Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
blockCountAppend
    Maybe AnalysisResult
resultAnalysis Maybe AnalysisResult -> Maybe AnalysisResult -> Bool
forall a. Eq a => a -> a -> Bool
== AnalysisResult -> Maybe AnalysisResult
forall a. a -> Maybe a
Just (Int -> AnalysisResult
ResultCountBlock Int
blockCount) Bool -> FilePath -> IO ()
forall t.
(AssertionPredicable t, HasCallStack) =>
t -> FilePath -> IO ()
@?
        FilePath
"wrong number of blocks encountered during analysis \
        \ (counted: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Maybe AnalysisResult -> FilePath
forall a. Show a => a -> FilePath
show Maybe AnalysisResult
resultAnalysis FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"; expected: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
blockCount FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")"
  where
    genTxs :: p -> p -> p -> f [a]
genTxs 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 =
    FilePath -> [TestTree] -> TestTree
testGroup FilePath
"cardano-tools"
      [ FilePath -> ((FilePath -> IO ()) -> IO ()) -> TestTree
testCaseSteps FilePath
"synthesize and analyse: blockCount\n" (FilePath -> IO ()) -> IO ()
blockCountTest
      , TestTree
Test.Cardano.Tools.Headers.tests
      ]

main :: IO ()
IO ()
main = TestEnvConfig -> TestTree -> IO ()
defaultMainWithTestEnv TestEnvConfig
defaultTestEnvConfig TestTree
tests