{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE LambdaCase #-}

module DBAnalyser.Parsers
  ( parseCmdLine
  , parseCardanoArgs
  , CardanoBlockArgs
  ) where

import Cardano.Tools.DBAnalyser.Analysis
import Cardano.Tools.DBAnalyser.Block.Cardano
import Cardano.Tools.DBAnalyser.Types
import qualified Data.Foldable as Foldable
import Options.Applicative
import Ouroboros.Consensus.Block (SlotNo (..), WithOrigin (..))
import Ouroboros.Consensus.Byron.Node (PBftSignatureThreshold (..))

{-------------------------------------------------------------------------------
  Parsing
-------------------------------------------------------------------------------}

parseCmdLine :: Parser (DBAnalyserConfig, CardanoBlockArgs)
parseCmdLine :: Parser (DBAnalyserConfig, CardanoBlockArgs)
parseCmdLine = (,) (DBAnalyserConfig
 -> CardanoBlockArgs -> (DBAnalyserConfig, CardanoBlockArgs))
-> Parser DBAnalyserConfig
-> Parser
     (CardanoBlockArgs -> (DBAnalyserConfig, CardanoBlockArgs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DBAnalyserConfig
parseDBAnalyserConfig Parser (CardanoBlockArgs -> (DBAnalyserConfig, CardanoBlockArgs))
-> Parser CardanoBlockArgs
-> Parser (DBAnalyserConfig, CardanoBlockArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser CardanoBlockArgs
parseCardanoArgs

parseDBAnalyserConfig :: Parser DBAnalyserConfig
parseDBAnalyserConfig :: Parser DBAnalyserConfig
parseDBAnalyserConfig =
  FilePath
-> Bool
-> SelectDB
-> Maybe ValidateBlocks
-> AnalysisName
-> Limit
-> LedgerDBBackend
-> DBAnalyserConfig
DBAnalyserConfig
    (FilePath
 -> Bool
 -> SelectDB
 -> Maybe ValidateBlocks
 -> AnalysisName
 -> Limit
 -> LedgerDBBackend
 -> DBAnalyserConfig)
-> Parser FilePath
-> Parser
     (Bool
      -> SelectDB
      -> Maybe ValidateBlocks
      -> AnalysisName
      -> Limit
      -> LedgerDBBackend
      -> DBAnalyserConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
      ( [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
          [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"db"
          , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Path to the Chain DB"
          , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PATH"
          ]
      )
    Parser
  (Bool
   -> SelectDB
   -> Maybe ValidateBlocks
   -> AnalysisName
   -> Limit
   -> LedgerDBBackend
   -> DBAnalyserConfig)
-> Parser Bool
-> Parser
     (SelectDB
      -> Maybe ValidateBlocks
      -> AnalysisName
      -> Limit
      -> LedgerDBBackend
      -> DBAnalyserConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
      ( [Mod FlagFields Bool] -> Mod FlagFields Bool
forall a. Monoid a => [a] -> a
mconcat
          [ FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"verbose"
          , FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Enable verbose logging"
          ]
      )
    Parser
  (SelectDB
   -> Maybe ValidateBlocks
   -> AnalysisName
   -> Limit
   -> LedgerDBBackend
   -> DBAnalyserConfig)
-> Parser SelectDB
-> Parser
     (Maybe ValidateBlocks
      -> AnalysisName -> Limit -> LedgerDBBackend -> DBAnalyserConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SelectDB
parseSelectDB
    Parser
  (Maybe ValidateBlocks
   -> AnalysisName -> Limit -> LedgerDBBackend -> DBAnalyserConfig)
-> Parser (Maybe ValidateBlocks)
-> Parser
     (AnalysisName -> Limit -> LedgerDBBackend -> DBAnalyserConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe ValidateBlocks)
parseValidationPolicy
    Parser
  (AnalysisName -> Limit -> LedgerDBBackend -> DBAnalyserConfig)
-> Parser AnalysisName
-> Parser (Limit -> LedgerDBBackend -> DBAnalyserConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser AnalysisName
parseAnalysis
    Parser (Limit -> LedgerDBBackend -> DBAnalyserConfig)
-> Parser Limit -> Parser (LedgerDBBackend -> DBAnalyserConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Limit
parseLimit
    Parser (LedgerDBBackend -> DBAnalyserConfig)
-> Parser LedgerDBBackend -> Parser DBAnalyserConfig
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Parser LedgerDBBackend] -> Parser LedgerDBBackend
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
Foldable.asum
      [ LedgerDBBackend
-> Mod FlagFields LedgerDBBackend -> Parser LedgerDBBackend
forall a. a -> Mod FlagFields a -> Parser a
flag' LedgerDBBackend
V1InMem (Mod FlagFields LedgerDBBackend -> Parser LedgerDBBackend)
-> Mod FlagFields LedgerDBBackend -> Parser LedgerDBBackend
forall a b. (a -> b) -> a -> b
$
          [Mod FlagFields LedgerDBBackend] -> Mod FlagFields LedgerDBBackend
forall a. Monoid a => [a] -> a
mconcat
            [ FilePath -> Mod FlagFields LedgerDBBackend
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"v1-in-mem"
            , FilePath -> Mod FlagFields LedgerDBBackend
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"use v1 in-memory backing store"
            ]
      , LedgerDBBackend
-> Mod FlagFields LedgerDBBackend -> Parser LedgerDBBackend
forall a. a -> Mod FlagFields a -> Parser a
flag' LedgerDBBackend
V1LMDB (Mod FlagFields LedgerDBBackend -> Parser LedgerDBBackend)
-> Mod FlagFields LedgerDBBackend -> Parser LedgerDBBackend
forall a b. (a -> b) -> a -> b
$
          [Mod FlagFields LedgerDBBackend] -> Mod FlagFields LedgerDBBackend
forall a. Monoid a => [a] -> a
mconcat
            [ FilePath -> Mod FlagFields LedgerDBBackend
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"lmdb"
            , FilePath -> Mod FlagFields LedgerDBBackend
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"use v1 LMDB backing store"
            ]
      , LedgerDBBackend
-> Mod FlagFields LedgerDBBackend -> Parser LedgerDBBackend
forall a. a -> Mod FlagFields a -> Parser a
flag' LedgerDBBackend
V2InMem (Mod FlagFields LedgerDBBackend -> Parser LedgerDBBackend)
-> Mod FlagFields LedgerDBBackend -> Parser LedgerDBBackend
forall a b. (a -> b) -> a -> b
$
          [Mod FlagFields LedgerDBBackend] -> Mod FlagFields LedgerDBBackend
forall a. Monoid a => [a] -> a
mconcat
            [ FilePath -> Mod FlagFields LedgerDBBackend
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"v2-in-mem"
            , FilePath -> Mod FlagFields LedgerDBBackend
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"use v2 in-memory backend"
            ]
      ]

parseSelectDB :: Parser SelectDB
parseSelectDB :: Parser SelectDB
parseSelectDB =
  WithOrigin SlotNo -> SelectDB
SelectImmutableDB (WithOrigin SlotNo -> SelectDB)
-> Parser (WithOrigin SlotNo) -> Parser SelectDB
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (WithOrigin SlotNo)
analyseFrom
 where
  analyseFrom :: Parser (WithOrigin SlotNo)
  analyseFrom :: Parser (WithOrigin SlotNo)
analyseFrom =
    (Maybe Word64 -> WithOrigin SlotNo)
-> Parser (Maybe Word64) -> Parser (WithOrigin SlotNo)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WithOrigin SlotNo
-> (Word64 -> WithOrigin SlotNo)
-> Maybe Word64
-> WithOrigin SlotNo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe WithOrigin SlotNo
forall t. WithOrigin t
Origin (SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
NotOrigin (SlotNo -> WithOrigin SlotNo)
-> (Word64 -> SlotNo) -> Word64 -> WithOrigin SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> SlotNo
SlotNo)) (Parser (Maybe Word64) -> Parser (WithOrigin SlotNo))
-> Parser (Maybe Word64) -> Parser (WithOrigin SlotNo)
forall a b. (a -> b) -> a -> b
$
      Parser Word64 -> Parser (Maybe Word64)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Word64 -> Parser (Maybe Word64))
-> Parser Word64 -> Parser (Maybe Word64)
forall a b. (a -> b) -> a -> b
$
        ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
          ReadM Word64
forall a. Read a => ReadM a
auto
          ( FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"analyse-from"
              Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"SLOT_NUMBER"
              Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Start analysis from ledger state stored at specific slot number"
          )

parseValidationPolicy :: Parser (Maybe ValidateBlocks)
parseValidationPolicy :: Parser (Maybe ValidateBlocks)
parseValidationPolicy =
  Parser ValidateBlocks -> Parser (Maybe ValidateBlocks)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ValidateBlocks -> Parser (Maybe ValidateBlocks))
-> Parser ValidateBlocks -> Parser (Maybe ValidateBlocks)
forall a b. (a -> b) -> a -> b
$
    ReadM ValidateBlocks
-> Mod OptionFields ValidateBlocks -> Parser ValidateBlocks
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM ValidateBlocks
reader (Mod OptionFields ValidateBlocks -> Parser ValidateBlocks)
-> Mod OptionFields ValidateBlocks -> Parser ValidateBlocks
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields ValidateBlocks]
-> Mod OptionFields ValidateBlocks
forall a. Monoid a => [a] -> a
mconcat
        [ FilePath -> Mod OptionFields ValidateBlocks
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"db-validation"
        , FilePath -> Mod OptionFields ValidateBlocks
forall (f :: * -> *) a. FilePath -> Mod f a
help (FilePath -> Mod OptionFields ValidateBlocks)
-> FilePath -> Mod OptionFields ValidateBlocks
forall a b. (a -> b) -> a -> b
$
            FilePath
"The extent of the ChainDB on-disk files validation. This is "
              FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"completely unrelated to validation of the ledger rules. "
              FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"Possible values: validate-all-blocks, minimum-block-validation."
        ]
 where
  reader :: ReadM ValidateBlocks
reader = (FilePath -> Maybe ValidateBlocks) -> ReadM ValidateBlocks
forall a. (FilePath -> Maybe a) -> ReadM a
maybeReader ((FilePath -> Maybe ValidateBlocks) -> ReadM ValidateBlocks)
-> (FilePath -> Maybe ValidateBlocks) -> ReadM ValidateBlocks
forall a b. (a -> b) -> a -> b
$ \case
    FilePath
"validate-all-blocks" -> ValidateBlocks -> Maybe ValidateBlocks
forall a. a -> Maybe a
Just ValidateBlocks
ValidateAllBlocks
    FilePath
"minimum-block-validation" -> ValidateBlocks -> Maybe ValidateBlocks
forall a. a -> Maybe a
Just ValidateBlocks
MinimumBlockValidation
    FilePath
_ -> Maybe ValidateBlocks
forall a. Maybe a
Nothing

parseAnalysis :: Parser AnalysisName
parseAnalysis :: Parser AnalysisName
parseAnalysis =
  [Parser AnalysisName] -> Parser AnalysisName
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
Foldable.asum
    [ AnalysisName -> Mod FlagFields AnalysisName -> Parser AnalysisName
forall a. a -> Mod FlagFields a -> Parser a
flag' AnalysisName
ShowSlotBlockNo (Mod FlagFields AnalysisName -> Parser AnalysisName)
-> Mod FlagFields AnalysisName -> Parser AnalysisName
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields AnalysisName] -> Mod FlagFields AnalysisName
forall a. Monoid a => [a] -> a
mconcat
          [ FilePath -> Mod FlagFields AnalysisName
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"show-slot-block-no"
          , FilePath -> Mod FlagFields AnalysisName
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Show slot and block number and hash of all blocks"
          ]
    , AnalysisName -> Mod FlagFields AnalysisName -> Parser AnalysisName
forall a. a -> Mod FlagFields a -> Parser a
flag' AnalysisName
CountTxOutputs (Mod FlagFields AnalysisName -> Parser AnalysisName)
-> Mod FlagFields AnalysisName -> Parser AnalysisName
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields AnalysisName] -> Mod FlagFields AnalysisName
forall a. Monoid a => [a] -> a
mconcat
          [ FilePath -> Mod FlagFields AnalysisName
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"count-tx-outputs"
          , FilePath -> Mod FlagFields AnalysisName
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Show number of transaction outputs per block"
          ]
    , AnalysisName -> Mod FlagFields AnalysisName -> Parser AnalysisName
forall a. a -> Mod FlagFields a -> Parser a
flag' AnalysisName
ShowBlockHeaderSize (Mod FlagFields AnalysisName -> Parser AnalysisName)
-> Mod FlagFields AnalysisName -> Parser AnalysisName
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields AnalysisName] -> Mod FlagFields AnalysisName
forall a. Monoid a => [a] -> a
mconcat
          [ FilePath -> Mod FlagFields AnalysisName
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"show-block-header-size"
          , FilePath -> Mod FlagFields AnalysisName
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Show the header sizes of all blocks"
          ]
    , AnalysisName -> Mod FlagFields AnalysisName -> Parser AnalysisName
forall a. a -> Mod FlagFields a -> Parser a
flag' AnalysisName
ShowBlockTxsSize (Mod FlagFields AnalysisName -> Parser AnalysisName)
-> Mod FlagFields AnalysisName -> Parser AnalysisName
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields AnalysisName] -> Mod FlagFields AnalysisName
forall a. Monoid a => [a] -> a
mconcat
          [ FilePath -> Mod FlagFields AnalysisName
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"show-block-txs-size"
          , FilePath -> Mod FlagFields AnalysisName
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Show the total transaction sizes per block"
          ]
    , AnalysisName -> Mod FlagFields AnalysisName -> Parser AnalysisName
forall a. a -> Mod FlagFields a -> Parser a
flag' AnalysisName
ShowEBBs (Mod FlagFields AnalysisName -> Parser AnalysisName)
-> Mod FlagFields AnalysisName -> Parser AnalysisName
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields AnalysisName] -> Mod FlagFields AnalysisName
forall a. Monoid a => [a] -> a
mconcat
          [ FilePath -> Mod FlagFields AnalysisName
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"show-ebbs"
          , FilePath -> Mod FlagFields AnalysisName
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Show all EBBs and their predecessors"
          ]
    , Parser AnalysisName
storeLedgerParser
    , AnalysisName -> Mod FlagFields AnalysisName -> Parser AnalysisName
forall a. a -> Mod FlagFields a -> Parser a
flag' AnalysisName
CountBlocks (Mod FlagFields AnalysisName -> Parser AnalysisName)
-> Mod FlagFields AnalysisName -> Parser AnalysisName
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields AnalysisName] -> Mod FlagFields AnalysisName
forall a. Monoid a => [a] -> a
mconcat
          [ FilePath -> Mod FlagFields AnalysisName
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"count-blocks"
          , FilePath -> Mod FlagFields AnalysisName
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Count number of blocks processed"
          ]
    , Parser AnalysisName
