{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE NamedFieldPuns #-}

module Bcc.Node.Parsers
  ( nodeCLIParser
  , parserHelpHeader
  , parserHelpOptions
  , renderHelpDoc
  ) where

import           Bcc.Prelude hiding (option)
import           Prelude (String)

import           Data.Time.Clock (secondsToDiffTime)
import           Options.Applicative hiding (str)
import qualified Options.Applicative as Opt
import qualified Options.Applicative.Help as OptI
import           System.Posix.Types (Fd (..))

import           Shardagnostic.Network.Block (MaxSlotNo (..), SlotNo (..))

import           Shardagnostic.Consensus.Storage.LedgerDB.DiskPolicy (SnapshotInterval (..))

import           Bcc.Node.Configuration.POM (PartialNodeConfiguration (..), lastOption)
import           Bcc.Node.Types

nodeCLIParser  :: Parser PartialNodeConfiguration
nodeCLIParser :: Parser PartialNodeConfiguration
nodeCLIParser = Mod CommandFields PartialNodeConfiguration
-> Parser PartialNodeConfiguration
forall a. Mod CommandFields a -> Parser a
subparser
                (  String -> Mod CommandFields PartialNodeConfiguration
forall a. String -> Mod CommandFields a
commandGroup String
"Run the node"
                Mod CommandFields PartialNodeConfiguration
-> Mod CommandFields PartialNodeConfiguration
-> Mod CommandFields PartialNodeConfiguration
forall a. Semigroup a => a -> a -> a
<> String -> Mod CommandFields PartialNodeConfiguration
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"run"
                Mod CommandFields PartialNodeConfiguration
-> Mod CommandFields PartialNodeConfiguration
-> Mod CommandFields PartialNodeConfiguration
forall a. Semigroup a => a -> a -> a
<> String
-> ParserInfo PartialNodeConfiguration
-> Mod CommandFields PartialNodeConfiguration
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"run"
                     (Parser PartialNodeConfiguration
-> InfoMod PartialNodeConfiguration
-> ParserInfo PartialNodeConfiguration
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser PartialNodeConfiguration
nodeRunParser Parser PartialNodeConfiguration
-> Parser (PartialNodeConfiguration -> PartialNodeConfiguration)
-> Parser PartialNodeConfiguration
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (PartialNodeConfiguration -> PartialNodeConfiguration)
forall a. Parser (a -> a)
helper)
                           (String -> InfoMod PartialNodeConfiguration
forall a. String -> InfoMod a
progDesc String
"Run the node." ))
                )

nodeRunParser :: Parser PartialNodeConfiguration
nodeRunParser :: Parser PartialNodeConfiguration
nodeRunParser = do
  -- Filepaths
  Last String
topFp <- Parser String -> Parser (Last String)
forall a. Parser a -> Parser (Last a)
lastOption Parser String
parseTopologyFile
  Last String
dbFp <- Parser String -> Parser (Last String)
forall a. Parser a -> Parser (Last a)
lastOption Parser String
parseDbPath
  Last SocketPath
socketFp <-   Parser SocketPath -> Parser (Last SocketPath)
forall a. Parser a -> Parser (Last a)
lastOption (Parser SocketPath -> Parser (Last SocketPath))
-> Parser SocketPath -> Parser (Last SocketPath)
forall a b. (a -> b) -> a -> b
$ Text -> Parser SocketPath
parseSocketPath Text
"Path to a bcc-node socket"

  -- Protocol files
  Maybe String
coleCertFile   <- Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser String
parseColeDelegationCert
  Maybe String
coleKeyFile    <- Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser String
parseColeSigningKey
  Maybe String
sophieKESFile  <- Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser String
parseKesKeyFilePath
  Maybe String
sophieVRFFile  <- Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser String
parseVrfKeyFilePath
  Maybe String
sophieCertFile <- Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser String
parseOperationalCertFilePath
  Maybe String
