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

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
import qualified Data.Foldable as Foldable
import           Options.Applicative
import           Ouroboros.Consensus.Block (SlotNo (..), WithOrigin (..))
import           Ouroboros.Consensus.Byron.Node (PBftSignatureThreshold (..))
import           Ouroboros.Consensus.Shelley.Node (Nonce (..))

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

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
Foldable.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