checkNoThunksParser
    , AnalysisName -> Mod FlagFields AnalysisName -> Parser AnalysisName
forall a. a -> Mod FlagFields a -> Parser a
flag' AnalysisName
TraceLedgerProcessing (Mod FlagFields AnalysisName -> Parser AnalysisName)
-> Mod FlagFields AnalysisName -> Parser AnalysisName
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields AnalysisName] -> Mod FlagFields AnalysisName
forall a. Monoid a => [a] -> a
mconcat
          [ FilePath -> Mod FlagFields AnalysisName
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"trace-ledger"
          , FilePath -> Mod FlagFields AnalysisName
forall (f :: * -> *) a. FilePath -> Mod f a
help (FilePath -> Mod FlagFields AnalysisName)
-> FilePath -> Mod FlagFields AnalysisName
forall a b. (a -> b) -> a -> b
$
              FilePath
"Maintain ledger state and trace ledger phases in the GHC event"
                FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" log. The db-analyser tool performs era-specific analysis"
                FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" of the ledger state and inserts markers for 'significant'"
                FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" events, such as for example epoch transitions."
          ]
    , (Int -> AnalysisName) -> Parser Int -> Parser AnalysisName
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> AnalysisName
ReproMempoolAndForge (Parser Int -> Parser AnalysisName)
-> Parser Int -> Parser AnalysisName
forall a b. (a -> b) -> a -> b
$
        ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int -> Parser Int