sophieBulkCredsFile <- Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser String
parseBulkCredsFilePath

  -- Node Address
  Last NodeHostIPv4Address
nIPv4Address <- Parser NodeHostIPv4Address -> Parser (Last NodeHostIPv4Address)
forall a. Parser a -> Parser (Last a)
lastOption Parser NodeHostIPv4Address
parseHostIPv4Addr
  Last NodeHostIPv6Address
nIPv6Address <- Parser NodeHostIPv6Address -> Parser (Last NodeHostIPv6Address)
forall a. Parser a -> Parser (Last a)
lastOption Parser NodeHostIPv6Address
parseHostIPv6Addr
  Last PortNumber
nPortNumber  <- Parser PortNumber -> Parser (Last PortNumber)
forall a. Parser a -> Parser (Last a)
lastOption Parser PortNumber
parsePort

  -- NodeConfiguration filepath
  Last String
nodeConfigFp <- Parser String -> Parser (Last String)
forall a. Parser a -> Parser (Last a)
lastOption Parser String
parseConfigFile
  Last SnapshotInterval
snapshotInterval <- Parser SnapshotInterval -> Parser (Last SnapshotInterval)
forall a. Parser a -> Parser (Last a)
lastOption Parser SnapshotInterval
parseSnapshotInterval

  Last Bool
validate <- Parser Bool -> Parser (Last Bool)
forall a. Parser a -> Parser (Last a)
lastOption Parser Bool
parseValidateDB
  Last (Maybe Fd)
shutdownIPC <- Parser (Maybe Fd) -> Parser (Last (Maybe Fd))
forall a. Parser a -> Parser (Last a)
lastOption Parser (Maybe Fd)
parseShutdownIPC

  Last MaxSlotNo
shutdownOnSlotSynced <- Parser MaxSlotNo -> Parser (Last MaxSlotNo)
forall a. Parser a -> Parser (Last a)
lastOption Parser MaxSlotNo
parseShutdownOnSlotSynced

  pure $ PartialNodeConfiguration :: Last NodeHostIPv4Address
