{-# LANGUAGE ApplicativeDo      #-}
{-# LANGUAGE CPP                #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE PatternSynonyms    #-}

module DBAnalyser.Parsers (
    BlockType (..)
  , blockTypeParser
  , parseCmdLine
  ) where

import           Cardano.Crypto (RequiresNetworkMagic (..))
import           Cardano.Tools.DBAnalyser.Analysis
import           Cardano.Tools.DBAnalyser.Block.Byron
import           Cardano.Tools.DBAnalyser.Block.Cardano
import           Cardano.Tools.DBAnalyser.Block.Shelley
import           Cardano.Tools.DBAnalyser.Types
#if __GLASGOW_HASKELL__ < 900
import           Data.Foldable (asum)
#endif
import           Options.Applicative
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Byron.Node (PBftSignatureThreshold (..))
import           Ouroboros.Consensus.Shelley.Node (Nonce (..))
import           Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (pattern DoDiskSnapshotChecksum, pattern NoDoDiskSnapshotChecksum)

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

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

parseDBAnalyserConfig :: Parser DBAnalyserConfig
parseDBAnalyserConfig :: Parser DBAnalyserConfig
parseDBAnalyserConfig = FilePath
-> Bool
-> SelectDB
-> Maybe ValidateBlocks
-> AnalysisName
-> Limit
-> Flag "DoDiskSnapshotChecksum"
-> DBAnalyserConfig
DBAnalyserConfig
    (FilePath
 -> Bool
 -> SelectDB
 -> Maybe ValidateBlocks
 -> AnalysisName
 -> Limit
 -> Flag "DoDiskSnapshotChecksum"
 -> DBAnalyserConfig)
-> Parser FilePath
-> Parser
     (Bool
      -> SelectDB
      -> Maybe ValidateBlocks
      -> AnalysisName
      -> Limit
      -> Flag "DoDiskSnapshotChecksum"
      -> 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
   -> Flag "DoDiskSnapshotChecksum"
   -> DBAnalyserConfig)
-> Parser Bool
-> Parser
     (SelectDB
      -> Maybe ValidateBlocks
      -> AnalysisName
      -> Limit
      -> Flag "DoDiskSnapshotChecksum"
      -> 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
   -> Flag "DoDiskSnapshotChecksum"
   -> DBAnalyserConfig)
-> Parser SelectDB
-> Parser
     (Maybe ValidateBlocks
      -> AnalysisName
      -> Limit
      -> Flag "DoDiskSnapshotChecksum"
      -> 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
   -> Flag "DoDiskSnapshotChecksum"
   -> DBAnalyserConfig)
-> Parser (Maybe ValidateBlocks)
-> Parser
     (AnalysisName
      -> Limit -> Flag "DoDiskSnapshotChecksum" -> 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 -> Flag "DoDiskSnapshotChecksum" -> DBAnalyserConfig)
-> Parser AnalysisName
-> Parser
     (Limit -> Flag "DoDiskSnapshotChecksum" -> 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 -> Flag "DoDiskSnapshotChecksum" -> DBAnalyserConfig)
-> Parser Limit
-> Parser (Flag "DoDiskSnapshotChecksum" -> 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 (Flag "DoDiskSnapshotChecksum" -> DBAnalyserConfig)
-> Parser (Flag "DoDiskSnapshotChecksum")
-> 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
<*> Flag "DoDiskSnapshotChecksum"
-> Flag "DoDiskSnapshotChecksum"
-> Mod FlagFields (Flag "DoDiskSnapshotChecksum")
-> Parser (Flag "DoDiskSnapshotChecksum")
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Flag "DoDiskSnapshotChecksum"
DoDiskSnapshotChecksum Flag "DoDiskSnapshotChecksum"
NoDoDiskSnapshotChecksum ([Mod FlagFields (Flag "DoDiskSnapshotChecksum")]
-> Mod FlagFields (Flag "DoDiskSnapshotChecksum")
forall a. Monoid a => [a] -> a
mconcat [
            FilePath -> Mod FlagFields (Flag "DoDiskSnapshotChecksum")
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"no-snapshot-checksum-on-read"
          , FilePath -> Mod FlagFields (Flag "DoDiskSnapshotChecksum")
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Don't check the '.checksum' file when reading a ledger snapshot"
          ])

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
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)."
            )
    )
  Flag "DoDiskSnapshotChecksum"
