{-# LANGUAGE ApplicativeDo #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Hydra.Options (
  module Hydra.Options,
  ParserResult (..),
  renderFailure,
) where

import Hydra.Prelude

import Control.Arrow (left)
import Control.Lens ((?~))
import Data.Aeson (Value (Object, String), withObject, (.:))
import Data.Aeson.Lens (atKey)
import Data.ByteString qualified as BS
import Data.ByteString.Char8 qualified as BSC
import Data.IP (IP (IPv4), toIPv4, toIPv4w)
import Data.Text (unpack)
import Data.Text qualified as T
import Data.Version (Version (..), showVersion)
import Hydra.Cardano.Api (
  AsType (AsTxId),
  ChainPoint (..),
  File (..),
  NetworkId (..),
  NetworkMagic (..),
  SlotNo (..),
  SocketPath,
  TxId (..),
  deserialiseFromRawBytes,
  deserialiseFromRawBytesHex,
  proxyToAsType,
  serialiseToRawBytesHexText,
 )
import Hydra.Chain (maximumNumberOfParties)
import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod), fromNominalDiffTime)
import Hydra.Contract qualified as Contract
import Hydra.Ledger.Cardano ()
import Hydra.Logging (Verbosity (..))
import Hydra.Network (Host, NodeId (NodeId), PortNumber, readHost, readPort)
import Hydra.Version (embeddedRevision, gitRevision, unknownVersion)
import Options.Applicative (
  Parser,
  ParserInfo,
  ParserResult (..),
  auto,
  command,
  completer,
  defaultPrefs,
  eitherReader,
  execParserPure,
  flag,
  flag',
  footer,
  fullDesc,
  handleParseResult,
  header,
  help,
  helper,
  hsubparser,
  info,
  infoOption,
  listCompleter,
  long,
  maybeReader,
  metavar,
  option,
  progDesc,
  progDescDoc,
  renderFailure,
  short,
  showDefault,
  strOption,
  value,
 )
import Options.Applicative.Builder (str)
import Options.Applicative.Help (vsep)
import Paths_hydra_node (version)
import Test.QuickCheck (elements, listOf, listOf1, oneof, suchThat, vectorOf)

data Command
  = Run RunOptions
  | Publish PublishOptions
  | GenHydraKey GenerateKeyPair
  deriving stock (Int -> Command -> ShowS
[Command] -> ShowS
Command -> [Char]
(Int -> Command -> ShowS)
-> (Command -> [Char]) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Command -> ShowS
showsPrec :: Int -> Command -> ShowS
$cshow :: Command -> [Char]
show :: Command -> [Char]
$cshowList :: [Command] -> ShowS
showList :: [Command] -> ShowS
Show, Command -> Command -> Bool
(Command -> Command -> Bool)
-> (Command -> Command -> Bool) -> Eq Command
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
/= :: Command -> Command -> Bool
Eq)

commandParser :: Parser Command
commandParser :: Parser Command
commandParser =
  Parser Command
subcommands
    Parser Command -> Parser Command -> Parser Command
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RunOptions -> Command
Run (RunOptions -> Command) -> Parser RunOptions -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RunOptions
runOptionsParser
 where
  subcommands :: Parser Command
subcommands =
    Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
hsubparser (Mod CommandFields Command -> Parser Command)
-> Mod CommandFields Command -> Parser Command
forall a b. (a -> b) -> a -> b
$
      Mod CommandFields Command
offlineCommand
        Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> Mod CommandFields Command
publishScriptsCommand
        Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> Mod CommandFields Command
genHydraKeyCommand

  offlineCommand :: Mod CommandFields Command