-> Last NodeHostIPv6Address
-> Last PortNumber
-> Last ConfigYamlFilePath
-> Last TopologyFile
-> Last DbFile
-> Last ProtocolFilepaths
-> Last Bool
-> Last (Maybe Fd)
-> Last MaxSlotNo
-> Last NodeProtocolConfiguration
-> Last SocketPath
-> Last DiffusionMode
-> Last SnapshotInterval
-> Last Bool
-> Last MaxConcurrencyBulkSync
-> Last MaxConcurrencyDeadline
-> Last Bool
-> Last Bool
-> Last TraceOptions
-> PartialNodeConfiguration
PartialNodeConfiguration
           { pncNodeIPv4Addr :: Last NodeHostIPv4Address
pncNodeIPv4Addr = Last NodeHostIPv4Address
nIPv4Address
           , pncNodeIPv6Addr :: Last NodeHostIPv6Address
pncNodeIPv6Addr = Last NodeHostIPv6Address
nIPv6Address
           , pncNodePortNumber :: Last PortNumber
pncNodePortNumber = Last PortNumber
nPortNumber
           , pncConfigFile :: Last ConfigYamlFilePath
pncConfigFile   = String -> ConfigYamlFilePath
ConfigYamlFilePath (String -> ConfigYamlFilePath)
-> Last String -> Last ConfigYamlFilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Last String
nodeConfigFp
           , pncTopologyFile :: Last TopologyFile
pncTopologyFile = String -> TopologyFile
TopologyFile (String -> TopologyFile) -> Last String -> Last TopologyFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Last String
topFp
           , pncDatabaseFile :: Last DbFile
pncDatabaseFile = String -> DbFile
DbFile (String -> DbFile) -> Last String -> Last DbFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Last String
dbFp
           , pncSocketPath :: Last SocketPath
pncSocketPath   = Last SocketPath
socketFp
           , pncDiffusionMode :: Last DiffusionMode
pncDiffusionMode = Last DiffusionMode
forall a. Monoid a => a
mempty
           , pncSnapshotInterval :: Last SnapshotInterval
pncSnapshotInterval = Last SnapshotInterval
snapshotInterval
           , pncTestEnableDevelopmentNetworkProtocols :: Last Bool
pncTestEnableDevelopmentNetworkProtocols = Last Bool
forall a. Monoid a => a
mempty
           , pncProtocolFiles :: Last ProtocolFilepaths
pncProtocolFiles = Maybe ProtocolFilepaths -> Last ProtocolFilepaths
forall a. Maybe a -> Last a
Last (Maybe ProtocolFilepaths -> Last ProtocolFilepaths)
-> Maybe ProtocolFilepaths -> Last ProtocolFilepaths
forall a b. (a -> b) -> a -> b
$ ProtocolFilepaths -> Maybe ProtocolFilepaths
forall a. a -> Maybe a
Just ProtocolFilepaths :: Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> ProtocolFilepaths
ProtocolFilepaths
             { Maybe String
coleCertFile :: Maybe String
coleCertFile :: Maybe String
coleCertFile
             , Maybe String
coleKeyFile :: Maybe String
coleKeyFile :: Maybe String
coleKeyFile
             , Maybe String
sophieKESFile :: Maybe String
sophieKESFile :: Maybe String
sophieKESFile
             , Maybe String
sophieVRFFile :: Maybe String
sophieVRFFile :: Maybe String
sophieVRFFile
             , Maybe String
sophieCertFile :: Maybe String
sophieCertFile :: Maybe String
sophieCertFile
             , Maybe String
sophieBulkCredsFile :: Maybe String
sophieBulkCredsFile :: Maybe String
sophieBulkCredsFile
             }
           , pncValidateDB :: Last Bool
pncValidateDB = Last Bool
validate
           , pncShutdownIPC :: Last (Maybe Fd)
pncShutdownIPC = Last (Maybe Fd)
shutdownIPC
           , pncShutdownOnSlotSynced :: Last MaxSlotNo
pncShutdownOnSlotSynced = Last MaxSlotNo
shutdownOnSlotSynced
           , pncProtocolConfig :: Last NodeProtocolConfiguration
pncProtocolConfig = Last NodeProtocolConfiguration
forall a. Monoid a => a
mempty
           , pncMaxConcurrencyBulkSync :: Last MaxConcurrencyBulkSync
pncMaxConcurrencyBulkSync = Last MaxConcurrencyBulkSync
forall a. Monoid a => a
mempty
           , pncMaxConcurrencyDeadline :: Last MaxConcurrencyDeadline
pncMaxConcurrencyDeadline = Last MaxConcurrencyDeadline
forall a. Monoid a => a
mempty
           , pncLoggingSwitch :: Last Bool
pncLoggingSwitch = Last Bool
forall a. Monoid a => a
mempty
           , pncLogMetrics :: Last Bool
pncLogMetrics = Last Bool
forall a. Monoid a => a
mempty
           , pncTraceConfig :: Last TraceOptions
pncTraceConfig = Last TraceOptions
forall a. Monoid a => a
mempty
           }

parseSocketPath :: Text -> Parser SocketPath
parseSocketPath :: Text -> Parser SocketPath
parseSocketPath Text
helpMessage =
  String -> SocketPath
SocketPath (String -> SocketPath) -> Parser String -> Parser SocketPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"socket-path"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help (Text -> String
forall a b. ConvertText a b => a -> b
toS Text
helpMessage)
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (String -> Completer
bashCompleter String
"file")
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILEPATH"
    )

parseHostIPv4Addr :: Parser NodeHostIPv4Address
parseHostIPv4Addr :: Parser NodeHostIPv4Address
parseHostIPv4Addr =
    ReadM NodeHostIPv4Address