forall a b. (a -> b) -> a -> b
$
          [Mod OptionFields Int] -> Mod OptionFields Int
forall a. Monoid a => [a] -> a
mconcat
            [ FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"repro-mempool-and-forge"
            , FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. FilePath -> Mod f a
help (FilePath -> Mod OptionFields Int)
-> FilePath -> Mod OptionFields Int
forall a b. (a -> b) -> a -> b
$
                FilePath
"Maintain ledger state and mempool trafficking the"
                  FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" transactions of each block. The integer is how many"
                  FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"blocks to put in the mempool at once."
            , FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"INT"
            ]
    , Parser AnalysisName
benchmarkLedgerOpsParser
    , Parser AnalysisName
getBlockApplicationMetrics
    , AnalysisName -> Parser AnalysisName
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AnalysisName
OnlyValidation
    ]

storeLedgerParser :: Parser AnalysisName
storeLedgerParser :: Parser AnalysisName
storeLedgerParser = do
  SlotNo
slot <-
    Word64 -> SlotNo
SlotNo
      (Word64 -> SlotNo) -> Parser Word64 -> Parser SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
        ReadM Word64
forall a. Read a => ReadM a
auto
        ( FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"store-ledger"
            Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"SLOT_NUMBER"
            Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Store ledger state at specific slot number"
        )
  LedgerApplicationMode