doChecksum <- Flag "DoDiskSnapshotChecksum"
-> Flag "DoDiskSnapshotChecksum"
-> Mod FlagFields (Flag "DoDiskSnapshotChecksum")
-> Parser (Flag "DoDiskSnapshotChecksum")
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Flag "DoDiskSnapshotChecksum"
DoDiskSnapshotChecksum Flag "DoDiskSnapshotChecksum"
NoDoDiskSnapshotChecksum
    ([Mod FlagFields (Flag "DoDiskSnapshotChecksum")]
-> Mod FlagFields (Flag "DoDiskSnapshotChecksum")
forall a. Monoid a => [a] -> a
mconcat [ FilePath -> Mod FlagFields (Flag "DoDiskSnapshotChecksum")
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"no-snapshot-checksum-on-write"
             , FilePath -> Mod FlagFields (Flag "DoDiskSnapshotChecksum")
forall (f :: * -> *) a. FilePath -> Mod f a
help ([FilePath] -> FilePath
unlines [ FilePath
"Don't calculate the checksum and"
                             , FilePath
"write the '.checksum' file"
                             , FilePath
"when taking a ledger snapshot"
                             ])
             ])
  pure $ SlotNo
-> LedgerApplicationMode
-> Flag "DoDiskSnapshotChecksum"
-> AnalysisName
StoreLedgerStateAt SlotNo
slot LedgerApplicationMode
ledgerValidation Flag "DoDiskSnapshotChecksum"
doChecksum

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
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
-------------------------------------------------------------------------------}

data BlockType =
    ByronBlock   ByronBlockArgs
  | ShelleyBlock ShelleyBlockArgs
  | CardanoBlock CardanoBlockArgs

blockTypeParser :: Parser BlockType
blockTypeParser :: Parser BlockType
blockTypeParser = Mod CommandFields BlockType -> Parser BlockType
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields BlockType -> Parser BlockType)
-> Mod CommandFields BlockType -> Parser BlockType
forall a b. (a -> b) -> a -> b
$ [Mod CommandFields BlockType] -> Mod CommandFields BlockType
forall a. Monoid a => [a] -> a
mconcat
  [ FilePath -> ParserInfo BlockType -> Mod CommandFields BlockType
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"byron"
      (Parser BlockType -> InfoMod BlockType -> ParserInfo BlockType
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser BlockType
parseByronType   Parser BlockType
-> Parser (BlockType -> BlockType) -> Parser BlockType
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (BlockType -> BlockType)
forall a. Parser (a -> a)
helper) (FilePath -> InfoMod BlockType
forall a. FilePath -> InfoMod a
progDesc FilePath
"Analyse a Byron-only DB"))
  , FilePath -> ParserInfo BlockType -> Mod CommandFields BlockType
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"shelley"
      (Parser BlockType -> InfoMod BlockType -> ParserInfo BlockType
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser BlockType
parseShelleyType Parser BlockType
-> Parser (BlockType -> BlockType) -> Parser BlockType
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (BlockType -> BlockType)
forall a. Parser (a -> a)
helper) (FilePath -> InfoMod BlockType
forall a. FilePath -> InfoMod a
progDesc FilePath
"Analyse a Shelley-only DB"))
  , FilePath -> ParserInfo BlockType -> Mod CommandFields BlockType
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"cardano"
      (Parser BlockType -> InfoMod BlockType -> ParserInfo BlockType
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser BlockType
parseCardanoType Parser BlockType
-> Parser (BlockType -> BlockType) -> Parser BlockType
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (BlockType -> BlockType)
forall a. Parser (a -> a)
helper) (FilePath -> InfoMod BlockType
forall a. FilePath -> InfoMod a
progDesc FilePath
"Analyse a Cardano DB"))
  ]

parseByronType :: Parser BlockType
parseByronType :: Parser BlockType
parseByronType = ByronBlockArgs -> BlockType
ByronBlock (ByronBlockArgs -> BlockType)
-> Parser ByronBlockArgs -> Parser BlockType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByronBlockArgs
parseByronArgs

parseShelleyType :: Parser BlockType
parseShelleyType :: Parser BlockType
parseShelleyType = ShelleyBlockArgs -> BlockType
ShelleyBlock (ShelleyBlockArgs -> BlockType)
-> Parser ShelleyBlockArgs -> Parser BlockType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ShelleyBlockArgs
parseShelleyArgs

parseCardanoType :: Parser BlockType
parseCardanoType :: Parser BlockType
parseCardanoType = CardanoBlockArgs -> BlockType
CardanoBlock (CardanoBlockArgs -> BlockType)
-> Parser CardanoBlockArgs -> Parser BlockType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CardanoBlockArgs
parseCardanoArgs

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