-> Mod OptionFields NodeHostIPv4Address
-> Parser NodeHostIPv4Address
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((String -> Either String NodeHostIPv4Address)
-> ReadM NodeHostIPv4Address
forall a. (String -> Either String a) -> ReadM a
eitherReader String -> Either String NodeHostIPv4Address
parseNodeHostIPv4Address) (
          String -> Mod OptionFields NodeHostIPv4Address
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"host-addr"
       Mod OptionFields NodeHostIPv4Address
-> Mod OptionFields NodeHostIPv4Address
-> Mod OptionFields NodeHostIPv4Address
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields NodeHostIPv4Address
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"IPV4"
       Mod OptionFields NodeHostIPv4Address
-> Mod OptionFields NodeHostIPv4Address
-> Mod OptionFields NodeHostIPv4Address
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields NodeHostIPv4Address
forall (f :: * -> *) a. String -> Mod f a
help String
"An optional IPv4 address"
    )

parseHostIPv6Addr :: Parser NodeHostIPv6Address
parseHostIPv6Addr :: Parser NodeHostIPv6Address
parseHostIPv6Addr =
    ReadM NodeHostIPv6Address
-> Mod OptionFields NodeHostIPv6Address
-> Parser NodeHostIPv6Address
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((String -> Either String NodeHostIPv6Address)
-> ReadM NodeHostIPv6Address
forall a. (String -> Either String a) -> ReadM a
eitherReader String -> Either String NodeHostIPv6Address
parseNodeHostIPv6Address) (
          String -> Mod OptionFields NodeHostIPv6Address
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"host-ipv6-addr"
       Mod OptionFields NodeHostIPv6Address
-> Mod OptionFields NodeHostIPv6Address
-> Mod OptionFields NodeHostIPv6Address
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields NodeHostIPv6Address
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"IPV6"
       Mod OptionFields NodeHostIPv6Address
-> Mod OptionFields NodeHostIPv6Address
-> Mod OptionFields NodeHostIPv6Address
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields NodeHostIPv6Address
forall (f :: * -> *) a. String -> Mod f a
help String
"An optional IPv6 address"
    )

parseNodeHostIPv4Address :: String -> Either String NodeHostIPv4Address
parseNodeHostIPv4Address :: String -> Either String NodeHostIPv4Address
parseNodeHostIPv4Address String
str =
  Either String NodeHostIPv4Address
-> (IPv4 -> Either String NodeHostIPv4Address)
-> Maybe IPv4
-> Either String NodeHostIPv4Address
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (String -> Either String NodeHostIPv4Address
forall a b. a -> Either a b
Left (String -> Either String NodeHostIPv4Address)
-> String -> Either String NodeHostIPv4Address
forall a b. (a -> b) -> a -> b
$
      String
"Failed to parse IPv4 address: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
". If you want to specify an IPv6 address, use --host-ipv6-addr option.")
    (NodeHostIPv4Address -> Either String NodeHostIPv4Address
forall a b. b -> Either a b
Right (NodeHostIPv4Address -> Either String NodeHostIPv4Address)
-> (IPv4 -> NodeHostIPv4Address)
-> IPv4
-> Either String NodeHostIPv4Address
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IPv4 -> NodeHostIPv4Address
NodeHostIPv4Address)
    (String -> Maybe IPv4
forall a. Read a => String -> Maybe a
readMaybe String
str)

parseNodeHostIPv6Address :: String -> Either String NodeHostIPv6Address
parseNodeHostIPv6Address :: String -> Either String NodeHostIPv6Address
parseNodeHostIPv6Address String
str =
  Either String NodeHostIPv6Address