ledgerValidation <-
    LedgerApplicationMode
-> LedgerApplicationMode
-> Mod FlagFields LedgerApplicationMode
-> Parser LedgerApplicationMode
forall a. a -> a -> Mod FlagFields a -> Parser a
flag
      LedgerApplicationMode
LedgerReapply
      LedgerApplicationMode
LedgerApply
      ( FilePath -> Mod FlagFields LedgerApplicationMode
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"full-ledger-validation"
          Mod FlagFields LedgerApplicationMode
-> Mod FlagFields LedgerApplicationMode
-> Mod FlagFields LedgerApplicationMode
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields LedgerApplicationMode
forall (f :: * -> *) a. FilePath -> Mod f a
help
            ( FilePath
"Use full block application while applying blocks to ledger states, "
                FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"also validating signatures and scripts. "
                FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"This is much slower than block reapplication (the default)."
            )
      )
  pure $ SlotNo -> LedgerApplicationMode -> AnalysisName
StoreLedgerStateAt SlotNo
slot LedgerApplicationMode
ledgerValidation

checkNoThunksParser :: Parser AnalysisName
checkNoThunksParser :: Parser AnalysisName
checkNoThunksParser =
  Word64 -> AnalysisName
CheckNoThunksEvery
    (Word64 -> AnalysisName) -> Parser Word64 -> Parser AnalysisName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
      ReadM Word64