parseShelleyArgs :: Parser ShelleyBlockArgs
parseShelleyArgs :: Parser ShelleyBlockArgs
parseShelleyArgs = FilePath -> Nonce -> ShelleyBlockArgs
ShelleyBlockArgs
    (FilePath -> Nonce -> ShelleyBlockArgs)
-> Parser FilePath -> Parser (Nonce -> ShelleyBlockArgs)
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
"configShelley"
          , 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"
          ])
    Parser (Nonce -> ShelleyBlockArgs)
-> Parser Nonce -> Parser ShelleyBlockArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Parser Nonce] -> Parser Nonce
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [ Hash Blake2b_256 Nonce -> Nonce
Nonce  (Hash Blake2b_256 Nonce -> Nonce)
-> Parser (Hash Blake2b_256 Nonce) -> Parser Nonce
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Hash Blake2b_256 Nonce)
parseNonce
             , Nonce -> Parser Nonce
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Nonce
NeutralNonce]
  where
    parseNonce :: Parser (Hash Blake2b_256 Nonce)
parseNonce = Mod OptionFields (Hash Blake2b_256 Nonce)
-> Parser (Hash Blake2b_256 Nonce)
forall s. IsString s => Mod OptionFields s -> Parser s
strOption ([Mod OptionFields (Hash Blake2b_256 Nonce)]
-> Mod OptionFields (Hash Blake2b_256 Nonce)
forall a. Monoid a => [a] -> a
mconcat [
            FilePath -> Mod OptionFields (Hash Blake2b_256 Nonce)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"nonce"
          , FilePath -> Mod OptionFields (Hash Blake2b_256 Nonce)
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Initial nonce, i.e., hash of the genesis config file"
          , FilePath -> Mod OptionFields (Hash Blake2b_256 Nonce)
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NONCE"
          ])

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"
    ]

parseByronArgs :: Parser ByronBlockArgs
parseByronArgs :: Parser ByronBlockArgs
parseByronArgs = FilePath
-> RequiresNetworkMagic
-> Maybe (Hash Raw)
-> Maybe PBftSignatureThreshold
-> ByronBlockArgs
ByronBlockArgs
    (FilePath
 -> RequiresNetworkMagic
 -> Maybe (Hash Raw)
 -> Maybe PBftSignatureThreshold
 -> ByronBlockArgs)
-> Parser FilePath
-> Parser
     (RequiresNetworkMagic
      -> Maybe (Hash Raw)
      -> Maybe PBftSignatureThreshold
      -> ByronBlockArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath
parseConfigFile
    Parser
  (RequiresNetworkMagic
   -> Maybe (Hash Raw)
   -> Maybe PBftSignatureThreshold
   -> ByronBlockArgs)
-> Parser RequiresNetworkMagic
-> Parser
     (Maybe (Hash Raw)
      -> Maybe PBftSignatureThreshold -> ByronBlockArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RequiresNetworkMagic
-> RequiresNetworkMagic
-> Mod FlagFields RequiresNetworkMagic
-> Parser RequiresNetworkMagic
forall a. a -> a -> Mod FlagFields a -> Parser a
flag RequiresNetworkMagic
RequiresNoMagic RequiresNetworkMagic
RequiresMagic ([Mod FlagFields RequiresNetworkMagic]
-> Mod FlagFields RequiresNetworkMagic
forall a. Monoid a => [a] -> a
mconcat [
            FilePath -> Mod FlagFields RequiresNetworkMagic
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"requires-magic"
          , FilePath -> Mod FlagFields RequiresNetworkMagic
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"The DB contains blocks from a testnet, requiring network magic, rather than mainnet"
          ])
    Parser
  (Maybe (Hash Raw)
   -> Maybe PBftSignatureThreshold -> ByronBlockArgs)
-> Parser (Maybe (Hash Raw))
-> Parser (Maybe PBftSignatureThreshold -> ByronBlockArgs)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Hash Raw) -> Parser (Maybe (Hash Raw))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM (Hash Raw)
-> Mod OptionFields (Hash Raw) -> Parser (Hash Raw)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM (Hash Raw)
forall a. Read a => ReadM a
auto ([Mod OptionFields (Hash Raw)] -> Mod OptionFields (Hash Raw)
forall a. Monoid a => [a] -> a
mconcat [
            FilePath -> Mod OptionFields (Hash Raw)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"genesisHash"
          , FilePath -> Mod OptionFields (Hash Raw)
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Expected genesis hash"
          , FilePath -> Mod OptionFields (Hash Raw)
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"HASH"
          ]))
    Parser (Maybe PBftSignatureThreshold -> ByronBlockArgs)
-> Parser (Maybe PBftSignatureThreshold) -> Parser ByronBlockArgs
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