-> (IPv6 -> Either String NodeHostIPv6Address)
-> Maybe IPv6
-> Either String NodeHostIPv6Address
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (String -> Either String NodeHostIPv6Address
forall a b. a -> Either a b
Left (String -> Either String NodeHostIPv6Address)
-> String -> Either String NodeHostIPv6Address
forall a b. (a -> b) -> a -> b
$
      String
"Failed to parse IPv6 address: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
". If you want to specify an IPv4 adddress, use --host-addr option.")
    (NodeHostIPv6Address -> Either String NodeHostIPv6Address
forall a b. b -> Either a b
Right (NodeHostIPv6Address -> Either String NodeHostIPv6Address)
-> (IPv6 -> NodeHostIPv6Address)
-> IPv6
-> Either String NodeHostIPv6Address
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IPv6 -> NodeHostIPv6Address
NodeHostIPv6Address)
    (String -> Maybe IPv6
forall a. Read a => String -> Maybe a
readMaybe String
str)

parsePort :: Parser PortNumber
parsePort :: Parser PortNumber
parsePort =
    ReadM PortNumber
-> Mod OptionFields PortNumber -> Parser PortNumber
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> PortNumber) (Int -> PortNumber) -> ReadM Int -> ReadM PortNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Int
forall a. Read a => ReadM a
auto) (
          String -> Mod OptionFields PortNumber
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"port"
       Mod OptionFields PortNumber
-> Mod OptionFields PortNumber -> Mod OptionFields PortNumber
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PortNumber
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PORT"
       Mod OptionFields PortNumber
-> Mod OptionFields PortNumber -> Mod OptionFields PortNumber
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PortNumber
forall (f :: * -> *) a. String -> Mod f a
help String
"The port number"
       Mod OptionFields PortNumber
-> Mod OptionFields PortNumber -> Mod OptionFields PortNumber
forall a. Semigroup a => a -> a -> a
<> PortNumber -> Mod OptionFields PortNumber
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value PortNumber
0 -- Use an ephemeral port
    )

parseConfigFile :: Parser FilePath
parseConfigFile :: Parser String
parseConfigFile =
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"config"
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NODE-CONFIGURATION"
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Configuration file for the bcc-node"
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (String -> Completer
bashCompleter String
"file")
    )

parseDbPath :: Parser FilePath
parseDbPath :: Parser String
parseDbPath =
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"database-path"
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILEPATH"
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Directory where the state is stored."
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (String -> Completer
bashCompleter String
"file")
    )

parseValidateDB :: Parser Bool
parseValidateDB :: Parser Bool
parseValidateDB =
    Mod FlagFields Bool -> Parser Bool
switch (
         String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"validate-db"
      Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Validate all on-disk database files"
    )

parseShutdownIPC :: Parser (Maybe Fd)
parseShutdownIPC :: Parser (Maybe Fd)
parseShutdownIPC =
    Parser Fd -> Parser (Maybe Fd)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Fd -> Parser (Maybe Fd)) -> Parser Fd -> Parser (Maybe Fd)
forall a b. (a -> b) -> a -> b
$ ReadM Fd -> Mod OptionFields Fd -> Parser Fd
forall a. ReadM a -> Mod OptionFields a -> Parser a
option (CInt -> Fd
Fd (CInt -> Fd) -> ReadM CInt -> ReadM Fd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM CInt
forall a. Read a => ReadM a
auto) (
         String -> Mod OptionFields Fd
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"shutdown-ipc"
      Mod OptionFields Fd -> Mod OptionFields Fd -> Mod OptionFields Fd
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Fd
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FD"
      Mod OptionFields Fd -> Mod OptionFields Fd -> Mod OptionFields Fd
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Fd
forall (f :: * -> *) a. String -> Mod f a
help String
"Shut down the process when this inherited FD reaches EOF"
      Mod OptionFields Fd -> Mod OptionFields Fd -> Mod OptionFields Fd
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Fd
forall (f :: * -> *) a. Mod f a
hidden
    )

parseShutdownOnSlotSynced :: Parser MaxSlotNo
parseShutdownOnSlotSynced :: Parser MaxSlotNo
parseShutdownOnSlotSynced =
    (Maybe MaxSlotNo -> MaxSlotNo)