forall a. Read a => ReadM a
auto
      ( FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"checkThunks"
          Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"BLOCK_COUNT"
          Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Check the ledger state for thunks every n blocks"
      )

parseLimit :: Parser Limit
parseLimit :: Parser Limit
parseLimit =
  [Parser Limit] -> Parser Limit
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
Foldable.asum
    [ Int -> Limit
Limit
        (Int -> Limit) -> Parser Int -> Parser Limit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
          ReadM Int
forall a. Read a => ReadM a
auto
          ( [Mod OptionFields Int] -> Mod OptionFields Int
forall a. Monoid a => [a] -> a
mconcat
              [ FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"num-blocks-to-process"
              , FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Maximum number of blocks we want to process"
              , FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"INT"
              ]
          )
    , Limit -> Parser Limit
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Limit
Unlimited
    ]

benchmarkLedgerOpsParser :: Parser AnalysisName
benchmarkLedgerOpsParser :: Parser AnalysisName
benchmarkLedgerOpsParser =
  Parser (Maybe FilePath -> LedgerApplicationMode -> AnalysisName)
benchmarkLedgerOpsFlagParser
    Parser (Maybe FilePath -> LedgerApplicationMode -> AnalysisName)
-> Parser AnalysisName -> Parser AnalysisName
forall a b. Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Maybe FilePath -> LedgerApplicationMode -> AnalysisName
BenchmarkLedgerOps (Maybe FilePath -> LedgerApplicationMode -> AnalysisName)
-> Parser (Maybe FilePath)
-> Parser (LedgerApplicationMode -> AnalysisName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe FilePath)
pMaybeOutputFile Parser (LedgerApplicationMode -> AnalysisName)
-> Parser LedgerApplicationMode -> Parser AnalysisName
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser LedgerApplicationMode
pApplyMode)
 where
  benchmarkLedgerOpsFlagParser :: Parser (Maybe FilePath -> LedgerApplicationMode -> AnalysisName)