offlineCommand =
    [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command
      [Char]
"offline"
      ( Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info
          (RunOptions -> Command
Run (RunOptions -> Command) -> Parser RunOptions -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RunOptions
offlineModeParser)
          ([Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"Run the node in offline mode.")
      )

  publishScriptsCommand :: Mod CommandFields Command
publishScriptsCommand =
    [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command
      [Char]
"publish-scripts"
      ( Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info
          (PublishOptions -> Command
Publish (PublishOptions -> Command)
-> Parser PublishOptions -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PublishOptions
publishOptionsParser)
          ( InfoMod Command
forall a. InfoMod a
fullDesc
              InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<> Maybe (Doc AnsiStyle) -> InfoMod Command
forall a. Maybe (Doc AnsiStyle) -> InfoMod a
progDescDoc
                ( Doc AnsiStyle -> Maybe (Doc AnsiStyle)
forall a. a -> Maybe a
Just (Doc AnsiStyle -> Maybe (Doc AnsiStyle))
-> Doc AnsiStyle -> Maybe (Doc AnsiStyle)
forall a b. (a -> b) -> a -> b
$
                    [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vsep
                      [ Doc AnsiStyle
"Publish Hydra's Plutus scripts on chain to be used"
                      , Doc AnsiStyle
"by the hydra-node as --hydra-script-tx-id."
                      , Doc AnsiStyle
""
                      , Doc AnsiStyle
" ┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓ "
                      , Doc AnsiStyle
" ┃              ⚠ WARNING ⚠              ┃ "
                      , Doc AnsiStyle
" ┣═══════════════════════════════════════┫ "
                      , Doc AnsiStyle
" ┃    This costs money. About 50 Ada.    ┃ "
                      , Doc AnsiStyle
" ┃ Spent using the provided signing key. ┃ "
                      , Doc AnsiStyle
" ┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛ "
                      ]
                )
              InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
footer
                [Char]
"The command outputs the transaction id (in base16) \
                \of the publishing transaction. This transaction id \
                \can then be passed onto '--hydra-scripts-tx-id' to \
                \start a hydra-node using the referenced scripts."
          )
      )

  genHydraKeyCommand :: Mod CommandFields Command
genHydraKeyCommand =
    [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command
      [Char]
"gen-hydra-key"
      ( Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info
          (GenerateKeyPair -> Command
GenHydraKey (GenerateKeyPair -> Command)
-> ([Char] -> GenerateKeyPair) -> [Char] -> Command
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> GenerateKeyPair
GenerateKeyPair ([Char] -> Command) -> Parser [Char] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Char]
outputFileParser)
          ([Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"Generate a pair of Hydra signing/verification keys (off-chain keys).")
      )

data PublishOptions = PublishOptions
  { PublishOptions -> NetworkId
publishNetworkId :: NetworkId
  , PublishOptions -> SocketPath
publishNodeSocket :: SocketPath
  , PublishOptions -> [Char]
publishSigningKey :: FilePath
  }
  deriving stock (Int -> PublishOptions -> ShowS
[PublishOptions] -> ShowS
PublishOptions -> [Char]
(Int -> PublishOptions -> ShowS)
-> (PublishOptions -> [Char])
-> ([PublishOptions] -> ShowS)
-> Show PublishOptions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PublishOptions -> ShowS
showsPrec :: Int -> PublishOptions -> ShowS
$cshow :: PublishOptions -> [Char]
show :: PublishOptions -> [Char]
$cshowList :: [PublishOptions] -> ShowS
showList :: [PublishOptions] -> ShowS
Show, PublishOptions -> PublishOptions -> Bool
(PublishOptions -> PublishOptions -> Bool)
-> (PublishOptions -> PublishOptions -> Bool) -> Eq PublishOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PublishOptions -> PublishOptions -> Bool
== :: PublishOptions -> PublishOptions -> Bool
$c/= :: PublishOptions -> PublishOptions -> Bool
/= :: PublishOptions -> PublishOptions -> Bool
Eq)

publishOptionsParser :: Parser PublishOptions
publishOptionsParser :: Parser PublishOptions
publishOptionsParser =
  NetworkId -> SocketPath -> [Char] -> PublishOptions
PublishOptions
    (NetworkId -> SocketPath -> [Char] -> PublishOptions)
-> Parser NetworkId
-> Parser (SocketPath -> [Char] -> PublishOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser NetworkId
networkIdParser
    Parser (SocketPath -> [Char] -> PublishOptions)
-> Parser SocketPath -> Parser ([Char] -> PublishOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SocketPath
nodeSocketParser
    Parser ([Char] -> PublishOptions)
-> Parser [Char] -> Parser PublishOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Char]
cardanoSigningKeyFileParser

data RunOptions = RunOptions
  { RunOptions -> Verbosity
verbosity :: Verbosity
  , RunOptions -> NodeId
nodeId :: NodeId
  , -- NOTE: Why not a 'Host'?
    RunOptions -> IP
host :: IP
  , RunOptions -> PortNumber
port :: PortNumber
  , RunOptions -> [Host]
peers :: [Host]
  , RunOptions -> IP
apiHost :: IP
  , RunOptions -> PortNumber
apiPort :: PortNumber
  , RunOptions -> Maybe PortNumber
monitoringPort :: Maybe PortNumber
  , RunOptions -> [Char]
hydraSigningKey :: FilePath
  , RunOptions -> [[Char]]
hydraVerificationKeys :: [FilePath]
  , RunOptions -> [Char]
persistenceDir :: FilePath
  , RunOptions -> ChainConfig
chainConfig :: ChainConfig
  , RunOptions -> LedgerConfig
ledgerConfig :: LedgerConfig
  }
  deriving stock (RunOptions -> RunOptions -> Bool
(RunOptions -> RunOptions -> Bool)
-> (RunOptions -> RunOptions -> Bool) -> Eq RunOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunOptions -> RunOptions -> Bool
== :: RunOptions -> RunOptions -> Bool
$c/= :: RunOptions -> RunOptions -> Bool
/= :: RunOptions -> RunOptions -> Bool
Eq, Int -> RunOptions -> ShowS
[RunOptions] -> ShowS
RunOptions -> [Char]
(Int -> RunOptions -> ShowS)
-> (RunOptions -> [Char])
-> ([RunOptions] -> ShowS)
-> Show RunOptions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunOptions -> ShowS
showsPrec :: Int -> RunOptions -> ShowS
$cshow :: RunOptions -> [Char]
show :: RunOptions -> [Char]
$cshowList :: [RunOptions] -> ShowS
showList :: [RunOptions] -> ShowS
Show, (forall x. RunOptions -> Rep RunOptions x)
-> (forall x. Rep RunOptions x -> RunOptions) -> Generic RunOptions
forall x. Rep RunOptions x -> RunOptions
forall x. RunOptions -> Rep RunOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RunOptions -> Rep RunOptions x
from :: forall x. RunOptions -> Rep RunOptions x
$cto :: forall x. Rep RunOptions x -> RunOptions
to :: forall x. Rep RunOptions x -> RunOptions
Generic)
  deriving anyclass ([RunOptions] -> Value
[RunOptions] -> Encoding
RunOptions -> Bool
RunOptions -> Value
RunOptions -> Encoding
(RunOptions -> Value)
-> (RunOptions -> Encoding)
-> ([RunOptions] -> Value)
-> ([RunOptions] -> Encoding)
-> (RunOptions -> Bool)
-> ToJSON RunOptions
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: RunOptions -> Value
toJSON :: RunOptions -> Value
$ctoEncoding :: RunOptions -> Encoding
toEncoding :: RunOptions -> Encoding
$ctoJSONList :: [RunOptions] -> Value
toJSONList :: [RunOptions] -> Value
$ctoEncodingList :: [RunOptions] -> Encoding
toEncodingList :: [RunOptions] -> Encoding
$comitField :: RunOptions -> Bool
omitField :: RunOptions -> Bool
ToJSON, Maybe RunOptions
Value -> Parser [RunOptions]
Value -> Parser RunOptions
(Value -> Parser RunOptions)
-> (Value -> Parser [RunOptions])
-> Maybe RunOptions
-> FromJSON RunOptions
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser RunOptions
parseJSON :: Value -> Parser RunOptions
$cparseJSONList :: Value -> Parser [RunOptions]
parseJSONList :: Value -> Parser [RunOptions]
$comittedField :: Maybe RunOptions
omittedField :: Maybe RunOptions
FromJSON)

-- Orphan instance
instance Arbitrary IP where
  arbitrary :: Gen IP
arbitrary = IPv4 -> IP
IPv4 (IPv4 -> IP) -> (Word32 -> IPv4) -> Word32 -> IP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> IPv4
toIPv4w (Word32 -> IP) -> Gen Word32 -> Gen IP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: IP -> [IP]
shrink = IP -> [IP]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary RunOptions where
  arbitrary :: Gen RunOptions
arbitrary = do
    Verbosity
verbosity <- [Verbosity] -> Gen Verbosity
forall a. [a] -> Gen a
elements [Verbosity
Quiet, Text -> Verbosity
Verbose Text
"HydraNode"]
    NodeId
nodeId <- Gen NodeId
forall a. Arbitrary a => Gen a
arbitrary
    IP
host <- Gen IP
forall a. Arbitrary a => Gen a
arbitrary
    PortNumber
port <- Gen PortNumber
forall a. Arbitrary a => Gen a
arbitrary
    [Host]
peers <- Gen [Host] -> Gen [Host]
forall a. Gen a -> Gen a
reasonablySized Gen [Host]
forall a. Arbitrary a => Gen a
arbitrary
    IP
apiHost <- Gen IP
forall a. Arbitrary a => Gen a
arbitrary
    PortNumber
apiPort <- Gen PortNumber
forall a. Arbitrary a => Gen a
arbitrary
    Maybe PortNumber
monitoringPort <- Gen (Maybe PortNumber)
forall a. Arbitrary a => Gen a
arbitrary
    [Char]
hydraSigningKey <- [Char] -> Gen [Char]
genFilePath [Char]
"sk"
    [[Char]]
hydraVerificationKeys <- Gen [[Char]] -> Gen [[Char]]
forall a. Gen a -> Gen a
reasonablySized (Gen [Char] -> Gen [[Char]]
forall a. Gen a -> Gen [a]
listOf ([Char] -> Gen [Char]
genFilePath [Char]
"vk"))
    [Char]
persistenceDir <- Gen [Char]
genDirPath
    ChainConfig
chainConfig <- Gen ChainConfig
forall a. Arbitrary a => Gen a
arbitrary
    LedgerConfig
ledgerConfig <- Gen LedgerConfig
forall a. Arbitrary a => Gen a
arbitrary
    pure $
      RunOptions
        { Verbosity
$sel:verbosity:RunOptions :: Verbosity
verbosity :: Verbosity
verbosity
        , NodeId
$sel:nodeId:RunOptions :: NodeId
nodeId :: NodeId
nodeId
        , IP
$sel:host:RunOptions :: IP
host :: IP
host
        , PortNumber
$sel:port:RunOptions :: PortNumber
port :: PortNumber
port
        , [Host]
$sel:peers:RunOptions :: [Host]
peers :: [Host]
peers
        , IP
$sel:apiHost:RunOptions :: IP
apiHost :: IP
apiHost
        , PortNumber
$sel:apiPort:RunOptions :: PortNumber
apiPort :: PortNumber
apiPort
        , Maybe PortNumber
$sel:monitoringPort:RunOptions :: Maybe PortNumber
monitoringPort :: Maybe PortNumber
monitoringPort
        , [Char]
$sel:hydraSigningKey:RunOptions :: [Char]
hydraSigningKey :: [Char]
hydraSigningKey
        , [[Char]]
$sel:hydraVerificationKeys:RunOptions :: [[Char]]
hydraVerificationKeys :: [[Char]]
hydraVerificationKeys
        , [Char]
$sel:persistenceDir:RunOptions :: [Char]
persistenceDir :: [Char]
persistenceDir
        , ChainConfig
$sel:chainConfig:RunOptions :: ChainConfig
chainConfig :: ChainConfig
chainConfig
        , LedgerConfig
$sel:ledgerConfig:RunOptions :: LedgerConfig
ledgerConfig :: LedgerConfig
ledgerConfig
        }

  shrink :: RunOptions -> [RunOptions]
shrink = RunOptions -> [RunOptions]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

-- | Default options as they should also be provided by 'runOptionsParser'.
defaultRunOptions :: RunOptions
defaultRunOptions :: RunOptions
defaultRunOptions =
  RunOptions
    { $sel:verbosity:RunOptions :: Verbosity
verbosity = Text -> Verbosity
Verbose Text
"HydraNode"
    , $sel:nodeId:RunOptions :: NodeId
nodeId = Text -> NodeId
NodeId Text
"hydra-node-1"
    , $sel:host:RunOptions :: IP
host = IP
localhost
    , $sel:port:RunOptions :: PortNumber
port = PortNumber
5001
    , $sel:peers:RunOptions :: [Host]
peers = []
    , $sel:apiHost:RunOptions :: IP
apiHost = IP
localhost
    , $sel:apiPort:RunOptions :: PortNumber
apiPort = PortNumber
4001
    , $sel:monitoringPort:RunOptions :: Maybe PortNumber
monitoringPort = Maybe PortNumber
forall a. Maybe a
Nothing
    , $sel:hydraSigningKey:RunOptions :: [Char]
hydraSigningKey = [Char]
"hydra.sk"
    , $sel:hydraVerificationKeys:RunOptions :: [[Char]]
hydraVerificationKeys = []
    , $sel:persistenceDir:RunOptions :: [Char]
persistenceDir = [Char]
"./"
    , $sel:chainConfig:RunOptions :: ChainConfig
chainConfig = DirectChainConfig -> ChainConfig
Direct DirectChainConfig
defaultDirectChainConfig
    , $sel:ledgerConfig:RunOptions :: LedgerConfig
ledgerConfig = LedgerConfig
defaultLedgerConfig
    }
 where
  localhost :: IP
localhost = IPv4 -> IP
IPv4 (IPv4 -> IP) -> IPv4 -> IP
forall a b. (a -> b) -> a -> b
$ [Int] -> IPv4
toIPv4 [Int
127, Int
0, Int
0, Int
1]

-- | Parser for running the cardano-node with all its 'RunOptions'.
runOptionsParser :: Parser RunOptions
runOptionsParser :: Parser RunOptions
runOptionsParser =
  Verbosity
-> NodeId
-> IP
-> PortNumber
-> [Host]
-> IP
-> PortNumber
-> Maybe PortNumber
-> [Char]
-> [[Char]]
-> [Char]
-> ChainConfig
-> LedgerConfig
-> RunOptions
RunOptions
    (Verbosity
 -> NodeId
 -> IP
 -> PortNumber
 -> [Host]
 -> IP
 -> PortNumber
 -> Maybe PortNumber
 -> [Char]
 -> [[Char]]
 -> [Char]
 -> ChainConfig
 -> LedgerConfig
 -> RunOptions)
-> Parser Verbosity
-> Parser
     (NodeId
      -> IP
      -> PortNumber
      -> [Host]
      -> IP
      -> PortNumber
      -> Maybe PortNumber
      -> [Char]
      -> [[Char]]
      -> [Char]
      -> ChainConfig
      -> LedgerConfig
      -> RunOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Verbosity
verbosityParser
    Parser
  (NodeId
   -> IP
   -> PortNumber
   -> [Host]
   -> IP
   -> PortNumber
   -> Maybe PortNumber
   -> [Char]
   -> [[Char]]
   -> [Char]
   -> ChainConfig
   -> LedgerConfig
   -> RunOptions)
-> Parser NodeId
-> Parser
     (IP
      -> PortNumber
      -> [Host]
      -> IP
      -> PortNumber
      -> Maybe PortNumber
      -> [Char]
      -> [[Char]]
      -> [Char]
      -> ChainConfig
      -> LedgerConfig
      -> RunOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NodeId
nodeIdParser
    Parser
  (IP
   -> PortNumber
   -> [Host]
   -> IP
   -> PortNumber
   -> Maybe PortNumber
   -> [Char]
   -> [[Char]]
   -> [Char]
   -> ChainConfig
   -> LedgerConfig
   -> RunOptions)
-> Parser IP
-> Parser
     (PortNumber
      -> [Host]
      -> IP
      -> PortNumber
      -> Maybe PortNumber
      -> [Char]
      -> [[Char]]
      -> [Char]
      -> ChainConfig
      -> LedgerConfig
      -> RunOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser IP
hostParser
    Parser
  (PortNumber
   -> [Host]
   -> IP
   -> PortNumber
   -> Maybe PortNumber
   -> [Char]
   -> [[Char]]
   -> [Char]
   -> ChainConfig
   -> LedgerConfig
   -> RunOptions)
-> Parser PortNumber
-> Parser
     ([Host]
      -> IP
      -> PortNumber
      -> Maybe PortNumber
      -> [Char]
      -> [[Char]]
      -> [Char]
      -> ChainConfig
      -> LedgerConfig
      -> RunOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PortNumber
portParser
    Parser
  ([Host]
   -> IP
   -> PortNumber
   -> Maybe PortNumber
   -> [Char]
   -> [[Char]]
   -> [Char]
   -> ChainConfig
   -> LedgerConfig
   -> RunOptions)
-> Parser [Host]
-> Parser
     (IP
      -> PortNumber
      -> Maybe PortNumber
      -> [Char]
      -> [[Char]]
      -> [Char]
      -> ChainConfig
      -> LedgerConfig
      -> RunOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Host -> Parser [Host]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Host
peerParser
    Parser
  (IP
   -> PortNumber
   -> Maybe PortNumber
   -> [Char]
   -> [[Char]]
   -> [Char]
   -> ChainConfig
   -> LedgerConfig
   -> RunOptions)
-> Parser IP
-> Parser
     (PortNumber
      -> Maybe PortNumber
      -> [Char]
      -> [[Char]]
      -> [Char]
      -> ChainConfig
      -> LedgerConfig
      -> RunOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser IP
apiHostParser
    Parser
  (PortNumber
   -> Maybe PortNumber
   -> [Char]
   -> [[Char]]
   -> [Char]
   -> ChainConfig
   -> LedgerConfig
   -> RunOptions)
-> Parser PortNumber
-> Parser
     (Maybe PortNumber
      -> [Char]
      -> [[Char]]
      -> [Char]
      -> ChainConfig
      -> LedgerConfig
      -> RunOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PortNumber
apiPortParser
    Parser
  (Maybe PortNumber
   -> [Char]
   -> [[Char]]
   -> [Char]
   -> ChainConfig
   -> LedgerConfig
   -> RunOptions)
-> Parser (Maybe PortNumber)
-> Parser
     ([Char]
      -> [[Char]] -> [Char] -> ChainConfig -> LedgerConfig -> RunOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PortNumber -> Parser (Maybe PortNumber)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser PortNumber
monitoringPortParser
    Parser
  ([Char]
   -> [[Char]] -> [Char] -> ChainConfig -> LedgerConfig -> RunOptions)
-> Parser [Char]
-> Parser
     ([[Char]] -> [Char] -> ChainConfig -> LedgerConfig -> RunOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Char]
hydraSigningKeyFileParser
    Parser
  ([[Char]] -> [Char] -> ChainConfig -> LedgerConfig -> RunOptions)
-> Parser [[Char]]
-> Parser ([Char] -> ChainConfig -> LedgerConfig -> RunOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Char] -> Parser [[Char]]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser [Char]
hydraVerificationKeyFileParser
    Parser ([Char] -> ChainConfig -> LedgerConfig -> RunOptions)
-> Parser [Char]
-> Parser (ChainConfig -> LedgerConfig -> RunOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Char]
persistenceDirParser
    Parser (ChainConfig -> LedgerConfig -> RunOptions)
-> Parser ChainConfig -> Parser (LedgerConfig -> RunOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( DirectChainConfig -> ChainConfig
Direct (DirectChainConfig -> ChainConfig)
-> Parser DirectChainConfig -> Parser ChainConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DirectChainConfig
directChainConfigParser
            Parser ChainConfig -> Parser ChainConfig -> Parser ChainConfig
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OfflineChainConfig -> ChainConfig
Offline (OfflineChainConfig -> ChainConfig)
-> Parser OfflineChainConfig -> Parser ChainConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser OfflineChainConfig
offlineChainConfigParser
        )
    Parser (LedgerConfig -> RunOptions)
-> Parser LedgerConfig -> Parser RunOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser LedgerConfig
ledgerConfigParser

-- | Alternative parser to 'runOptionsParser' for running the cardano-node in
-- offline mode.
offlineModeParser :: Parser RunOptions
offlineModeParser :: Parser RunOptions
offlineModeParser = do
  -- NOTE: We must parse the offline options first as the 'runOptionsParser'
  -- would also "consume" those options
  ChainConfig
chainConfig <- OfflineChainConfig -> ChainConfig
Offline (OfflineChainConfig -> ChainConfig)
-> Parser OfflineChainConfig -> Parser ChainConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser OfflineChainConfig
offlineChainConfigParser
  -- NOTE: We can re-use the runOptionsParser only as it never fails
  -- because it has defaults for all options.
  RunOptions
options <- Parser RunOptions
runOptionsParser
  pure RunOptions
options{chainConfig}

newtype GenerateKeyPair = GenerateKeyPair
  { GenerateKeyPair -> [Char]
outputFile :: FilePath
  }
  deriving stock (GenerateKeyPair -> GenerateKeyPair -> Bool
(GenerateKeyPair -> GenerateKeyPair -> Bool)
-> (GenerateKeyPair -> GenerateKeyPair -> Bool)
-> Eq GenerateKeyPair
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenerateKeyPair -> GenerateKeyPair -> Bool
== :: GenerateKeyPair -> GenerateKeyPair -> Bool
$c/= :: GenerateKeyPair -> GenerateKeyPair -> Bool
/= :: GenerateKeyPair -> GenerateKeyPair -> Bool
Eq, Int -> GenerateKeyPair -> ShowS
[GenerateKeyPair] -> ShowS
GenerateKeyPair -> [Char]
(Int -> GenerateKeyPair -> ShowS)
-> (GenerateKeyPair -> [Char])
-> ([GenerateKeyPair] -> ShowS)
-> Show GenerateKeyPair
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenerateKeyPair -> ShowS
showsPrec :: Int -> GenerateKeyPair -> ShowS
$cshow :: GenerateKeyPair -> [Char]
show :: GenerateKeyPair -> [Char]
$cshowList :: [GenerateKeyPair] -> ShowS
showList :: [GenerateKeyPair] -> ShowS
Show)

outputFileParser :: Parser FilePath
outputFileParser :: Parser [Char]
outputFileParser =
  Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"output-file"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"FILE"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value [Char]
"hydra-key"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Basename of files to generate key-pair into. Signing key will be suffixed '.sk' and verification key '.vk'"
    )

newtype LedgerConfig = CardanoLedgerConfig
  { LedgerConfig -> [Char]
cardanoLedgerProtocolParametersFile :: FilePath
  }
  deriving stock (LedgerConfig -> LedgerConfig -> Bool
(LedgerConfig -> LedgerConfig -> Bool)
-> (LedgerConfig -> LedgerConfig -> Bool) -> Eq LedgerConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LedgerConfig -> LedgerConfig -> Bool
== :: LedgerConfig -> LedgerConfig -> Bool
$c/= :: LedgerConfig -> LedgerConfig -> Bool
/= :: LedgerConfig -> LedgerConfig -> Bool
Eq, Int -> LedgerConfig -> ShowS
[LedgerConfig] -> ShowS
LedgerConfig -> [Char]
(Int -> LedgerConfig -> ShowS)
-> (LedgerConfig -> [Char])
-> ([LedgerConfig] -> ShowS)
-> Show LedgerConfig
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LedgerConfig -> ShowS
showsPrec :: Int -> LedgerConfig -> ShowS
$cshow :: LedgerConfig -> [Char]
show :: LedgerConfig -> [Char]
$cshowList :: [LedgerConfig] -> ShowS
showList :: [LedgerConfig] -> ShowS
Show, (forall x. LedgerConfig -> Rep LedgerConfig x)
-> (forall x. Rep LedgerConfig x -> LedgerConfig)
-> Generic LedgerConfig
forall x. Rep LedgerConfig x -> LedgerConfig
forall x. LedgerConfig -> Rep LedgerConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LedgerConfig -> Rep LedgerConfig x
from :: forall x. LedgerConfig -> Rep LedgerConfig x
$cto :: forall x. Rep LedgerConfig x -> LedgerConfig
to :: forall x. Rep LedgerConfig x -> LedgerConfig
Generic)
  deriving anyclass ([LedgerConfig] -> Value
[LedgerConfig] -> Encoding
LedgerConfig -> Bool
LedgerConfig -> Value
LedgerConfig -> Encoding
(LedgerConfig -> Value)
-> (LedgerConfig -> Encoding)
-> ([LedgerConfig] -> Value)
-> ([LedgerConfig] -> Encoding)
-> (LedgerConfig -> Bool)
-> ToJSON LedgerConfig
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: LedgerConfig -> Value
toJSON :: LedgerConfig -> Value
$ctoEncoding :: LedgerConfig -> Encoding
toEncoding :: LedgerConfig -> Encoding
$ctoJSONList :: [LedgerConfig] -> Value
toJSONList :: [LedgerConfig] -> Value
$ctoEncodingList :: [LedgerConfig] -> Encoding
toEncodingList :: [LedgerConfig] -> Encoding
$comitField :: LedgerConfig -> Bool
omitField :: LedgerConfig -> Bool
ToJSON, Maybe LedgerConfig
Value -> Parser [LedgerConfig]
Value -> Parser LedgerConfig
(Value -> Parser LedgerConfig)
-> (Value -> Parser [LedgerConfig])
-> Maybe LedgerConfig
-> FromJSON LedgerConfig
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser LedgerConfig
parseJSON :: Value -> Parser LedgerConfig
$cparseJSONList :: Value -> Parser [LedgerConfig]
parseJSONList :: Value -> Parser [LedgerConfig]
$comittedField :: Maybe LedgerConfig
omittedField :: Maybe LedgerConfig
FromJSON)

defaultLedgerConfig :: LedgerConfig
defaultLedgerConfig :: LedgerConfig
defaultLedgerConfig =
  CardanoLedgerConfig
    { $sel:cardanoLedgerProtocolParametersFile:CardanoLedgerConfig :: [Char]
cardanoLedgerProtocolParametersFile = [Char]
"protocol-parameters.json"
    }

instance Arbitrary LedgerConfig where
  arbitrary :: Gen LedgerConfig
arbitrary = do
    [Char]
cardanoLedgerProtocolParametersFile <- [Char] -> Gen [Char]
genFilePath [Char]
"json"
    pure $ CardanoLedgerConfig{[Char]
$sel:cardanoLedgerProtocolParametersFile:CardanoLedgerConfig :: [Char]
cardanoLedgerProtocolParametersFile :: [Char]
cardanoLedgerProtocolParametersFile}

ledgerConfigParser :: Parser LedgerConfig
ledgerConfigParser :: Parser LedgerConfig
ledgerConfigParser =
  [Char] -> LedgerConfig
CardanoLedgerConfig
    ([Char] -> LedgerConfig) -> Parser [Char] -> Parser LedgerConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Char]
cardanoLedgerProtocolParametersParser

cardanoLedgerProtocolParametersParser :: Parser FilePath
cardanoLedgerProtocolParametersParser :: Parser [Char]
cardanoLedgerProtocolParametersParser =
  Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"ledger-protocol-parameters"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"FILE"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value [Char]
"protocol-parameters.json"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields [Char]
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help
          [Char]
"Path to protocol parameters used in the Hydra Head. \
          \See manual how to configure this."
    )

data ChainConfig
  = Offline OfflineChainConfig
  | Direct DirectChainConfig
  deriving stock (ChainConfig -> ChainConfig -> Bool
(ChainConfig -> ChainConfig -> Bool)
-> (ChainConfig -> ChainConfig -> Bool) -> Eq ChainConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChainConfig -> ChainConfig -> Bool
== :: ChainConfig -> ChainConfig -> Bool
$c/= :: ChainConfig -> ChainConfig -> Bool
/= :: ChainConfig -> ChainConfig -> Bool
Eq, Int -> ChainConfig -> ShowS
[ChainConfig] -> ShowS
ChainConfig -> [Char]
(Int -> ChainConfig -> ShowS)
-> (ChainConfig -> [Char])
-> ([ChainConfig] -> ShowS)
-> Show ChainConfig
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChainConfig -> ShowS
showsPrec :: Int -> ChainConfig -> ShowS
$cshow :: ChainConfig -> [Char]
show :: ChainConfig -> [Char]
$cshowList :: [ChainConfig] -> ShowS
showList :: [ChainConfig] -> ShowS
Show, (forall x. ChainConfig -> Rep ChainConfig x)
-> (forall x. Rep ChainConfig x -> ChainConfig)
-> Generic ChainConfig
forall x. Rep ChainConfig x -> ChainConfig
forall x. ChainConfig -> Rep ChainConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChainConfig -> Rep ChainConfig x
from :: forall x. ChainConfig -> Rep ChainConfig x
$cto :: forall x. Rep ChainConfig x -> ChainConfig
to :: forall x. Rep ChainConfig x -> ChainConfig
Generic)

instance ToJSON ChainConfig where
  toJSON :: ChainConfig -> Value
toJSON = \case
    Offline OfflineChainConfig
cfg -> OfflineChainConfig -> Value
forall a. ToJSON a => a -> Value
toJSON OfflineChainConfig
cfg Value -> (Value -> Value) -> Value
forall a b. a -> (a -> b) -> b
& Key -> Traversal' Value (Maybe Value)
forall t. AsValue t => Key -> Traversal' t (Maybe Value)
atKey Key
"tag" ((Maybe Value -> Identity (Maybe Value))
 -> Value -> Identity Value)
-> Value -> Value -> Value
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
String Text
"OfflineChainConfig"
    Direct DirectChainConfig
cfg -> DirectChainConfig -> Value
forall a. ToJSON a => a -> Value
toJSON DirectChainConfig
cfg Value -> (Value -> Value) -> Value
forall a b. a -> (a -> b) -> b
& Key -> Traversal' Value (Maybe Value)
forall t. AsValue t => Key -> Traversal' t (Maybe Value)
atKey Key
"tag" ((Maybe Value -> Identity (Maybe Value))
 -> Value -> Identity Value)
-> Value -> Value -> Value
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
String Text
"DirectChainConfig"

instance FromJSON ChainConfig where
  parseJSON :: Value -> Parser ChainConfig
parseJSON =
    [Char]
-> (Object -> Parser ChainConfig) -> Value -> Parser ChainConfig
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"ChainConfig" ((Object -> Parser ChainConfig) -> Value -> Parser ChainConfig)
-> (Object -> Parser ChainConfig) -> Value -> Parser ChainConfig
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      Object
o Object -> Key -> Parser [Char]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tag" Parser [Char]
-> ([Char] -> Parser ChainConfig) -> Parser ChainConfig
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        [Char]
"OfflineChainConfig" -> OfflineChainConfig -> ChainConfig
Offline (OfflineChainConfig -> ChainConfig)
-> Parser OfflineChainConfig -> Parser ChainConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser OfflineChainConfig
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
        [Char]
"DirectChainConfig" -> DirectChainConfig -> ChainConfig
Direct (DirectChainConfig -> ChainConfig)
-> Parser DirectChainConfig -> Parser ChainConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser DirectChainConfig
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
        [Char]
tag -> [Char] -> Parser ChainConfig
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser ChainConfig) -> [Char] -> Parser ChainConfig
forall a b. (a -> b) -> a -> b
$ [Char]
"unexpected tag " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
tag

data OfflineChainConfig = OfflineChainConfig
  { OfflineChainConfig -> [Char]
initialUTxOFile :: FilePath
  -- ^ Path to a json encoded starting 'UTxO' for the offline-mode head.
  , OfflineChainConfig -> Maybe [Char]
ledgerGenesisFile :: Maybe FilePath
  -- ^ Path to a shelley genesis file with slot lengths used by the offline-mode chain.
  }
  deriving stock (OfflineChainConfig -> OfflineChainConfig -> Bool
(OfflineChainConfig -> OfflineChainConfig -> Bool)
-> (OfflineChainConfig -> OfflineChainConfig -> Bool)
-> Eq OfflineChainConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OfflineChainConfig -> OfflineChainConfig -> Bool
== :: OfflineChainConfig -> OfflineChainConfig -> Bool
$c/= :: OfflineChainConfig -> OfflineChainConfig -> Bool
/= :: OfflineChainConfig -> OfflineChainConfig -> Bool
Eq, Int -> OfflineChainConfig -> ShowS
[OfflineChainConfig] -> ShowS
OfflineChainConfig -> [Char]
(Int -> OfflineChainConfig -> ShowS)
-> (OfflineChainConfig -> [Char])
-> ([OfflineChainConfig] -> ShowS)
-> Show OfflineChainConfig
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OfflineChainConfig -> ShowS
showsPrec :: Int -> OfflineChainConfig -> ShowS
$cshow :: OfflineChainConfig -> [Char]
show :: OfflineChainConfig -> [Char]
$cshowList :: [OfflineChainConfig] -> ShowS
showList :: [OfflineChainConfig] -> ShowS
Show, (forall x. OfflineChainConfig -> Rep OfflineChainConfig x)
-> (forall x. Rep OfflineChainConfig x -> OfflineChainConfig)
-> Generic OfflineChainConfig
forall x. Rep OfflineChainConfig x -> OfflineChainConfig
forall x. OfflineChainConfig -> Rep OfflineChainConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OfflineChainConfig -> Rep OfflineChainConfig x
from :: forall x. OfflineChainConfig -> Rep OfflineChainConfig x
$cto :: forall x. Rep OfflineChainConfig x -> OfflineChainConfig
to :: forall x. Rep OfflineChainConfig x -> OfflineChainConfig
Generic)
  deriving anyclass ([OfflineChainConfig] -> Value
[OfflineChainConfig] -> Encoding
OfflineChainConfig -> Bool
OfflineChainConfig -> Value
OfflineChainConfig -> Encoding
(OfflineChainConfig -> Value)
-> (OfflineChainConfig -> Encoding)
-> ([OfflineChainConfig] -> Value)
-> ([OfflineChainConfig] -> Encoding)
-> (OfflineChainConfig -> Bool)
-> ToJSON OfflineChainConfig
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: OfflineChainConfig -> Value
toJSON :: OfflineChainConfig -> Value
$ctoEncoding :: OfflineChainConfig -> Encoding
toEncoding :: OfflineChainConfig -> Encoding
$ctoJSONList :: [OfflineChainConfig] -> Value
toJSONList :: [OfflineChainConfig] -> Value
$ctoEncodingList :: [OfflineChainConfig] -> Encoding
toEncodingList :: [OfflineChainConfig] -> Encoding
$comitField :: OfflineChainConfig -> Bool
omitField :: OfflineChainConfig -> Bool
ToJSON, Maybe OfflineChainConfig
Value -> Parser [OfflineChainConfig]
Value -> Parser OfflineChainConfig
(Value -> Parser OfflineChainConfig)
-> (Value -> Parser [OfflineChainConfig])
-> Maybe OfflineChainConfig
-> FromJSON OfflineChainConfig
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser OfflineChainConfig
parseJSON :: Value -> Parser OfflineChainConfig
$cparseJSONList :: Value -> Parser [OfflineChainConfig]
parseJSONList :: Value -> Parser [OfflineChainConfig]
$comittedField :: Maybe OfflineChainConfig
omittedField :: Maybe OfflineChainConfig
FromJSON)

defaultOfflineChainConfig :: OfflineChainConfig
defaultOfflineChainConfig :: OfflineChainConfig
defaultOfflineChainConfig =
  OfflineChainConfig
    { $sel:initialUTxOFile:OfflineChainConfig :: [Char]
initialUTxOFile = [Char]
"utxo.json"
    , $sel:ledgerGenesisFile:OfflineChainConfig :: Maybe [Char]
ledgerGenesisFile = Maybe [Char]
forall a. Maybe a
Nothing
    }

data DirectChainConfig = DirectChainConfig
  { DirectChainConfig -> NetworkId
networkId :: NetworkId
  -- ^ Network identifer to which we expect to connect.
  , DirectChainConfig -> SocketPath
nodeSocket :: SocketPath
  -- ^ Path to a domain socket used to connect to the server.
  , DirectChainConfig -> TxId
hydraScriptsTxId :: TxId
  -- ^ Identifier of transaction holding the hydra scripts to use.
  , DirectChainConfig -> [Char]
cardanoSigningKey :: FilePath
  -- ^ Path to the cardano signing key of the internal wallet.
  , DirectChainConfig -> [[Char]]
cardanoVerificationKeys :: [FilePath]
  -- ^ Paths to other node's verification keys.
  , DirectChainConfig -> Maybe ChainPoint
startChainFrom :: Maybe ChainPoint
  -- ^ Point at which to start following the chain.
  , DirectChainConfig -> ContestationPeriod
contestationPeriod :: ContestationPeriod
  }
  deriving stock (DirectChainConfig -> DirectChainConfig -> Bool
(DirectChainConfig -> DirectChainConfig -> Bool)
-> (DirectChainConfig -> DirectChainConfig -> Bool)
-> Eq DirectChainConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DirectChainConfig -> DirectChainConfig -> Bool
== :: DirectChainConfig -> DirectChainConfig -> Bool
$c/= :: DirectChainConfig -> DirectChainConfig -> Bool
/= :: DirectChainConfig -> DirectChainConfig -> Bool
Eq, Int -> DirectChainConfig -> ShowS
[DirectChainConfig] -> ShowS
DirectChainConfig -> [Char]
(Int -> DirectChainConfig -> ShowS)
-> (DirectChainConfig -> [Char])
-> ([DirectChainConfig] -> ShowS)
-> Show DirectChainConfig
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DirectChainConfig -> ShowS
showsPrec :: Int -> DirectChainConfig -> ShowS
$cshow :: DirectChainConfig -> [Char]
show :: DirectChainConfig -> [Char]
$cshowList :: [DirectChainConfig] -> ShowS
showList :: [DirectChainConfig] -> ShowS
Show, (forall x. DirectChainConfig -> Rep DirectChainConfig x)
-> (forall x. Rep DirectChainConfig x -> DirectChainConfig)
-> Generic DirectChainConfig
forall x. Rep DirectChainConfig x -> DirectChainConfig
forall x. DirectChainConfig -> Rep DirectChainConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DirectChainConfig -> Rep DirectChainConfig x
from :: forall x. DirectChainConfig -> Rep DirectChainConfig x
$cto :: forall x. Rep DirectChainConfig x -> DirectChainConfig
to :: forall x. Rep DirectChainConfig x -> DirectChainConfig
Generic)
  deriving anyclass ([DirectChainConfig] -> Value
[DirectChainConfig] -> Encoding
DirectChainConfig -> Bool
DirectChainConfig -> Value
DirectChainConfig -> Encoding
(DirectChainConfig -> Value)
-> (DirectChainConfig -> Encoding)
-> ([DirectChainConfig] -> Value)
-> ([DirectChainConfig] -> Encoding)
-> (DirectChainConfig -> Bool)
-> ToJSON DirectChainConfig
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: DirectChainConfig -> Value
toJSON :: DirectChainConfig -> Value
$ctoEncoding :: DirectChainConfig -> Encoding
toEncoding :: DirectChainConfig -> Encoding
$ctoJSONList :: [DirectChainConfig] -> Value
toJSONList :: [DirectChainConfig] -> Value
$ctoEncodingList :: [DirectChainConfig] -> Encoding
toEncodingList :: [DirectChainConfig] -> Encoding
$comitField :: DirectChainConfig -> Bool
omitField :: DirectChainConfig -> Bool
ToJSON, Maybe DirectChainConfig
Value -> Parser [DirectChainConfig]
Value -> Parser DirectChainConfig
(Value -> Parser DirectChainConfig)
-> (Value -> Parser [DirectChainConfig])
-> Maybe DirectChainConfig
-> FromJSON DirectChainConfig
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser DirectChainConfig
parseJSON :: Value -> Parser DirectChainConfig
$cparseJSONList :: Value -> Parser [DirectChainConfig]
parseJSONList :: Value -> Parser [DirectChainConfig]
$comittedField :: Maybe DirectChainConfig
omittedField :: Maybe DirectChainConfig
FromJSON)

defaultDirectChainConfig :: DirectChainConfig
defaultDirectChainConfig :: DirectChainConfig
defaultDirectChainConfig =
  DirectChainConfig
    { $sel:networkId:DirectChainConfig :: NetworkId
networkId = NetworkMagic -> NetworkId
Testnet (Word32 -> NetworkMagic
NetworkMagic Word32
42)
    , $sel:nodeSocket:DirectChainConfig :: SocketPath
nodeSocket = SocketPath
"node.socket"
    , $sel:hydraScriptsTxId:DirectChainConfig :: TxId
hydraScriptsTxId = Hash StandardCrypto EraIndependentTxBody -> TxId
TxId Hash StandardCrypto EraIndependentTxBody
Hash Blake2b_256 EraIndependentTxBody
"0101010101010101010101010101010101010101010101010101010101010101"
    , $sel:cardanoSigningKey:DirectChainConfig :: [Char]
cardanoSigningKey = [Char]
"cardano.sk"
    , $sel:cardanoVerificationKeys:DirectChainConfig :: [[Char]]
cardanoVerificationKeys = []
    , $sel:startChainFrom:DirectChainConfig :: Maybe ChainPoint
startChainFrom = Maybe ChainPoint
forall a. Maybe a
Nothing
    , $sel:contestationPeriod:DirectChainConfig :: ContestationPeriod
contestationPeriod = ContestationPeriod
defaultContestationPeriod
    }

instance Arbitrary ChainConfig where
  arbitrary :: Gen ChainConfig
arbitrary =
    [Gen ChainConfig] -> Gen ChainConfig
forall a. [Gen a] -> Gen a
oneof
      [ DirectChainConfig -> ChainConfig
Direct (DirectChainConfig -> ChainConfig)
-> Gen DirectChainConfig -> Gen ChainConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen DirectChainConfig
genDirectChainConfig
      , OfflineChainConfig -> ChainConfig
Offline (OfflineChainConfig -> ChainConfig)
-> Gen OfflineChainConfig -> Gen ChainConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen OfflineChainConfig
genOfflineChainConfig
      ]
   where
    genDirectChainConfig :: Gen DirectChainConfig
genDirectChainConfig = do
      NetworkId
networkId <- NetworkMagic -> NetworkId
Testnet (NetworkMagic -> NetworkId)
-> (Word32 -> NetworkMagic) -> Word32 -> NetworkId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> NetworkMagic
NetworkMagic (Word32 -> NetworkId) -> Gen Word32 -> Gen NetworkId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary
      SocketPath
nodeSocket <- [Char] -> SocketPath
forall content (direction :: FileDirection).
[Char] -> File content direction
File ([Char] -> SocketPath) -> Gen [Char] -> Gen SocketPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Gen [Char]
genFilePath [Char]
"socket"
      TxId
hydraScriptsTxId <- Gen TxId
forall a. Arbitrary a => Gen a
arbitrary
      [Char]
cardanoSigningKey <- [Char] -> Gen [Char]
genFilePath [Char]
"sk"
      [[Char]]
cardanoVerificationKeys <- Gen [[Char]] -> Gen [[Char]]
forall a. Gen a -> Gen a
reasonablySized (Gen [Char] -> Gen [[Char]]
forall a. Gen a -> Gen [a]
listOf ([Char] -> Gen [Char]
genFilePath [Char]
"vk"))
      Maybe ChainPoint
startChainFrom <- [Gen (Maybe ChainPoint)] -> Gen (Maybe ChainPoint)
forall a. [Gen a] -> Gen a
oneof [Maybe ChainPoint -> Gen (Maybe ChainPoint)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ChainPoint
forall a. Maybe a
Nothing, ChainPoint -> Maybe ChainPoint
forall a. a -> Maybe a
Just (ChainPoint -> Maybe ChainPoint)
-> Gen ChainPoint -> Gen (Maybe ChainPoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ChainPoint
genChainPoint]
      ContestationPeriod
contestationPeriod <- Gen ContestationPeriod
forall a. Arbitrary a => Gen a
arbitrary Gen ContestationPeriod
-> (ContestationPeriod -> Bool) -> Gen ContestationPeriod
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (ContestationPeriod -> ContestationPeriod -> Bool
forall a. Ord a => a -> a -> Bool
> Natural -> ContestationPeriod
UnsafeContestationPeriod Natural
0)
      pure
        DirectChainConfig
          { NetworkId
$sel:networkId:DirectChainConfig :: NetworkId
networkId :: NetworkId
networkId
          , SocketPath
$sel:nodeSocket:DirectChainConfig :: SocketPath
nodeSocket :: SocketPath
nodeSocket
          , TxId
$sel:hydraScriptsTxId:DirectChainConfig :: TxId
hydraScriptsTxId :: TxId
hydraScriptsTxId
          , [Char]
$sel:cardanoSigningKey:DirectChainConfig :: [Char]
cardanoSigningKey :: [Char]
cardanoSigningKey
          , [[Char]]
$sel:cardanoVerificationKeys:DirectChainConfig :: [[Char]]
cardanoVerificationKeys :: [[Char]]
cardanoVerificationKeys
          , Maybe ChainPoint
$sel:startChainFrom:DirectChainConfig :: Maybe ChainPoint
startChainFrom :: Maybe ChainPoint
startChainFrom
          , ContestationPeriod
$sel:contestationPeriod:DirectChainConfig :: ContestationPeriod
contestationPeriod :: ContestationPeriod
contestationPeriod
          }

    genOfflineChainConfig :: Gen OfflineChainConfig
genOfflineChainConfig = do
      Maybe [Char]
ledgerGenesisFile <- [Gen (Maybe [Char])] -> Gen (Maybe [Char])
forall a. [Gen a] -> Gen a
oneof [Maybe [Char] -> Gen (Maybe [Char])
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Char]
forall a. Maybe a
Nothing, [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> Gen [Char] -> Gen (Maybe [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Gen [Char]
genFilePath [Char]
"json"]
      [Char]
initialUTxOFile <- [Char] -> Gen [Char]
genFilePath [Char]
"json"
      pure
        OfflineChainConfig
          { [Char]
$sel:initialUTxOFile:OfflineChainConfig :: [Char]
initialUTxOFile :: [Char]
initialUTxOFile
          , Maybe [Char]
$sel:ledgerGenesisFile:OfflineChainConfig :: Maybe [Char]
ledgerGenesisFile :: Maybe [Char]
ledgerGenesisFile
          }

offlineChainConfigParser :: Parser OfflineChainConfig
offlineChainConfigParser :: Parser OfflineChainConfig
offlineChainConfigParser =
  [Char] -> Maybe [Char] -> OfflineChainConfig
OfflineChainConfig
    ([Char] -> Maybe [Char] -> OfflineChainConfig)
-> Parser [Char] -> Parser (Maybe [Char] -> OfflineChainConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Char]
initialUTxOFileParser
    Parser (Maybe [Char] -> OfflineChainConfig)
-> Parser (Maybe [Char]) -> Parser OfflineChainConfig
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 [Char])
ledgerGenesisFileParser

initialUTxOFileParser :: Parser FilePath
initialUTxOFileParser :: Parser [Char]
initialUTxOFileParser =
  ReadM [Char] -> Mod OptionFields [Char] -> Parser [Char]
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ReadM [Char]
forall s. IsString s => ReadM s
str
    ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"initial-utxo"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"FILE"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value [Char]
"utxo.json"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields [Char]
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"File containing initial UTxO for the L2 chain in offline mode."
    )

ledgerGenesisFileParser :: Parser (Maybe FilePath)
ledgerGenesisFileParser :: Parser (Maybe [Char])
ledgerGenesisFileParser =
  ReadM (Maybe [Char])
-> Mod OptionFields (Maybe [Char]) -> Parser (Maybe [Char])
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    (ReadM [Char] -> ReadM (Maybe [Char])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ReadM [Char]
forall s. IsString s => ReadM s
str)
    ( [Char] -> Mod OptionFields (Maybe [Char])
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"ledger-genesis"
        Mod OptionFields (Maybe [Char])
-> Mod OptionFields (Maybe [Char])
-> Mod OptionFields (Maybe [Char])
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields (Maybe [Char])
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"FILE"
        Mod OptionFields (Maybe [Char])
-> Mod OptionFields (Maybe [Char])
-> Mod OptionFields (Maybe [Char])
forall a. Semigroup a => a -> a -> a
<> Maybe [Char] -> Mod OptionFields (Maybe [Char])
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Maybe [Char]
forall a. Maybe a
Nothing
        Mod OptionFields (Maybe [Char])
-> Mod OptionFields (Maybe [Char])
-> Mod OptionFields (Maybe [Char])
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields (Maybe [Char])
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields (Maybe [Char])
-> Mod OptionFields (Maybe [Char])
-> Mod OptionFields (Maybe [Char])
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields (Maybe [Char])
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"File containing shelley genesis parameters for the simulated L1 in offline mode."
    )

directChainConfigParser :: Parser DirectChainConfig
directChainConfigParser :: Parser DirectChainConfig
directChainConfigParser =
  NetworkId
-> SocketPath
-> TxId
-> [Char]
-> [[Char]]
-> Maybe ChainPoint
-> ContestationPeriod
-> DirectChainConfig
DirectChainConfig
    (NetworkId
 -> SocketPath
 -> TxId
 -> [Char]
 -> [[Char]]
 -> Maybe ChainPoint
 -> ContestationPeriod
 -> DirectChainConfig)
-> Parser NetworkId
-> Parser
     (SocketPath
      -> TxId
      -> [Char]
      -> [[Char]]
      -> Maybe ChainPoint
      -> ContestationPeriod
      -> DirectChainConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser NetworkId
networkIdParser
    Parser
  (SocketPath
   -> TxId
   -> [Char]
   -> [[Char]]
   -> Maybe ChainPoint
   -> ContestationPeriod
   -> DirectChainConfig)
-> Parser SocketPath
-> Parser
     (TxId
      -> [Char]
      -> [[Char]]
      -> Maybe ChainPoint
      -> ContestationPeriod
      -> DirectChainConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SocketPath
nodeSocketParser
    Parser
  (TxId
   -> [Char]
   -> [[Char]]
   -> Maybe ChainPoint
   -> ContestationPeriod
   -> DirectChainConfig)
-> Parser TxId
-> Parser
     ([Char]
      -> [[Char]]
      -> Maybe ChainPoint
      -> ContestationPeriod
      -> DirectChainConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TxId
hydraScriptsTxIdParser
    Parser
  ([Char]
   -> [[Char]]
   -> Maybe ChainPoint
   -> ContestationPeriod
   -> DirectChainConfig)
-> Parser [Char]
-> Parser
     ([[Char]]
      -> Maybe ChainPoint -> ContestationPeriod -> DirectChainConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Char]
cardanoSigningKeyFileParser
    Parser
  ([[Char]]
   -> Maybe ChainPoint -> ContestationPeriod -> DirectChainConfig)
-> Parser [[Char]]
-> Parser
     (Maybe ChainPoint -> ContestationPeriod -> DirectChainConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Char] -> Parser [[Char]]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser [Char]
cardanoVerificationKeyFileParser
    Parser
  (Maybe ChainPoint -> ContestationPeriod -> DirectChainConfig)
-> Parser (Maybe ChainPoint)
-> Parser (ContestationPeriod -> DirectChainConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ChainPoint -> Parser (Maybe ChainPoint)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ChainPoint
startChainFromParser
    Parser (ContestationPeriod -> DirectChainConfig)
-> Parser ContestationPeriod -> Parser DirectChainConfig
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ContestationPeriod
contestationPeriodParser

networkIdParser :: Parser NetworkId
networkIdParser :: Parser NetworkId
networkIdParser = Parser NetworkId
pMainnet Parser NetworkId -> Parser NetworkId -> Parser NetworkId
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (NetworkMagic -> NetworkId)
-> Parser NetworkMagic -> Parser NetworkId
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NetworkMagic -> NetworkId
Testnet Parser NetworkMagic
pTestnetMagic
 where
  pMainnet :: Parser NetworkId
  pMainnet :: Parser NetworkId
pMainnet =
    NetworkId -> Mod FlagFields NetworkId -> Parser NetworkId
forall a. a -> Mod FlagFields a -> Parser a
flag'
      NetworkId
Mainnet
      ( [Char] -> Mod FlagFields NetworkId
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"mainnet"
          Mod FlagFields NetworkId
-> Mod FlagFields NetworkId -> Mod FlagFields NetworkId
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields NetworkId
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Use the mainnet magic id."
      )

  pTestnetMagic :: Parser NetworkMagic
  pTestnetMagic :: Parser NetworkMagic
pTestnetMagic =
    Word32 -> NetworkMagic
NetworkMagic
      (Word32 -> NetworkMagic) -> Parser Word32 -> Parser NetworkMagic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Word32 -> Mod OptionFields Word32 -> Parser Word32
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
        ReadM Word32
forall a. Read a => ReadM a
auto
        ( [Char] -> Mod OptionFields Word32
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"testnet-magic"
            Mod OptionFields Word32
-> Mod OptionFields Word32 -> Mod OptionFields Word32
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Word32
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"NATURAL"
            Mod OptionFields Word32
-> Mod OptionFields Word32 -> Mod OptionFields Word32
forall a. Semigroup a => a -> a -> a
<> Word32 -> Mod OptionFields Word32
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Word32
42
            Mod OptionFields Word32
-> Mod OptionFields Word32 -> Mod OptionFields Word32
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Word32
forall a (f :: * -> *). Show a => Mod f a
showDefault
            Mod OptionFields Word32
-> Mod OptionFields Word32 -> Mod OptionFields Word32
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields Word32
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer ([[Char]] -> Completer
listCompleter [[Char]
"1", [Char]
"2", [Char]
"42"])
            Mod OptionFields Word32
-> Mod OptionFields Word32 -> Mod OptionFields Word32
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Word32
forall (f :: * -> *) a. [Char] -> Mod f a
help
              [Char]
"Network identifier for a testnet to connect to. We only need to \
              \provide the magic number here. For example: '2' is the 'preview' \
              \network. See https://book.world.dev.cardano.org/environments.html for available networks."
        )

nodeSocketParser :: Parser SocketPath
nodeSocketParser :: Parser SocketPath
nodeSocketParser =
  Mod OptionFields SocketPath -> Parser SocketPath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    ( [Char] -> Mod OptionFields SocketPath
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"node-socket"
        Mod OptionFields SocketPath
-> Mod OptionFields SocketPath -> Mod OptionFields SocketPath
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields SocketPath
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"FILE"
        Mod OptionFields SocketPath
-> Mod OptionFields SocketPath -> Mod OptionFields SocketPath
forall a. Semigroup a => a -> a -> a
<> SocketPath -> Mod OptionFields SocketPath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value SocketPath
"node.socket"
        Mod OptionFields SocketPath
-> Mod OptionFields SocketPath -> Mod OptionFields SocketPath
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields SocketPath
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields SocketPath
-> Mod OptionFields SocketPath -> Mod OptionFields SocketPath
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields SocketPath
forall (f :: * -> *) a. [Char] -> Mod f a
help
          [Char]
"Filepath to local unix domain socket used to communicate with \
          \the cardano node."
    )

cardanoSigningKeyFileParser :: Parser FilePath
cardanoSigningKeyFileParser :: Parser [Char]
cardanoSigningKeyFileParser =
  Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"cardano-signing-key"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"FILE"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields [Char]
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value [Char]
"cardano.sk"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help
          [Char]
"Cardano signing key of our hydra-node. This will be used to authorize \
          \Hydra protocol transactions for heads the node takes part in and any \
          \funds owned by this key will be used as 'fuel'."
    )

cardanoVerificationKeyFileParser :: Parser FilePath
cardanoVerificationKeyFileParser :: Parser [Char]
cardanoVerificationKeyFileParser =
  ReadM [Char] -> Mod OptionFields [Char] -> Parser [Char]
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ReadM [Char]
forall s. IsString s => ReadM s
str
    ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"cardano-verification-key"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"FILE"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help
          ( [Char]
"Cardano verification key of another party in the Head. Can be \
            \provided multiple times, once for each participant (current maximum limit is "
              [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall b a. (Show a, IsString b) => a -> b
show Int
maximumNumberOfParties
              [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
")."
          )
    )

hydraSigningKeyFileParser :: Parser FilePath
hydraSigningKeyFileParser :: Parser [Char]
hydraSigningKeyFileParser =
  ReadM [Char] -> Mod OptionFields [Char] -> Parser [Char]
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ReadM [Char]
forall s. IsString s => ReadM s
str
    ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"hydra-signing-key"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"FILE"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value [Char]
"hydra.sk"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields [Char]
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Hydra signing key used by our hydra-node."
    )

hydraVerificationKeyFileParser :: Parser FilePath
hydraVerificationKeyFileParser :: Parser [Char]
hydraVerificationKeyFileParser =
  ReadM [Char] -> Mod OptionFields [Char] -> Parser [Char]
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ReadM [Char]
forall s. IsString s => ReadM s
str
    ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"hydra-verification-key"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"FILE"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help
          ( [Char]
"Hydra verification key of another party in the Head. Can be \
            \provided multiple times, once for each participant (current maximum limit is "
              [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall b a. (Show a, IsString b) => a -> b
show Int
maximumNumberOfParties
              [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" )."
          )
    )

peerParser :: Parser Host
peerParser :: Parser Host
peerParser =
  ReadM Host -> Mod OptionFields Host -> Parser Host
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    (([Char] -> Maybe Host) -> ReadM Host
forall a. ([Char] -> Maybe a) -> ReadM a
maybeReader [Char] -> Maybe Host
forall (m :: * -> *). MonadFail m => [Char] -> m Host
readHost)
    ( [Char] -> Mod OptionFields Host
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"peer"
        Mod OptionFields Host
-> Mod OptionFields Host -> Mod OptionFields Host
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Host
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'P'
        Mod OptionFields Host
-> Mod OptionFields Host -> Mod OptionFields Host
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Host
forall (f :: * -> *) a. [Char] -> Mod f a
help
          ( [Char]
"A peer address in the form <host>:<port>, where <host> can be an IP \
            \address, or a host name. Can be provided multiple times, once for \
            \each peer (current maximum limit is "
              [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall b a. (Show a, IsString b) => a -> b
show Int
maximumNumberOfParties
              [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" peers)."
          )
    )

nodeIdParser :: Parser NodeId
nodeIdParser :: Parser NodeId
nodeIdParser =
  ReadM NodeId -> Mod OptionFields NodeId -> Parser NodeId
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ReadM NodeId
forall s. IsString s => ReadM s
str
    ( [Char] -> Mod OptionFields NodeId
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"node-id"
        Mod OptionFields NodeId
-> Mod OptionFields NodeId -> Mod OptionFields NodeId
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields NodeId
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'n'
        Mod OptionFields NodeId
-> Mod OptionFields NodeId -> Mod OptionFields NodeId
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields NodeId
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"NODE-ID"
        Mod OptionFields NodeId
-> Mod OptionFields NodeId -> Mod OptionFields NodeId
forall a. Semigroup a => a -> a -> a
<> NodeId -> Mod OptionFields NodeId
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value NodeId
"hydra-node-1"
        Mod OptionFields NodeId
-> Mod OptionFields NodeId -> Mod OptionFields NodeId
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields NodeId
forall (f :: * -> *) a. [Char] -> Mod f a
help
          [Char]
"The Hydra node identifier used on the Hydra network. It is \
          \important to have a unique identifier in order to be able to \
          \distinguish between connected peers."
    )

verbosityParser :: Parser Verbosity
verbosityParser :: Parser Verbosity
verbosityParser =
  Verbosity
-> Verbosity -> Mod FlagFields Verbosity -> Parser Verbosity
forall a. a -> a -> Mod FlagFields a -> Parser a
flag
    (Text -> Verbosity
Verbose Text
"HydraNode")
    Verbosity
Quiet
    ( [Char] -> Mod FlagFields Verbosity
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"quiet"
        Mod FlagFields Verbosity
-> Mod FlagFields Verbosity -> Mod FlagFields Verbosity
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Verbosity
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'q'
        Mod FlagFields Verbosity
-> Mod FlagFields Verbosity -> Mod FlagFields Verbosity
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Verbosity
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Turns off logging."
    )

hostParser :: Parser IP
hostParser :: Parser IP
hostParser =
  ReadM IP -> Mod OptionFields IP -> Parser IP
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ReadM IP
forall a. Read a => ReadM a
auto
    ( [Char] -> Mod OptionFields IP
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"host"
        Mod OptionFields IP -> Mod OptionFields IP -> Mod OptionFields IP
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields IP
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'h'
        -- XXX: This is default does not make sense, should use 0.0.0.0.
        Mod OptionFields IP -> Mod OptionFields IP -> Mod OptionFields IP
forall a. Semigroup a => a -> a -> a
<> IP -> Mod OptionFields IP
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value IP
"127.0.0.1"
        Mod OptionFields IP -> Mod OptionFields IP -> Mod OptionFields IP
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields IP
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields IP -> Mod OptionFields IP -> Mod OptionFields IP
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields IP
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"IP"
        Mod OptionFields IP -> Mod OptionFields IP -> Mod OptionFields IP
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields IP
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Listen address for incoming Hydra network connections."
    )

portParser :: Parser PortNumber
portParser :: Parser PortNumber
portParser =
  ReadM PortNumber
-> Mod OptionFields PortNumber -> Parser PortNumber
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    (([Char] -> Maybe PortNumber) -> ReadM PortNumber
forall a. ([Char] -> Maybe a) -> ReadM a
maybeReader [Char] -> Maybe PortNumber
forall (m :: * -> *). MonadFail m => [Char] -> m PortNumber
readPort)
    ( [Char] -> Mod OptionFields PortNumber
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"port"
        Mod OptionFields PortNumber
-> Mod OptionFields PortNumber -> Mod OptionFields PortNumber
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields PortNumber
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p'
        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
5001
        Mod OptionFields PortNumber
-> Mod OptionFields PortNumber -> Mod OptionFields PortNumber
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields PortNumber
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields PortNumber
-> Mod OptionFields PortNumber -> Mod OptionFields PortNumber
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields PortNumber
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"PORT"
        Mod OptionFields PortNumber
-> Mod OptionFields PortNumber -> Mod OptionFields PortNumber
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields PortNumber
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Listen port for incoming Hydra network connections."
    )

apiHostParser :: Parser IP
apiHostParser :: Parser IP
apiHostParser =
  ReadM IP -> Mod OptionFields IP -> Parser IP
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ReadM IP
forall a. Read a => ReadM a
auto
    ( [Char] -> Mod OptionFields IP
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"api-host"
        Mod OptionFields IP -> Mod OptionFields IP -> Mod OptionFields IP
forall a. Semigroup a => a -> a -> a
<> IP -> Mod OptionFields IP
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value IP
"127.0.0.1"
        Mod OptionFields IP -> Mod OptionFields IP -> Mod OptionFields IP
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields IP
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"IP"
        Mod OptionFields IP -> Mod OptionFields IP -> Mod OptionFields IP
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields IP
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields IP -> Mod OptionFields IP -> Mod OptionFields IP
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields IP
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Listen address for incoming client API connections."
    )

apiPortParser :: Parser PortNumber
apiPortParser :: Parser PortNumber
apiPortParser =
  ReadM PortNumber
-> Mod OptionFields PortNumber -> Parser PortNumber
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    (([Char] -> Maybe PortNumber) -> ReadM PortNumber
forall a. ([Char] -> Maybe a) -> ReadM a
maybeReader [Char] -> Maybe PortNumber
forall (m :: * -> *). MonadFail m => [Char] -> m PortNumber
readPort)
    ( [Char] -> Mod OptionFields PortNumber
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"api-port"
        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
4001
        Mod OptionFields PortNumber
-> Mod OptionFields PortNumber -> Mod OptionFields PortNumber
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields PortNumber
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields PortNumber
-> Mod OptionFields PortNumber -> Mod OptionFields PortNumber
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields PortNumber
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"PORT"
        Mod OptionFields PortNumber
-> Mod OptionFields PortNumber -> Mod OptionFields PortNumber
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields PortNumber
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Listen port for incoming client API connections."
    )

monitoringPortParser :: Parser PortNumber
monitoringPortParser :: Parser PortNumber
monitoringPortParser =
  ReadM PortNumber
-> Mod OptionFields PortNumber -> Parser PortNumber
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    (([Char] -> Maybe PortNumber) -> ReadM PortNumber
forall a. ([Char] -> Maybe a) -> ReadM a
maybeReader [Char] -> Maybe PortNumber
forall (m :: * -> *). MonadFail m => [Char] -> m PortNumber
readPort)
    ( [Char] -> Mod OptionFields PortNumber
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"monitoring-port"
        Mod OptionFields PortNumber
-> Mod OptionFields PortNumber -> Mod OptionFields PortNumber
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields PortNumber
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"PORT"
        Mod OptionFields PortNumber
-> Mod OptionFields PortNumber -> Mod OptionFields PortNumber
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields PortNumber
forall (f :: * -> *) a. [Char] -> Mod f a
help
          [Char]
"Listen port for monitoring and metrics via prometheus. If left \
          \empty, monitoring server is not started."
    )

startChainFromParser :: Parser ChainPoint
startChainFromParser :: Parser ChainPoint
startChainFromParser =
  ReadM ChainPoint
-> Mod OptionFields ChainPoint -> Parser ChainPoint
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    (([Char] -> Maybe ChainPoint) -> ReadM ChainPoint
forall a. ([Char] -> Maybe a) -> ReadM a
maybeReader [Char] -> Maybe ChainPoint
readChainPoint)
    ( [Char] -> Mod OptionFields ChainPoint
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"start-chain-from"
        Mod OptionFields ChainPoint
-> Mod OptionFields ChainPoint -> Mod OptionFields ChainPoint
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields ChainPoint
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"SLOT.HEADER_HASH"
        Mod OptionFields ChainPoint
-> Mod OptionFields ChainPoint -> Mod OptionFields ChainPoint
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields ChainPoint
forall (f :: * -> *) a. [Char] -> Mod f a
help
          [Char]
"The id of the block we want to start observing the chain from. \
          \If not given, uses the chain tip at startup. Composed by the slot \
          \number, a separator ('.') and the hash of the block header. \
          \For example: 52970883.d36a9936ae7a07f5f4bdc9ad0b23761cb7b14f35007e54947e27a1510f897f04."
    )
 where
  readChainPoint :: String -> Maybe ChainPoint
  readChainPoint :: [Char] -> Maybe ChainPoint
readChainPoint = \case
    [Char]
"0" -> ChainPoint -> Maybe ChainPoint
forall a. a -> Maybe a
Just ChainPoint
ChainPointAtGenesis
    [Char]
chainPointStr ->
      case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"." ([Char] -> Text
forall a. ToText a => a -> Text
toText [Char]
chainPointStr) of
        [Text
slotNoTxt, Text
headerHashTxt] -> do
          SlotNo
slotNo <- Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Maybe Word64 -> Maybe SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Maybe Word64
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
forall a. ToString a => a -> [Char]
toString Text
slotNoTxt)
          Hash BlockHeader
headerHash <-
            (RawBytesHexError -> Maybe (Hash BlockHeader))
-> (Hash BlockHeader -> Maybe (Hash BlockHeader))
-> Either RawBytesHexError (Hash BlockHeader)
-> Maybe (Hash BlockHeader)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (Hash BlockHeader)
-> RawBytesHexError -> Maybe (Hash BlockHeader)
forall a b. a -> b -> a
const Maybe (Hash BlockHeader)
forall a. Maybe a
Nothing) Hash BlockHeader -> Maybe (Hash BlockHeader)
forall a. a -> Maybe a
Just (Either RawBytesHexError (Hash BlockHeader)
 -> Maybe (Hash BlockHeader))
-> Either RawBytesHexError (Hash BlockHeader)
-> Maybe (Hash BlockHeader)
forall a b. (a -> b) -> a -> b
$
              AsType (Hash BlockHeader)
-> ByteString -> Either RawBytesHexError (Hash BlockHeader)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex (Proxy (Hash BlockHeader) -> AsType (Hash BlockHeader)
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType Proxy (Hash BlockHeader)
forall {k} (t :: k). Proxy t
Proxy) (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
headerHashTxt)
          pure $ SlotNo -> Hash BlockHeader -> ChainPoint
ChainPoint SlotNo
slotNo Hash BlockHeader
headerHash
        [Text]
_emptyOrSingularList ->
          Maybe ChainPoint
forall a. Maybe a
Nothing

hydraScriptsTxIdParser :: Parser TxId
hydraScriptsTxIdParser :: Parser TxId
hydraScriptsTxIdParser =
  ReadM TxId -> Mod OptionFields TxId -> Parser TxId
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    (([Char] -> Either [Char] TxId) -> ReadM TxId
forall a. ([Char] -> Either [Char] a) -> ReadM a
eitherReader (([Char] -> Either [Char] TxId) -> ReadM TxId)
-> ([Char] -> Either [Char] TxId) -> ReadM TxId
forall a b. (a -> b) -> a -> b
$ (RawBytesHexError -> [Char])
-> Either RawBytesHexError TxId -> Either [Char] TxId
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left RawBytesHexError -> [Char]
forall b a. (Show a, IsString b) => a -> b
show (Either RawBytesHexError TxId -> Either [Char] TxId)
-> ([Char] -> Either RawBytesHexError TxId)
-> [Char]
-> Either [Char] TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType TxId -> ByteString -> Either RawBytesHexError TxId
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex AsType TxId
AsTxId (ByteString -> Either RawBytesHexError TxId)
-> ([Char] -> ByteString) -> [Char] -> Either RawBytesHexError TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
BSC.pack)
    ( [Char] -> Mod OptionFields TxId
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"hydra-scripts-tx-id"
        Mod OptionFields TxId
-> Mod OptionFields TxId -> Mod OptionFields TxId
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields TxId
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"TXID"
        Mod OptionFields TxId
-> Mod OptionFields TxId -> Mod OptionFields TxId
forall a. Semigroup a => a -> a -> a
<> TxId -> Mod OptionFields TxId
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value TxId
"0101010101010101010101010101010101010101010101010101010101010101"
        Mod OptionFields TxId
-> Mod OptionFields TxId -> Mod OptionFields TxId
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields TxId
forall (f :: * -> *) a. [Char] -> Mod f a
help
          [Char]
"The transaction which is expected to have published Hydra scripts as \
          \reference scripts in its outputs. Note: All scripts need to be in the \
          \first 10 outputs. See release notes for pre-published versions. You \
          \can use the 'publish-scripts' sub-command to publish them yourself."
    )

persistenceDirParser :: Parser FilePath
persistenceDirParser :: Parser [Char]
persistenceDirParser =
  ReadM [Char] -> Mod OptionFields [Char] -> Parser [Char]
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ReadM [Char]
forall s. IsString s => ReadM s
str
    ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"persistence-dir"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DIR"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value [Char]
"./"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help
          [Char]
"The directory where the Hydra Head state is stored.\
          \Do not edit these files manually!"
    )

hydraNodeCommand :: ParserInfo Command
hydraNodeCommand :: ParserInfo Command
hydraNodeCommand =
  Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info
    ( Parser Command
commandParser
        Parser Command -> Parser (Command -> Command) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Command -> Command)
forall {a}. Parser (a -> a)
versionInfo
        Parser Command -> Parser (Command -> Command) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Command -> Command)
forall {a}. Parser (a -> a)
scriptInfo
        Parser Command -> Parser (Command -> Command) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Command -> Command)
forall {a}. Parser (a -> a)
helper
    )
    ( InfoMod Command
forall a. InfoMod a
fullDesc
        InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"Starts a Hydra Node"
        InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
header [Char]
"hydra-node - Implementation of the Hydra Head protocol"
    )
 where
  versionInfo :: Parser (a -> a)
versionInfo =
    [Char] -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. [Char] -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption
      (Version -> [Char]
showVersion Version
hydraNodeVersion)
      ([Char] -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"version" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Show version")

  scriptInfo :: Parser (a -> a)
scriptInfo =
    [Char] -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. [Char] -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption
      (ByteString -> [Char]
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> [Char]) -> ByteString -> [Char]
forall a b. (a -> b) -> a -> b
$ ScriptInfo -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty ScriptInfo
Contract.scriptInfo)
      ([Char] -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"script-info" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Dump script info as JSON")

hydraNodeVersion :: Version
hydraNodeVersion :: Version
hydraNodeVersion =
  Version
version Version -> (Version -> Version) -> Version
forall a b. a -> (a -> b) -> b
& \(Version [Int]
semver [[Char]]
_) -> [Int] -> [[Char]] -> Version
Version [Int]
semver [[Char]]
revision
 where
  revision :: [[Char]]
revision =
    Maybe [Char] -> [[Char]]
forall a. Maybe a -> [a]
maybeToList (Maybe [Char] -> [[Char]]) -> Maybe [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
      Maybe [Char]
embeddedRevision
        Maybe [Char] -> Maybe [Char] -> Maybe [Char]
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe [Char]
gitRevision
        Maybe [Char] -> Maybe [Char] -> Maybe [Char]
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
unknownVersion

defaultContestationPeriod :: ContestationPeriod
defaultContestationPeriod :: ContestationPeriod
defaultContestationPeriod = Natural -> ContestationPeriod
UnsafeContestationPeriod Natural
60

contestationPeriodParser :: Parser ContestationPeriod
contestationPeriodParser :: Parser ContestationPeriod
contestationPeriodParser =
  ReadM ContestationPeriod
-> Mod OptionFields ContestationPeriod -> Parser ContestationPeriod
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    (ReadM ContestationPeriod
parseNatural ReadM ContestationPeriod
-> ReadM ContestationPeriod -> ReadM ContestationPeriod
forall a. ReadM a -> ReadM a -> ReadM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReadM ContestationPeriod
parseViaDiffTime)
    ( [Char] -> Mod OptionFields ContestationPeriod
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"contestation-period"
        Mod OptionFields ContestationPeriod
-> Mod OptionFields ContestationPeriod
-> Mod OptionFields ContestationPeriod
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields ContestationPeriod
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"SECONDS"
        Mod OptionFields ContestationPeriod
-> Mod OptionFields ContestationPeriod
-> Mod OptionFields ContestationPeriod
forall a. Semigroup a => a -> a -> a
<> ContestationPeriod -> Mod OptionFields ContestationPeriod
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value ContestationPeriod
defaultContestationPeriod
        Mod OptionFields ContestationPeriod
-> Mod OptionFields ContestationPeriod
-> Mod OptionFields ContestationPeriod
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields ContestationPeriod
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields ContestationPeriod
-> Mod OptionFields ContestationPeriod
-> Mod OptionFields ContestationPeriod
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields ContestationPeriod
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer ([[Char]] -> Completer
listCompleter [[Char]
"60", [Char]
"180", [Char]
"300"])
        Mod OptionFields ContestationPeriod
-> Mod OptionFields ContestationPeriod
-> Mod OptionFields ContestationPeriod
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields ContestationPeriod
forall (f :: * -> *) a. [Char] -> Mod f a
help
          [Char]
"Contestation period for close transaction in seconds. \
          \ If this value is not in sync with other participants hydra-node will ignore the initial tx.\
          \ Additionally, this value needs to make sense compared to the current network we are running."
    )
 where
  parseNatural :: ReadM ContestationPeriod
parseNatural = Natural -> ContestationPeriod
UnsafeContestationPeriod (Natural -> ContestationPeriod)
-> ReadM Natural -> ReadM ContestationPeriod
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Natural
forall a. Read a => ReadM a
auto

  parseViaDiffTime :: ReadM ContestationPeriod
parseViaDiffTime = ReadM NominalDiffTime
forall a. Read a => ReadM a
auto ReadM NominalDiffTime
-> (NominalDiffTime -> ReadM ContestationPeriod)
-> ReadM ContestationPeriod
forall a b. ReadM a -> (a -> ReadM b) -> ReadM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NominalDiffTime -> ReadM ContestationPeriod
forall (m :: * -> *).
MonadFail m =>
NominalDiffTime -> m ContestationPeriod
fromNominalDiffTime

data InvalidOptions
  = MaximumNumberOfPartiesExceeded
  | CardanoAndHydraKeysMissmatch
  deriving stock (InvalidOptions -> InvalidOptions -> Bool
(InvalidOptions -> InvalidOptions -> Bool)
-> (InvalidOptions -> InvalidOptions -> Bool) -> Eq InvalidOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvalidOptions -> InvalidOptions -> Bool
== :: InvalidOptions -> InvalidOptions -> Bool
$c/= :: InvalidOptions -> InvalidOptions -> Bool
/= :: InvalidOptions -> InvalidOptions -> Bool
Eq, Int -> InvalidOptions -> ShowS
[InvalidOptions] -> ShowS
InvalidOptions -> [Char]
(Int -> InvalidOptions -> ShowS)
-> (InvalidOptions -> [Char])
-> ([InvalidOptions] -> ShowS)
-> Show InvalidOptions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidOptions -> ShowS
showsPrec :: Int -> InvalidOptions -> ShowS
$cshow :: InvalidOptions -> [Char]
show :: InvalidOptions -> [Char]
$cshowList :: [InvalidOptions] -> ShowS
showList :: [InvalidOptions] -> ShowS
Show)

-- | Validate cmd line arguments for hydra-node and check if they make sense before actually running the node.
-- Rules we apply:
--  - Check if number of parties is bigger than our hardcoded limit
--      (by looking at loaded hydra or cardano keys and comparing it to the 'maximumNumberOfParties')
--  - Check that number of loaded hydra keys match with the number of loaded cardano keys
--      (by comparing lengths of the two lists)
validateRunOptions :: RunOptions -> Either InvalidOptions ()
validateRunOptions :: RunOptions -> Either InvalidOptions ()
validateRunOptions RunOptions{[[Char]]
$sel:hydraVerificationKeys:RunOptions :: RunOptions -> [[Char]]
hydraVerificationKeys :: [[Char]]
hydraVerificationKeys, ChainConfig
$sel:chainConfig:RunOptions :: RunOptions -> ChainConfig
chainConfig :: ChainConfig
chainConfig} =
  case ChainConfig
chainConfig of
    Offline{} -> () -> Either InvalidOptions ()
forall a b. b -> Either a b
Right ()
    Direct DirectChainConfig{[[Char]]
$sel:cardanoVerificationKeys:DirectChainConfig :: DirectChainConfig -> [[Char]]
cardanoVerificationKeys :: [[Char]]
cardanoVerificationKeys}
      | Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ([[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
hydraVerificationKeys) ([[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
cardanoVerificationKeys) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maximumNumberOfParties ->
          InvalidOptions -> Either InvalidOptions ()
forall a b. a -> Either a b
Left InvalidOptions
MaximumNumberOfPartiesExceeded
      | [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
cardanoVerificationKeys Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
hydraVerificationKeys ->
          InvalidOptions -> Either InvalidOptions ()
forall a b. a -> Either a b
Left InvalidOptions
CardanoAndHydraKeysMissmatch
      | Bool
otherwise -> () -> Either InvalidOptions ()
forall a b. b -> Either a b
Right ()

-- | Parse command-line arguments into a `Option` or exit with failure and error message.
parseHydraCommand :: IO Command
parseHydraCommand :: IO Command
parseHydraCommand = IO [[Char]]
forall (m :: * -> *). MonadIO m => m [[Char]]
getArgs IO [[Char]]
-> ([[Char]] -> ParserResult Command) -> IO (ParserResult Command)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [[Char]] -> ParserResult Command
parseHydraCommandFromArgs IO (ParserResult Command)
-> (ParserResult Command -> IO Command) -> IO Command
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParserResult Command -> IO Command
forall a. ParserResult a -> IO a
handleParseResult

-- | Pure parsing of `Option` from a list of arguments.
parseHydraCommandFromArgs :: [String] -> ParserResult Command
parseHydraCommandFromArgs :: [[Char]] -> ParserResult Command
parseHydraCommandFromArgs = ParserPrefs
-> ParserInfo Command -> [[Char]] -> ParserResult Command
forall a. ParserPrefs -> ParserInfo a -> [[Char]] -> ParserResult a
execParserPure ParserPrefs
defaultPrefs ParserInfo Command
hydraNodeCommand

-- | Convert an 'Options' instance into the corresponding list of command-line arguments.
--
-- This is useful in situations where one wants to programatically define 'Options', providing
-- some measure of type safety, without having to juggle with strings.
toArgs :: RunOptions -> [String]
toArgs :: RunOptions -> [[Char]]
toArgs
  RunOptions
    { Verbosity
$sel:verbosity:RunOptions :: RunOptions -> Verbosity
verbosity :: Verbosity
verbosity
    , NodeId
$sel:nodeId:RunOptions :: RunOptions -> NodeId
nodeId :: NodeId
nodeId
    , IP
$sel:host:RunOptions :: RunOptions -> IP
host :: IP
host
    , PortNumber
$sel:port:RunOptions :: RunOptions -> PortNumber
port :: PortNumber
port
    , [Host]
$sel:peers:RunOptions :: RunOptions -> [Host]
peers :: [Host]
peers
    , IP
$sel:apiHost:RunOptions :: RunOptions -> IP
apiHost :: IP
apiHost
    , PortNumber
$sel:apiPort:RunOptions :: RunOptions -> PortNumber
apiPort :: PortNumber
apiPort
    , Maybe PortNumber
$sel:monitoringPort:RunOptions :: RunOptions -> Maybe PortNumber
monitoringPort :: Maybe PortNumber
monitoringPort
    , [Char]
$sel:hydraSigningKey:RunOptions :: RunOptions -> [Char]
hydraSigningKey :: [Char]
hydraSigningKey
    , [[Char]]
$sel:hydraVerificationKeys:RunOptions :: RunOptions -> [[Char]]
hydraVerificationKeys :: [[Char]]
hydraVerificationKeys
    , [Char]
$sel:persistenceDir:RunOptions :: RunOptions -> [Char]
persistenceDir :: [Char]
persistenceDir
    , ChainConfig
$sel:chainConfig:RunOptions :: RunOptions -> ChainConfig
chainConfig :: ChainConfig
chainConfig
    , LedgerConfig
$sel:ledgerConfig:RunOptions :: RunOptions -> LedgerConfig
ledgerConfig :: LedgerConfig
ledgerConfig
    } =
    Verbosity -> [[Char]]
isVerbose Verbosity
verbosity
      [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> [[Char]
"--node-id", Text -> [Char]
unpack Text
nId]
      [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> [[Char]
"--host", IP -> [Char]
forall b a. (Show a, IsString b) => a -> b
show IP
host]
      [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> [[Char]
"--port", PortNumber -> [Char]
forall b a. (Show a, IsString b) => a -> b
show PortNumber
port]
      [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> [[Char]
"--api-host", IP -> [Char]
forall b a. (Show a, IsString b) => a -> b
show IP
apiHost]
      [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> PortNumber -> [[Char]]
toArgApiPort PortNumber
apiPort
      [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> [[Char]
"--hydra-signing-key", [Char]
hydraSigningKey]
      [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> ([Char] -> [[Char]]) -> [[Char]] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\[Char]
vk -> [[Char]
"--hydra-verification-key", [Char]
vk]) [[Char]]
hydraVerificationKeys
      [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> (Host -> [[Char]]) -> [Host] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Host -> [[Char]]
forall {a} {a}. (IsString a, Show a) => a -> [a]
toArgPeer [Host]
peers
      [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> [[Char]]
-> (PortNumber -> [[Char]]) -> Maybe PortNumber -> [[Char]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\PortNumber
mport -> [[Char]
"--monitoring-port", PortNumber -> [Char]
forall b a. (Show a, IsString b) => a -> b
show PortNumber
mport]) Maybe PortNumber
monitoringPort
      [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> [[Char]
"--persistence-dir", [Char]
persistenceDir]
      [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> ChainConfig -> [[Char]]
argsChainConfig ChainConfig
chainConfig
      [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> [[Char]]
argsLedgerConfig
   where
    (NodeId Text
nId) = NodeId
nodeId
    isVerbose :: Verbosity -> [[Char]]
isVerbose = \case
      Verbosity
Quiet -> [[Char]
"--quiet"]
      Verbosity
_ -> []

    toArgPeer :: a -> [a]
toArgPeer a
p =
      [a
"--peer", a -> a
forall b a. (Show a, IsString b) => a -> b
show a
p]

    toArgStartChainFrom :: Maybe ChainPoint -> [[Char]]
toArgStartChainFrom = \case
      Just ChainPoint
ChainPointAtGenesis ->
        Text -> [[Char]]
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"ChainPointAtGenesis"
      Just (ChainPoint (SlotNo Word64
slotNo) Hash BlockHeader
headerHash) ->
        let headerHashBase16 :: [Char]
headerHashBase16 = Text -> [Char]
forall a. ToString a => a -> [Char]
toString (Hash BlockHeader -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash BlockHeader
headerHash)
         in [[Char]
"--start-chain-from", Word64 -> [Char]
forall b a. (Show a, IsString b) => a -> b
show Word64
slotNo [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"." [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
headerHashBase16]
      Maybe ChainPoint
Nothing ->
        []

    argsChainConfig :: ChainConfig -> [[Char]]
argsChainConfig = \case
      Offline
        OfflineChainConfig
          { [Char]
$sel:initialUTxOFile:OfflineChainConfig :: OfflineChainConfig -> [Char]
initialUTxOFile :: [Char]
initialUTxOFile
          , Maybe [Char]
$sel:ledgerGenesisFile:OfflineChainConfig :: OfflineChainConfig -> Maybe [Char]
ledgerGenesisFile :: Maybe [Char]
ledgerGenesisFile
          } ->
          [[Char]
"--initial-utxo", [Char]
initialUTxOFile]
            [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> case Maybe [Char]
ledgerGenesisFile of
              Just [Char]
fp -> [[Char]
"--ledger-genesis", [Char]
fp]
              Maybe [Char]
Nothing -> []
      Direct
        DirectChainConfig
          { NetworkId
$sel:networkId:DirectChainConfig :: DirectChainConfig -> NetworkId
networkId :: NetworkId
networkId
          , SocketPath
$sel:nodeSocket:DirectChainConfig :: DirectChainConfig -> SocketPath
nodeSocket :: SocketPath
nodeSocket
          , TxId
$sel:hydraScriptsTxId:DirectChainConfig :: DirectChainConfig -> TxId
hydraScriptsTxId :: TxId
hydraScriptsTxId
          , [Char]
$sel:cardanoSigningKey:DirectChainConfig :: DirectChainConfig -> [Char]
cardanoSigningKey :: [Char]
cardanoSigningKey
          , [[Char]]
$sel:cardanoVerificationKeys:DirectChainConfig :: DirectChainConfig -> [[Char]]
cardanoVerificationKeys :: [[Char]]
cardanoVerificationKeys
          , Maybe ChainPoint
$sel:startChainFrom:DirectChainConfig :: DirectChainConfig -> Maybe ChainPoint
startChainFrom :: Maybe ChainPoint
startChainFrom
          , ContestationPeriod
$sel:contestationPeriod:DirectChainConfig :: DirectChainConfig -> ContestationPeriod
contestationPeriod :: ContestationPeriod
contestationPeriod
          } ->
          NetworkId -> [[Char]]
toArgNetworkId NetworkId
networkId
            [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> SocketPath -> [[Char]]
toArgNodeSocket SocketPath
nodeSocket
            [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> [[Char]
"--hydra-scripts-tx-id", Text -> [Char]
forall a. ToString a => a -> [Char]
toString (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ TxId -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText TxId
hydraScriptsTxId]
            [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> [[Char]
"--cardano-signing-key", [Char]
cardanoSigningKey]
            [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> [[Char]
"--contestation-period", ContestationPeriod -> [Char]
forall b a. (Show a, IsString b) => a -> b
show ContestationPeriod
contestationPeriod]
            [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> ([Char] -> [[Char]]) -> [[Char]] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\[Char]
vk -> [[Char]
"--cardano-verification-key", [Char]
vk]) [[Char]]
cardanoVerificationKeys
            [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> Maybe ChainPoint -> [[Char]]
toArgStartChainFrom Maybe ChainPoint
startChainFrom

    argsLedgerConfig :: [[Char]]
argsLedgerConfig =
      [[Char]
"--ledger-protocol-parameters", [Char]
cardanoLedgerProtocolParametersFile]

    CardanoLedgerConfig
      { [Char]
$sel:cardanoLedgerProtocolParametersFile:CardanoLedgerConfig :: LedgerConfig -> [Char]
cardanoLedgerProtocolParametersFile :: [Char]
cardanoLedgerProtocolParametersFile
      } = LedgerConfig
ledgerConfig

toArgNodeSocket :: SocketPath -> [String]
toArgNodeSocket :: SocketPath -> [[Char]]
toArgNodeSocket SocketPath
nodeSocket = [[Char]
"--node-socket", SocketPath -> [Char]
forall content (direction :: FileDirection).
File content direction -> [Char]
unFile SocketPath
nodeSocket]

toArgApiPort :: PortNumber -> [String]
toArgApiPort :: PortNumber -> [[Char]]
toArgApiPort PortNumber
apiPort = [[Char]
"--api-port", PortNumber -> [Char]
forall b a. (Show a, IsString b) => a -> b
show PortNumber
apiPort]

toArgNetworkId :: NetworkId -> [String]
toArgNetworkId :: NetworkId -> [[Char]]
toArgNetworkId = \case
  NetworkId
Mainnet -> [[Char]
"--mainnet"]
  Testnet (NetworkMagic Word32
magic) -> [[Char]
"--testnet-magic", Word32 -> [Char]
forall b a. (Show a, IsString b) => a -> b
show Word32
magic]

genFilePath :: String -> Gen FilePath
genFilePath :: [Char] -> Gen [Char]
genFilePath [Char]
extension = do
  [[Char]]
path <- Gen [[Char]] -> Gen [[Char]]
forall a. Gen a -> Gen a
reasonablySized (Gen [Char] -> Gen [[Char]]
forall a. Gen a -> Gen [a]
listOf1 ([[Char]] -> Gen [Char]
forall a. [a] -> Gen a
elements [[Char]
"a", [Char]
"b", [Char]
"c"]))
  pure $ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"/" [[Char]]
path [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"." [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
extension

genDirPath :: Gen FilePath
genDirPath :: Gen [Char]
genDirPath = do
  [[Char]]
path <- Gen [[Char]] -> Gen [[Char]]
forall a. Gen a -> Gen a
reasonablySized (Gen [Char] -> Gen [[Char]]
forall a. Gen a -> Gen [a]
listOf1 ([[Char]] -> Gen [Char]
forall a. [a] -> Gen a
elements [[Char]
"a", [Char]
"b", [Char]
"c"]))
  pure $ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"/" [[Char]]
path

genChainPoint :: Gen ChainPoint
genChainPoint :: Gen ChainPoint
genChainPoint = (SlotNo -> Hash BlockHeader -> ChainPoint
ChainPoint (SlotNo -> Hash BlockHeader -> ChainPoint)
-> (Word64 -> SlotNo) -> Word64 -> Hash BlockHeader -> ChainPoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> SlotNo
SlotNo (Word64 -> Hash BlockHeader -> ChainPoint)
-> Gen Word64 -> Gen (Hash BlockHeader -> ChainPoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary) Gen (Hash BlockHeader -> ChainPoint)
-> Gen (Hash BlockHeader) -> Gen ChainPoint
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Hash BlockHeader)
someHeaderHash
 where
  someHeaderHash :: Gen (Hash BlockHeader)
someHeaderHash = do
    [Word8]
bytes <- Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
32 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
    let hash :: Hash BlockHeader
hash = (SerialiseAsRawBytesError -> Hash BlockHeader)
-> (Hash BlockHeader -> Hash BlockHeader)
-> Either SerialiseAsRawBytesError (Hash BlockHeader)
-> Hash BlockHeader
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> SerialiseAsRawBytesError -> Hash BlockHeader
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"invalid bytes") Hash BlockHeader -> Hash BlockHeader
forall a. a -> a
id (Either SerialiseAsRawBytesError (Hash BlockHeader)
 -> Hash BlockHeader)
-> Either SerialiseAsRawBytesError (Hash BlockHeader)
-> Hash BlockHeader
forall a b. (a -> b) -> a -> b
$ AsType (Hash BlockHeader)
-> ByteString -> Either SerialiseAsRawBytesError (Hash BlockHeader)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes (Proxy (Hash BlockHeader) -> AsType (Hash BlockHeader)
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType Proxy (Hash BlockHeader)
forall {k} (t :: k). Proxy t
Proxy) (ByteString -> Either SerialiseAsRawBytesError (Hash BlockHeader))
-> ([Word8] -> ByteString)
-> [Word8]
-> Either SerialiseAsRawBytesError (Hash BlockHeader)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> Either SerialiseAsRawBytesError (Hash BlockHeader))
-> [Word8] -> Either SerialiseAsRawBytesError (Hash BlockHeader)
forall a b. (a -> b) -> a -> b
$ [Word8]
bytes
    Hash BlockHeader -> Gen (Hash BlockHeader)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Hash BlockHeader
hash