-> Parser (Maybe MaxSlotNo) -> Parser MaxSlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MaxSlotNo -> Maybe MaxSlotNo -> MaxSlotNo
forall a. a -> Maybe a -> a
fromMaybe MaxSlotNo
NoMaxSlotNo) (Parser (Maybe MaxSlotNo) -> Parser MaxSlotNo)
-> Parser (Maybe MaxSlotNo) -> Parser MaxSlotNo
forall a b. (a -> b) -> a -> b
$
    Parser MaxSlotNo -> Parser (Maybe MaxSlotNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser MaxSlotNo -> Parser (Maybe MaxSlotNo))
-> Parser MaxSlotNo -> Parser (Maybe MaxSlotNo)
forall a b. (a -> b) -> a -> b
$ ReadM MaxSlotNo -> Mod OptionFields MaxSlotNo -> Parser MaxSlotNo
forall a. ReadM a -> Mod OptionFields a -> Parser a
option (SlotNo -> MaxSlotNo
MaxSlotNo (SlotNo -> MaxSlotNo) -> (Word64 -> SlotNo) -> Word64 -> MaxSlotNo
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> SlotNo
SlotNo (Word64 -> MaxSlotNo) -> ReadM Word64 -> ReadM MaxSlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Word64
forall a. Read a => ReadM a
auto) (
         String -> Mod OptionFields MaxSlotNo
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"shutdown-on-slot-synced"
      Mod OptionFields MaxSlotNo
-> Mod OptionFields MaxSlotNo -> Mod OptionFields MaxSlotNo
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields MaxSlotNo
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SLOT"
      Mod OptionFields MaxSlotNo
-> Mod OptionFields MaxSlotNo -> Mod OptionFields MaxSlotNo
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields MaxSlotNo
forall (f :: * -> *) a. String -> Mod f a
help String
"Shut down the process after ChainDB is synced up to the specified slot"
      Mod OptionFields MaxSlotNo
-> Mod OptionFields MaxSlotNo -> Mod OptionFields MaxSlotNo
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields MaxSlotNo
forall (f :: * -> *) a. Mod f a
hidden
    )

parseTopologyFile :: Parser FilePath
parseTopologyFile :: Parser String
parseTopologyFile =
    Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (
            String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"topology"
         Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILEPATH"
         Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"The path to a file describing the topology."
         Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (String -> Completer
bashCompleter String
"file")
    )

parseColeDelegationCert :: Parser FilePath
parseColeDelegationCert :: Parser String
parseColeDelegationCert =
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"cole-delegation-certificate"
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILEPATH"
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Path to the delegation certificate."
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (String -> Completer
bashCompleter String
"file")
    )
  Parser String -> Parser String -> Parser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"delegation-certificate"
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
    )

parseColeSigningKey :: Parser FilePath
parseColeSigningKey :: Parser String
parseColeSigningKey =
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"cole-signing-key"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILEPATH"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Path to the Cole signing key."
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (String -> Completer
bashCompleter String
"file")
            )
  Parser String -> Parser String -> Parser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"signing-key"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall (f :: * -> *) a. Mod f a
Opt.internal
            )

parseOperationalCertFilePath :: Parser FilePath
parseOperationalCertFilePath :: Parser String
parseOperationalCertFilePath =
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"sophie-operational-certificate"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILEPATH"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Path to the delegation certificate."
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (String -> Completer
bashCompleter String
"file")
    )

parseBulkCredsFilePath :: Parser FilePath
parseBulkCredsFilePath :: Parser String
parseBulkCredsFilePath =
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"bulk-credentials-file"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILEPATH"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Path to the bulk pool credentials file."
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (String -> Completer
bashCompleter String
"file")
    )