benchmarkLedgerOpsFlagParser =
    (Maybe FilePath -> LedgerApplicationMode -> AnalysisName)
-> Mod
     FlagFields
     (Maybe FilePath -> LedgerApplicationMode -> AnalysisName)
-> Parser (Maybe FilePath -> LedgerApplicationMode -> AnalysisName)
forall a. a -> Mod FlagFields a -> Parser a
flag' Maybe FilePath -> LedgerApplicationMode -> AnalysisName
BenchmarkLedgerOps (Mod
   FlagFields
   (Maybe FilePath -> LedgerApplicationMode -> AnalysisName)
 -> Parser
      (Maybe FilePath -> LedgerApplicationMode -> AnalysisName))
-> Mod
     FlagFields
     (Maybe FilePath -> LedgerApplicationMode -> AnalysisName)
-> Parser (Maybe FilePath -> LedgerApplicationMode -> AnalysisName)
forall a b. (a -> b) -> a -> b
$
      [Mod
   FlagFields
   (Maybe FilePath -> LedgerApplicationMode -> AnalysisName)]
-> Mod
     FlagFields
     (Maybe FilePath -> LedgerApplicationMode -> AnalysisName)
forall a. Monoid a => [a] -> a
mconcat
        [ FilePath
-> Mod
     FlagFields
     (Maybe FilePath -> LedgerApplicationMode -> AnalysisName)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"benchmark-ledger-ops"
        , FilePath
-> Mod
     FlagFields
     (Maybe FilePath -> LedgerApplicationMode -> AnalysisName)
forall (f :: * -> *) a. FilePath -> Mod f a
help (FilePath
 -> Mod
      FlagFields
      (Maybe FilePath -> LedgerApplicationMode -> AnalysisName))
-> FilePath
-> Mod
     FlagFields
     (Maybe FilePath -> LedgerApplicationMode -> AnalysisName)
forall a b. (a -> b) -> a -> b
$
            FilePath
"Maintain ledger state and benchmark the main ledger calculations for each block."
              FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" Prints one line of stats per block to the given output file "
              FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" (defaults to stdout)."
        ]

  pApplyMode :: Parser LedgerApplicationMode
pApplyMode =
    LedgerApplicationMode
-> LedgerApplicationMode
-> Mod FlagFields LedgerApplicationMode
-> Parser LedgerApplicationMode
forall a. a -> a -> Mod FlagFields a -> Parser a
flag LedgerApplicationMode
LedgerApply LedgerApplicationMode
LedgerReapply (Mod FlagFields LedgerApplicationMode
 -> Parser LedgerApplicationMode)
-> Mod FlagFields LedgerApplicationMode
-> Parser LedgerApplicationMode
forall a b. (a -> b) -> a -> b
$
      [Mod FlagFields LedgerApplicationMode]
-> Mod FlagFields LedgerApplicationMode
forall a. Monoid a => [a] -> a
mconcat
        [ FilePath -> Mod FlagFields LedgerApplicationMode
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"reapply"
        , FilePath -> Mod FlagFields LedgerApplicationMode
forall (f :: * -> *) a. FilePath -> Mod f a
help (FilePath -> Mod FlagFields LedgerApplicationMode)
-> FilePath -> Mod FlagFields LedgerApplicationMode
forall a b. (a -> b) -> a -> b
$ FilePath
"Measure header/block *re*application instead of full application."
        ]

getBlockApplicationMetrics :: Parser AnalysisName
getBlockApplicationMetrics :: Parser AnalysisName
getBlockApplicationMetrics = do
  Maybe FilePath -> AnalysisName
fGetBlockApplicationMetrics <- Parser (Maybe FilePath -> AnalysisName)
partialGetBlockApplicationMetricsParser
  Maybe FilePath
mOutputFile <- Parser (Maybe FilePath)
pMaybeOutputFile
  pure $ Maybe FilePath -> AnalysisName
fGetBlockApplicationMetrics Maybe FilePath
mOutputFile
 where
  partialGetBlockApplicationMetricsParser :: Parser (Maybe FilePath -> AnalysisName)