--TODO: pass the current KES evolution, not the KES_0
parseKesKeyFilePath :: Parser FilePath
parseKesKeyFilePath :: Parser String
parseKesKeyFilePath =
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"sophie-kes-key"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILEPATH"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Path to the KES signing key."
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (String -> Completer
bashCompleter String
"file")
    )

parseVrfKeyFilePath :: Parser FilePath
parseVrfKeyFilePath :: Parser String
parseVrfKeyFilePath =
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"sophie-vrf-key"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILEPATH"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Path to the VRF signing key."
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (String -> Completer
bashCompleter String
"file")
    )

-- TODO revisit because it sucks
parseSnapshotInterval :: Parser SnapshotInterval
parseSnapshotInterval :: Parser SnapshotInterval
parseSnapshotInterval = (Integer -> SnapshotInterval)
-> Parser Integer -> Parser SnapshotInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DiffTime -> SnapshotInterval
RequestedSnapshotInterval (DiffTime -> SnapshotInterval)
-> (Integer -> DiffTime) -> Integer -> SnapshotInterval
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> DiffTime
secondsToDiffTime) Parser Integer
parseDifftime
  where
  parseDifftime :: Parser Integer
parseDifftime = ReadM Integer -> Mod OptionFields Integer -> Parser Integer
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Integer
forall a. Read a => ReadM a
auto
    ( String -> Mod OptionFields Integer
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"snapshot-interval"
        Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Integer
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SNAPSHOTINTERVAL"
        Mod OptionFields Integer
-> Mod OptionFields Integer -> Mod OptionFields Integer
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Integer
forall (f :: * -> *) a. String -> Mod f a
help String
"Snapshot Interval (in second)"
    )

-- | Produce just the brief help header for a given CLI option parser,
--   without the options.
parserHelpHeader :: String -> Opt.Parser a -> OptI.Doc
parserHelpHeader :: String -> Parser a -> Doc
parserHelpHeader = (Parser a -> String -> Doc) -> String -> Parser a -> Doc
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ParserPrefs -> Parser a -> String -> Doc
forall a. ParserPrefs -> Parser a -> String -> Doc
OptI.parserUsage (PrefsMod -> ParserPrefs
Opt.prefs PrefsMod
forall a. Monoid a => a
mempty))

-- | Produce just the options help for a given CLI option parser,
--   without the header.
parserHelpOptions :: Opt.Parser a -> OptI.Doc
parserHelpOptions :: Parser a -> Doc
parserHelpOptions = Doc -> Maybe Doc -> Doc
forall a. a -> Maybe a -> a
fromMaybe Doc
forall a. Monoid a => a
mempty (Maybe Doc -> Doc) -> (Parser a -> Maybe Doc) -> Parser a -> Doc
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Chunk Doc -> Maybe Doc
forall a. Chunk a -> Maybe a
OptI.unChunk (Chunk Doc -> Maybe Doc)
-> (Parser a -> Chunk Doc) -> Parser a -> Maybe Doc
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ParserPrefs -> Parser a -> Chunk Doc
forall a. ParserPrefs -> Parser a -> Chunk Doc
OptI.fullDesc (PrefsMod -> ParserPrefs
Opt.prefs PrefsMod
forall a. Monoid a => a
mempty)

-- | Render the help pretty document.
renderHelpDoc :: Int -> OptI.Doc -> String
renderHelpDoc :: Int -> Doc -> String
renderHelpDoc Int
cols =
  (SimpleDocStream Ann -> String -> String
forall ann. SimpleDocStream ann -> String -> String
`OptI.renderShowS` String
"") (SimpleDocStream Ann -> String)
-> (Doc -> SimpleDocStream Ann) -> Doc -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LayoutOptions -> Doc -> SimpleDocStream Ann
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
OptI.layoutPretty (PageWidth -> LayoutOptions
OptI.LayoutOptions (Int -> Double -> PageWidth
OptI.AvailablePerLine Int
cols Double
1.0))