partialGetBlockApplicationMetricsParser =
    NumberOfBlocks -> Maybe FilePath -> AnalysisName
GetBlockApplicationMetrics (NumberOfBlocks -> Maybe FilePath -> AnalysisName)
-> (Word64 -> NumberOfBlocks)
-> Word64
-> Maybe FilePath
-> AnalysisName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> NumberOfBlocks
NumberOfBlocks
      (Word64 -> Maybe FilePath -> AnalysisName)
-> Parser Word64 -> Parser (Maybe FilePath -> AnalysisName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
        ReadM Word64
forall a. Read a => ReadM a
auto
        ( [Mod OptionFields Word64] -> Mod OptionFields Word64
forall a. Monoid a => [a] -> a
mconcat
            [ FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"get-block-application-metrics"
            , FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NUM"
            , FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. FilePath -> Mod f a
help (FilePath -> Mod OptionFields Word64)
-> FilePath -> Mod OptionFields Word64
forall a b. (a -> b) -> a -> b
$
                FilePath
"Compute block application metrics every 'NUM' blocks (it currently supports slot and block numbers and UTxO size). "
                  FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"Stores the result to the given output file "
                  FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" (defaults to stdout)."
            ]
        )

pMaybeOutputFile :: Parser (Maybe FilePath)
pMaybeOutputFile :: Parser (Maybe FilePath)
pMaybeOutputFile =
  Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser FilePath -> Parser (Maybe FilePath))
-> Parser FilePath -> Parser (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$
    Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
      ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"out-file"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"FILE"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Optional output file. Default is to write to stdout."
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (FilePath -> Completer
bashCompleter FilePath
"file")
      )

{-------------------------------------------------------------------------------
  Parse BlockType-specific arguments
-------------------------------------------------------------------------------}

parseCardanoArgs :: Parser CardanoBlockArgs
parseCardanoArgs :: Parser CardanoBlockArgs
parseCardanoArgs =
  FilePath -> Maybe PBftSignatureThreshold -> CardanoBlockArgs
CardanoBlockArgs
    (FilePath -> Maybe PBftSignatureThreshold -> CardanoBlockArgs)
-> Parser FilePath
-> Parser (Maybe PBftSignatureThreshold -> CardanoBlockArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath
parseConfigFile
    Parser (Maybe PBftSignatureThreshold -> CardanoBlockArgs)
-> Parser (Maybe PBftSignatureThreshold) -> Parser CardanoBlockArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe PBftSignatureThreshold)
parsePBftSignatureThreshold

parseConfigFile :: Parser FilePath
parseConfigFile :: Parser FilePath
parseConfigFile =
  Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"config"
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Path to config file"
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PATH"
      ]

parsePBftSignatureThreshold :: Parser (Maybe PBftSignatureThreshold)
parsePBftSignatureThreshold :: Parser (Maybe PBftSignatureThreshold)
parsePBftSignatureThreshold =
  Parser PBftSignatureThreshold
-> Parser (Maybe PBftSignatureThreshold)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser PBftSignatureThreshold
 -> Parser (Maybe PBftSignatureThreshold))
-> Parser PBftSignatureThreshold
-> Parser (Maybe PBftSignatureThreshold)
forall a b. (a -> b) -> a -> b
$
    (Double -> PBftSignatureThreshold)
-> Parser Double -> Parser PBftSignatureThreshold
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> PBftSignatureThreshold
PBftSignatureThreshold (Parser Double -> Parser PBftSignatureThreshold)
-> Parser Double -> Parser PBftSignatureThreshold
forall a b. (a -> b) -> a -> b
$
      ReadM Double -> Mod OptionFields Double -> Parser Double
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Double
forall a. Read a => ReadM a
auto (Mod OptionFields Double -> Parser Double)
-> Mod OptionFields Double -> Parser Double
forall a b. (a -> b) -> a -> b
$
        [Mod OptionFields Double] -> Mod OptionFields Double
forall a. Monoid a => [a] -> a
mconcat
          [ FilePath -> Mod OptionFields Double
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"threshold"
          , FilePath -> Mod OptionFields Double
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"PBftSignatureThreshold"
          , FilePath -> Mod OptionFields Double
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"THRESHOLD"
          ]