{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# 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.Char8 qualified as BSC
import Data.IP (IP (IPv4), toIPv4)
import Data.List (nub)
import Data.Text (unpack)
import Data.Text qualified as T
import Data.Version (showVersion)
import Hydra.Cardano.Api (
  ChainPoint (..),
  File (..),
  NetworkId (..),
  NetworkMagic (..),
  SlotNo (..),
  SocketPath,
  TxId (..),
  deserialiseFromRawBytesHex,
  serialiseToRawBytesHexText,
 )
import Hydra.Chain (maximumNumberOfParties)
import Hydra.Contract qualified as Contract
import Hydra.Ledger.Cardano ()
import Hydra.Logging (Verbosity (..))
import Hydra.Network (Host (..), NodeId (NodeId), PortNumber, WhichEtcd (..), readHost, readPort, showHost)
import Hydra.NetworkVersions (hydraNodeVersion, parseNetworkTxIds)
import Hydra.Node.ApiTransactionTimeout (ApiTransactionTimeout (..))
import Hydra.Node.UnsyncedPeriod (UnsyncedPeriod (..), defaultUnsyncedPeriodFor)
import Hydra.Tx.ContestationPeriod (ContestationPeriod, fromNominalDiffTime)
import Hydra.Tx.DepositPeriod (DepositPeriod (..))
import Hydra.Tx.HeadId (HeadSeed)
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 Test.QuickCheck (Positive (..))

data Command
  = Run RunOptions
  | Publish PublishOptions
  | GenHydraKey GenerateKeyPair
  deriving stock (Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
(Int -> Command -> ShowS)
-> (Command -> String) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Command -> ShowS
showsPrec :: Int -> Command -> ShowS
$cshow :: Command -> String
show :: Command -> String
$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)

-- | Subcommand names recognized by 'commandParser'.
--
-- Derived from the same string literals used to register the subcommands
-- below, so that 'Main.hs' can't drift out of sync with the parser when a
-- new subcommand is added.
subcommandNames :: [String]
subcommandNames :: [String]
subcommandNames = [String
publishScriptsName, String
genHydraKeyName]

publishScriptsName :: String
publishScriptsName :: String
publishScriptsName = String
"publish-scripts"

genHydraKeyName :: String
genHydraKeyName :: String
genHydraKeyName = String
"gen-hydra-key"

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
publishScriptsCommand
        Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> Mod CommandFields Command
genHydraKeyCommand

  publishScriptsCommand :: Mod CommandFields Command
publishScriptsCommand =
    String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
command
      String
publishScriptsName
      ( 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
<> String -> InfoMod Command
forall a. String -> InfoMod a
footer
                String
"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 =
    String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
command
      String
genHydraKeyName
      ( Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info
          (GenerateKeyPair -> Command
GenHydraKey (GenerateKeyPair -> Command)
-> (String -> GenerateKeyPair) -> String -> Command
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GenerateKeyPair
GenerateKeyPair (String -> Command) -> Parser String -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
outputFileParser)
          (String -> InfoMod Command
forall a. String -> InfoMod a
progDesc String
"Generate a pair of Hydra signing/verification keys (off-chain keys).")
      )

data PublishOptions = PublishOptions
  { PublishOptions -> ChainBackendOptions
chainBackendOptions :: ChainBackendOptions
  , PublishOptions -> String
publishSigningKey :: FilePath
  }
  deriving stock (Int -> PublishOptions -> ShowS
[PublishOptions] -> ShowS
PublishOptions -> String
(Int -> PublishOptions -> ShowS)
-> (PublishOptions -> String)
-> ([PublishOptions] -> ShowS)
-> Show PublishOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PublishOptions -> ShowS
showsPrec :: Int -> PublishOptions -> ShowS
$cshow :: PublishOptions -> String
show :: PublishOptions -> String
$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, (forall x. PublishOptions -> Rep PublishOptions x)
-> (forall x. Rep PublishOptions x -> PublishOptions)
-> Generic PublishOptions
forall x. Rep PublishOptions x -> PublishOptions
forall x. PublishOptions -> Rep PublishOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PublishOptions -> Rep PublishOptions x
from :: forall x. PublishOptions -> Rep PublishOptions x
$cto :: forall x. Rep PublishOptions x -> PublishOptions
to :: forall x. Rep PublishOptions x -> PublishOptions
Generic)

defaultDirectOptions :: DirectOptions
defaultDirectOptions :: DirectOptions
defaultDirectOptions =
  DirectOptions
    { $sel:networkId:DirectOptions :: NetworkId
networkId = NetworkMagic -> NetworkId
Testnet (Word32 -> NetworkMagic
NetworkMagic Word32
42)
    , $sel:nodeSocket:DirectOptions :: SocketPath
nodeSocket = SocketPath
"node.socket"
    }

data ChainBackendOptions
  = Direct DirectOptions
  | Blockfrost BlockfrostOptions
  deriving stock ((forall x. ChainBackendOptions -> Rep ChainBackendOptions x)
-> (forall x. Rep ChainBackendOptions x -> ChainBackendOptions)
-> Generic ChainBackendOptions
forall x. Rep ChainBackendOptions x -> ChainBackendOptions
forall x. ChainBackendOptions -> Rep ChainBackendOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChainBackendOptions -> Rep ChainBackendOptions x
from :: forall x. ChainBackendOptions -> Rep ChainBackendOptions x
$cto :: forall x. Rep ChainBackendOptions x -> ChainBackendOptions
to :: forall x. Rep ChainBackendOptions x -> ChainBackendOptions
Generic, Int -> ChainBackendOptions -> ShowS
[ChainBackendOptions] -> ShowS
ChainBackendOptions -> String
(Int -> ChainBackendOptions -> ShowS)
-> (ChainBackendOptions -> String)
-> ([ChainBackendOptions] -> ShowS)
-> Show ChainBackendOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChainBackendOptions -> ShowS
showsPrec :: Int -> ChainBackendOptions -> ShowS
$cshow :: ChainBackendOptions -> String
show :: ChainBackendOptions -> String
$cshowList :: [ChainBackendOptions] -> ShowS
showList :: [ChainBackendOptions] -> ShowS
Show, ChainBackendOptions -> ChainBackendOptions -> Bool
(ChainBackendOptions -> ChainBackendOptions -> Bool)
-> (ChainBackendOptions -> ChainBackendOptions -> Bool)
-> Eq ChainBackendOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChainBackendOptions -> ChainBackendOptions -> Bool
== :: ChainBackendOptions -> ChainBackendOptions -> Bool
$c/= :: ChainBackendOptions -> ChainBackendOptions -> Bool
/= :: ChainBackendOptions -> ChainBackendOptions -> Bool
Eq)
  deriving anyclass ([ChainBackendOptions] -> Value
[ChainBackendOptions] -> Encoding
ChainBackendOptions -> Bool
ChainBackendOptions -> Value
ChainBackendOptions -> Encoding
(ChainBackendOptions -> Value)
-> (ChainBackendOptions -> Encoding)
-> ([ChainBackendOptions] -> Value)
-> ([ChainBackendOptions] -> Encoding)
-> (ChainBackendOptions -> Bool)
-> ToJSON ChainBackendOptions
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ChainBackendOptions -> Value
toJSON :: ChainBackendOptions -> Value
$ctoEncoding :: ChainBackendOptions -> Encoding
toEncoding :: ChainBackendOptions -> Encoding
$ctoJSONList :: [ChainBackendOptions] -> Value
toJSONList :: [ChainBackendOptions] -> Value
$ctoEncodingList :: [ChainBackendOptions] -> Encoding
toEncodingList :: [ChainBackendOptions] -> Encoding
$comitField :: ChainBackendOptions -> Bool
omitField :: ChainBackendOptions -> Bool
ToJSON, Maybe ChainBackendOptions
Value -> Parser [ChainBackendOptions]
Value -> Parser ChainBackendOptions
(Value -> Parser ChainBackendOptions)
-> (Value -> Parser [ChainBackendOptions])
-> Maybe ChainBackendOptions
-> FromJSON ChainBackendOptions
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ChainBackendOptions
parseJSON :: Value -> Parser ChainBackendOptions
$cparseJSONList :: Value -> Parser [ChainBackendOptions]
parseJSONList :: Value -> Parser [ChainBackendOptions]
$comittedField :: Maybe ChainBackendOptions
omittedField :: Maybe ChainBackendOptions
FromJSON)

data DirectOptions = DirectOptions
  { DirectOptions -> NetworkId
networkId :: NetworkId
  -- ^ Network identifier to which we expect to connect.
  , DirectOptions -> SocketPath
nodeSocket :: SocketPath
  -- ^ Path to a domain socket used to connect to the server.
  }
  deriving stock ((forall x. DirectOptions -> Rep DirectOptions x)
-> (forall x. Rep DirectOptions x -> DirectOptions)
-> Generic DirectOptions
forall x. Rep DirectOptions x -> DirectOptions
forall x. DirectOptions -> Rep DirectOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DirectOptions -> Rep DirectOptions x
from :: forall x. DirectOptions -> Rep DirectOptions x
$cto :: forall x. Rep DirectOptions x -> DirectOptions
to :: forall x. Rep DirectOptions x -> DirectOptions
Generic, Int -> DirectOptions -> ShowS
[DirectOptions] -> ShowS
DirectOptions -> String
(Int -> DirectOptions -> ShowS)
-> (DirectOptions -> String)
-> ([DirectOptions] -> ShowS)
-> Show DirectOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DirectOptions -> ShowS
showsPrec :: Int -> DirectOptions -> ShowS
$cshow :: DirectOptions -> String
show :: DirectOptions -> String
$cshowList :: [DirectOptions] -> ShowS
showList :: [DirectOptions] -> ShowS
Show, DirectOptions -> DirectOptions -> Bool
(DirectOptions -> DirectOptions -> Bool)
-> (DirectOptions -> DirectOptions -> Bool) -> Eq DirectOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DirectOptions -> DirectOptions -> Bool
== :: DirectOptions -> DirectOptions -> Bool
$c/= :: DirectOptions -> DirectOptions -> Bool
/= :: DirectOptions -> DirectOptions -> Bool
Eq)
  deriving anyclass ([DirectOptions] -> Value
[DirectOptions] -> Encoding
DirectOptions -> Bool
DirectOptions -> Value
DirectOptions -> Encoding
(DirectOptions -> Value)
-> (DirectOptions -> Encoding)
-> ([DirectOptions] -> Value)
-> ([DirectOptions] -> Encoding)
-> (DirectOptions -> Bool)
-> ToJSON DirectOptions
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: DirectOptions -> Value
toJSON :: DirectOptions -> Value
$ctoEncoding :: DirectOptions -> Encoding
toEncoding :: DirectOptions -> Encoding
$ctoJSONList :: [DirectOptions] -> Value
toJSONList :: [DirectOptions] -> Value
$ctoEncodingList :: [DirectOptions] -> Encoding
toEncodingList :: [DirectOptions] -> Encoding
$comitField :: DirectOptions -> Bool
omitField :: DirectOptions -> Bool
ToJSON, Maybe DirectOptions
Value -> Parser [DirectOptions]
Value -> Parser DirectOptions
(Value -> Parser DirectOptions)
-> (Value -> Parser [DirectOptions])
-> Maybe DirectOptions
-> FromJSON DirectOptions
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser DirectOptions
parseJSON :: Value -> Parser DirectOptions
$cparseJSONList :: Value -> Parser [DirectOptions]
parseJSONList :: Value -> Parser [DirectOptions]
$comittedField :: Maybe DirectOptions
omittedField :: Maybe DirectOptions
FromJSON)

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

defaultBlockfrostOptions :: BlockfrostOptions
defaultBlockfrostOptions :: BlockfrostOptions
defaultBlockfrostOptions =
  BlockfrostOptions
    { $sel:projectPath:BlockfrostOptions :: String
projectPath = String
"blockfrost-project.txt"
    }

publishOptionsParser :: Parser PublishOptions
publishOptionsParser :: Parser PublishOptions
publishOptionsParser =
  ChainBackendOptions -> String -> PublishOptions
PublishOptions (ChainBackendOptions -> String -> PublishOptions)
-> Parser ChainBackendOptions -> Parser (String -> PublishOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ChainBackendOptions
chainBackendOptionsParser Parser (String -> PublishOptions)
-> Parser String -> 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 String
cardanoSigningKeyFileParser

data RunOptions = RunOptions
  { RunOptions -> Verbosity
verbosity :: Verbosity
  , RunOptions -> NodeId
nodeId :: NodeId
  , RunOptions -> Host
listen :: Host
  , RunOptions -> Maybe Host
advertise :: Maybe Host
  , RunOptions -> [Host]
peers :: [Host]
  , RunOptions -> IP
apiHost :: IP
  , RunOptions -> PortNumber
apiPort :: PortNumber
  , RunOptions -> Maybe String
tlsCertPath :: Maybe FilePath
  , RunOptions -> Maybe String
tlsKeyPath :: Maybe FilePath
  , RunOptions -> Maybe PortNumber
monitoringPort :: Maybe PortNumber
  , RunOptions -> String
hydraSigningKey :: FilePath
  , RunOptions -> [String]
hydraVerificationKeys :: [FilePath]
  , RunOptions -> String
persistenceDir :: FilePath
  , RunOptions -> Maybe (Positive Natural)
persistenceRotateAfter :: Maybe (Positive Natural)
  , RunOptions -> ChainConfig
chainConfig :: ChainConfig
  , RunOptions -> LedgerConfig
ledgerConfig :: LedgerConfig
  , RunOptions -> WhichEtcd
whichEtcd :: WhichEtcd
  , RunOptions -> ApiTransactionTimeout
apiTransactionTimeout :: ApiTransactionTimeout
  }
  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 -> String
(Int -> RunOptions -> ShowS)
-> (RunOptions -> String)
-> ([RunOptions] -> ShowS)
-> Show RunOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunOptions -> ShowS
showsPrec :: Int -> RunOptions -> ShowS
$cshow :: RunOptions -> String
show :: RunOptions -> String
$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 instances
instance ToJSON a => ToJSON (Positive a) where
  toJSON :: Positive a -> Value
toJSON (Positive a
a) = a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a

instance FromJSON a => FromJSON (Positive a) where
  parseJSON :: Value -> Parser (Positive a)
parseJSON Value
v = a -> Positive a
forall a. a -> Positive a
Positive (a -> Positive a) -> Parser a -> Parser (Positive a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

-- | 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:listen:RunOptions :: Host
listen = Text -> PortNumber -> Host
Host Text
"0.0.0.0" PortNumber
5001
    , $sel:advertise:RunOptions :: Maybe Host
advertise = Maybe Host
forall a. Maybe a
Nothing
    , $sel:peers:RunOptions :: [Host]
peers = []
    , $sel:apiHost:RunOptions :: IP
apiHost = IP
localhost
    , $sel:apiPort:RunOptions :: PortNumber
apiPort = PortNumber
4001
    , $sel:tlsCertPath:RunOptions :: Maybe String
tlsCertPath = Maybe String
forall a. Maybe a
Nothing
    , $sel:tlsKeyPath:RunOptions :: Maybe String
tlsKeyPath = Maybe String
forall a. Maybe a
Nothing
    , $sel:monitoringPort:RunOptions :: Maybe PortNumber
monitoringPort = Maybe PortNumber
forall a. Maybe a
Nothing
    , $sel:hydraSigningKey:RunOptions :: String
hydraSigningKey = String
"hydra.sk"
    , $sel:hydraVerificationKeys:RunOptions :: [String]
hydraVerificationKeys = []
    , $sel:persistenceDir:RunOptions :: String
persistenceDir = String
"./"
    , $sel:persistenceRotateAfter:RunOptions :: Maybe (Positive Natural)
persistenceRotateAfter = Maybe (Positive Natural)
forall a. Maybe a
Nothing
    , $sel:chainConfig:RunOptions :: ChainConfig
chainConfig = CardanoChainConfig -> ChainConfig
Cardano CardanoChainConfig
defaultCardanoChainConfig
    , $sel:ledgerConfig:RunOptions :: LedgerConfig
ledgerConfig = LedgerConfig
defaultLedgerConfig
    , $sel:whichEtcd:RunOptions :: WhichEtcd
whichEtcd = WhichEtcd
EmbeddedEtcd
    , $sel:apiTransactionTimeout:RunOptions :: ApiTransactionTimeout
apiTransactionTimeout = ApiTransactionTimeout
300
    }
 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]

-- | Merge two 'RunOptions': for each field, @cli@ wins if it differs from
-- 'defaultRunOptions'; otherwise @base@ (e.g. loaded from a config file) wins.
-- Nested chain and ledger configs are merged recursively.
instance Semigroup RunOptions where
  RunOptions
base <> :: RunOptions -> RunOptions -> RunOptions
<> RunOptions
cli =
    RunOptions
      { $sel:verbosity:RunOptions :: Verbosity
verbosity = Verbosity -> Verbosity -> Verbosity -> Verbosity
forall a. Eq a => a -> a -> a -> a
o RunOptions
defaultRunOptions.verbosity RunOptions
base.verbosity RunOptions
cli.verbosity
      , $sel:nodeId:RunOptions :: NodeId
nodeId = NodeId -> NodeId -> NodeId -> NodeId
forall a. Eq a => a -> a -> a -> a
o RunOptions
defaultRunOptions.nodeId RunOptions
base.nodeId RunOptions
cli.nodeId
      , $sel:listen:RunOptions :: Host
listen = Host -> Host -> Host -> Host
forall a. Eq a => a -> a -> a -> a
o RunOptions
defaultRunOptions.listen RunOptions
base.listen RunOptions
cli.listen
      , $sel:advertise:RunOptions :: Maybe Host
advertise = Maybe Host -> Maybe Host -> Maybe Host -> Maybe Host
forall a. Eq a => a -> a -> a -> a
o RunOptions
defaultRunOptions.advertise RunOptions
base.advertise RunOptions
cli.advertise
      , -- Lists are unioned so that YAML entries and CLI flags are both
        -- included.  Duplicates are removed.  There is no way to "clear" the
        -- YAML list from the CLI; if you need full CLI control, simply omit
        -- these fields from the config file.
        $sel:peers:RunOptions :: [Host]
peers = [Host] -> [Host]
forall a. Eq a => [a] -> [a]
nub (RunOptions
base.peers [Host] -> [Host] -> [Host]
forall a. Semigroup a => a -> a -> a
<> RunOptions
cli.peers)
      , $sel:apiHost:RunOptions :: IP
apiHost = IP -> IP -> IP -> IP
forall a. Eq a => a -> a -> a -> a
o RunOptions
defaultRunOptions.apiHost RunOptions
base.apiHost RunOptions
cli.apiHost
      , $sel:apiPort:RunOptions :: PortNumber
apiPort = PortNumber -> PortNumber -> PortNumber -> PortNumber
forall a. Eq a => a -> a -> a -> a
o RunOptions
defaultRunOptions.apiPort RunOptions
base.apiPort RunOptions
cli.apiPort
      , $sel:tlsCertPath:RunOptions :: Maybe String
tlsCertPath = Maybe String -> Maybe String -> Maybe String -> Maybe String
forall a. Eq a => a -> a -> a -> a
o RunOptions
defaultRunOptions.tlsCertPath RunOptions
base.tlsCertPath RunOptions
cli.tlsCertPath
      , $sel:tlsKeyPath:RunOptions :: Maybe String
tlsKeyPath = Maybe String -> Maybe String -> Maybe String -> Maybe String
forall a. Eq a => a -> a -> a -> a
o RunOptions
defaultRunOptions.tlsKeyPath RunOptions
base.tlsKeyPath RunOptions
cli.tlsKeyPath
      , $sel:monitoringPort:RunOptions :: Maybe PortNumber
monitoringPort = Maybe PortNumber
-> Maybe PortNumber -> Maybe PortNumber -> Maybe PortNumber
forall a. Eq a => a -> a -> a -> a
o RunOptions
defaultRunOptions.monitoringPort RunOptions
base.monitoringPort RunOptions
cli.monitoringPort
      , $sel:hydraSigningKey:RunOptions :: String
hydraSigningKey = String -> String -> ShowS
forall a. Eq a => a -> a -> a -> a
o RunOptions
defaultRunOptions.hydraSigningKey RunOptions
base.hydraSigningKey RunOptions
cli.hydraSigningKey
      , $sel:hydraVerificationKeys:RunOptions :: [String]
hydraVerificationKeys = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub (RunOptions
base.hydraVerificationKeys [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> RunOptions
cli.hydraVerificationKeys)
      , $sel:persistenceDir:RunOptions :: String
persistenceDir = String -> String -> ShowS
forall a. Eq a => a -> a -> a -> a
o RunOptions
defaultRunOptions.persistenceDir RunOptions
base.persistenceDir RunOptions
cli.persistenceDir
      , $sel:persistenceRotateAfter:RunOptions :: Maybe (Positive Natural)
persistenceRotateAfter = Maybe (Positive Natural)
-> Maybe (Positive Natural)
-> Maybe (Positive Natural)
-> Maybe (Positive Natural)
forall a. Eq a => a -> a -> a -> a
o RunOptions
defaultRunOptions.persistenceRotateAfter RunOptions
base.persistenceRotateAfter RunOptions
cli.persistenceRotateAfter
      , $sel:chainConfig:RunOptions :: ChainConfig
chainConfig = RunOptions
base.chainConfig ChainConfig -> ChainConfig -> ChainConfig
forall a. Semigroup a => a -> a -> a
<> RunOptions
cli.chainConfig
      , $sel:ledgerConfig:RunOptions :: LedgerConfig
ledgerConfig = RunOptions
base.ledgerConfig LedgerConfig -> LedgerConfig -> LedgerConfig
forall a. Semigroup a => a -> a -> a
<> RunOptions
cli.ledgerConfig
      , $sel:whichEtcd:RunOptions :: WhichEtcd
whichEtcd = WhichEtcd -> WhichEtcd -> WhichEtcd -> WhichEtcd
forall a. Eq a => a -> a -> a -> a
o RunOptions
defaultRunOptions.whichEtcd RunOptions
base.whichEtcd RunOptions
cli.whichEtcd
      , $sel:apiTransactionTimeout:RunOptions :: ApiTransactionTimeout
apiTransactionTimeout = ApiTransactionTimeout
-> ApiTransactionTimeout
-> ApiTransactionTimeout
-> ApiTransactionTimeout
forall a. Eq a => a -> a -> a -> a
o RunOptions
defaultRunOptions.apiTransactionTimeout RunOptions
base.apiTransactionTimeout RunOptions
cli.apiTransactionTimeout
      }
   where
    o :: Eq a => a -> a -> a -> a
    o :: forall a. Eq a => a -> a -> a -> a
o = a -> a -> a -> a
forall a. Eq a => a -> a -> a -> a
overrideField

instance Semigroup ChainConfig where
  Cardano CardanoChainConfig
a <> :: ChainConfig -> ChainConfig -> ChainConfig
<> Cardano CardanoChainConfig
b = CardanoChainConfig -> ChainConfig
Cardano (CardanoChainConfig
a CardanoChainConfig -> CardanoChainConfig -> CardanoChainConfig
forall a. Semigroup a => a -> a -> a
<> CardanoChainConfig
b)
  -- If the config file says offline but CLI has the default Cardano config (no
  -- chain flags were supplied), keep the offline config from the file.
  Offline OfflineChainConfig
b <> Cardano CardanoChainConfig
c
    | CardanoChainConfig
c CardanoChainConfig -> CardanoChainConfig -> Bool
forall a. Eq a => a -> a -> Bool
== CardanoChainConfig
defaultCardanoChainConfig = OfflineChainConfig -> ChainConfig
Offline OfflineChainConfig
b
    | Bool
otherwise =
        Text -> ChainConfig
forall a t. (HasCallStack, IsText t) => t -> a
error
          Text
"Conflicting chain configuration: the config file specifies \
          \offline mode but Cardano-specific flags were also passed on the \
          \command line (e.g. --node-socket, --cardano-signing-key, \
          \--contestation-period, --hydra-scripts-tx-id). \
          \Either remove those CLI flags or change the config file to use \
          \cardano mode."
  -- In all other mixed-mode cases let the CLI value win (e.g. user explicitly
  -- passes --offline-head-seed to override a cardano config file).
  ChainConfig
_ <> ChainConfig
rhs = ChainConfig
rhs

instance Semigroup CardanoChainConfig where
  CardanoChainConfig
base <> :: CardanoChainConfig -> CardanoChainConfig -> CardanoChainConfig
<> CardanoChainConfig
cli =
    CardanoChainConfig
      { $sel:hydraScriptsTxId:CardanoChainConfig :: [TxId]
hydraScriptsTxId = [TxId] -> [TxId] -> [TxId] -> [TxId]
forall a. Eq a => a -> a -> a -> a
o CardanoChainConfig
defaultCardanoChainConfig.hydraScriptsTxId CardanoChainConfig
base.hydraScriptsTxId CardanoChainConfig
cli.hydraScriptsTxId
      , $sel:cardanoSigningKey:CardanoChainConfig :: String
cardanoSigningKey = String -> String -> ShowS
forall a. Eq a => a -> a -> a -> a
o CardanoChainConfig
defaultCardanoChainConfig.cardanoSigningKey CardanoChainConfig
base.cardanoSigningKey CardanoChainConfig
cli.cardanoSigningKey
      , -- Lists are unioned so that YAML peer entries and CLI --cardano-verification-key
        -- flags are both included rather than one silently replacing the other.
        -- Duplicates are removed.
        $sel:cardanoVerificationKeys:CardanoChainConfig :: [String]
cardanoVerificationKeys = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub (CardanoChainConfig
base.cardanoVerificationKeys [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> CardanoChainConfig
cli.cardanoVerificationKeys)
      , $sel:startChainFrom:CardanoChainConfig :: Maybe ChainPoint
startChainFrom = Maybe ChainPoint
-> Maybe ChainPoint -> Maybe ChainPoint -> Maybe ChainPoint
forall a. Eq a => a -> a -> a -> a
o CardanoChainConfig
defaultCardanoChainConfig.startChainFrom CardanoChainConfig
base.startChainFrom CardanoChainConfig
cli.startChainFrom
      , $sel:contestationPeriod:CardanoChainConfig :: ContestationPeriod
contestationPeriod = ContestationPeriod
mergedContestationPeriod
      , $sel:depositPeriod:CardanoChainConfig :: DepositPeriod
depositPeriod = DepositPeriod -> DepositPeriod -> DepositPeriod -> DepositPeriod
forall a. Eq a => a -> a -> a -> a
o CardanoChainConfig
defaultCardanoChainConfig.depositPeriod CardanoChainConfig
base.depositPeriod CardanoChainConfig
cli.depositPeriod
      , $sel:depositActivation:CardanoChainConfig :: DepositPeriod
depositActivation = DepositPeriod -> DepositPeriod -> DepositPeriod -> DepositPeriod
forall a. Eq a => a -> a -> a -> a
o CardanoChainConfig
defaultCardanoChainConfig.depositActivation CardanoChainConfig
base.depositActivation CardanoChainConfig
cli.depositActivation
      , $sel:unsyncedPeriod:CardanoChainConfig :: UnsyncedPeriod
unsyncedPeriod = UnsyncedPeriod
mergedUnsyncedPeriod
      , $sel:chainBackendOptions:CardanoChainConfig :: ChainBackendOptions
chainBackendOptions = CardanoChainConfig
base.chainBackendOptions ChainBackendOptions -> ChainBackendOptions -> ChainBackendOptions
forall a. Semigroup a => a -> a -> a
<> CardanoChainConfig
cli.chainBackendOptions
      }
   where
    o :: Eq a => a -> a -> a -> a
    o :: forall a. Eq a => a -> a -> a -> a
o = a -> a -> a -> a
forall a. Eq a => a -> a -> a -> a
overrideField
    mergedContestationPeriod :: ContestationPeriod
mergedContestationPeriod =
      ContestationPeriod
-> ContestationPeriod -> ContestationPeriod -> ContestationPeriod
forall a. Eq a => a -> a -> a -> a
o CardanoChainConfig
defaultCardanoChainConfig.contestationPeriod CardanoChainConfig
base.contestationPeriod CardanoChainConfig
cli.contestationPeriod
    -- unsyncedPeriod is automatically derived from contestationPeriod when not
    -- set explicitly. We detect "explicitly set" by checking whether the
    -- stored value differs from what would have been auto-derived for that
    -- side's own contestationPeriod. If neither side looks to have set it on
    -- purpose, we re-derive from the merged contestationPeriod so that
    -- overriding contestation from the CLI also shifts the derived
    -- unsynced-period.
    --
    -- Known limitation: if a user explicitly sets unsyncedPeriod to exactly
    -- the auto-derived value (e.g. 30min unsynced with 1h contestation), the
    -- heuristic cannot tell it apart from "unset" and will re-derive if the
    -- merged contestationPeriod differs. Setting a non-default value or
    -- using only one of YAML/CLI avoids this.
    yamlSetUnsynced :: Bool
yamlSetUnsynced = CardanoChainConfig
base.unsyncedPeriod UnsyncedPeriod -> UnsyncedPeriod -> Bool
forall a. Eq a => a -> a -> Bool
/= ContestationPeriod -> UnsyncedPeriod
defaultUnsyncedPeriodFor CardanoChainConfig
base.contestationPeriod
    cliSetUnsynced :: Bool
cliSetUnsynced = CardanoChainConfig
cli.unsyncedPeriod UnsyncedPeriod -> UnsyncedPeriod -> Bool
forall a. Eq a => a -> a -> Bool
/= ContestationPeriod -> UnsyncedPeriod
defaultUnsyncedPeriodFor CardanoChainConfig
cli.contestationPeriod
    mergedUnsyncedPeriod :: UnsyncedPeriod
mergedUnsyncedPeriod
      | Bool
cliSetUnsynced = CardanoChainConfig
cli.unsyncedPeriod
      | Bool
yamlSetUnsynced = CardanoChainConfig
base.unsyncedPeriod
      | Bool
otherwise = ContestationPeriod -> UnsyncedPeriod
defaultUnsyncedPeriodFor ContestationPeriod
mergedContestationPeriod

instance Semigroup ChainBackendOptions where
  Direct DirectOptions
a <> :: ChainBackendOptions -> ChainBackendOptions -> ChainBackendOptions
<> Direct DirectOptions
b = DirectOptions -> ChainBackendOptions
Direct (DirectOptions
a DirectOptions -> DirectOptions -> DirectOptions
forall a. Semigroup a => a -> a -> a
<> DirectOptions
b)
  Blockfrost BlockfrostOptions
a <> Blockfrost BlockfrostOptions
b = BlockfrostOptions -> ChainBackendOptions
Blockfrost (BlockfrostOptions
a BlockfrostOptions -> BlockfrostOptions -> BlockfrostOptions
forall a. Semigroup a => a -> a -> a
<> BlockfrostOptions
b)
  ChainBackendOptions
_ <> ChainBackendOptions
rhs = ChainBackendOptions
rhs

instance Semigroup DirectOptions where
  DirectOptions
base <> :: DirectOptions -> DirectOptions -> DirectOptions
<> DirectOptions
cli =
    DirectOptions
      { $sel:networkId:DirectOptions :: NetworkId
networkId = NetworkId -> NetworkId -> NetworkId -> NetworkId
forall a. Eq a => a -> a -> a -> a
o DirectOptions
defaultDirectOptions.networkId DirectOptions
base.networkId DirectOptions
cli.networkId
      , $sel:nodeSocket:DirectOptions :: SocketPath
nodeSocket = SocketPath -> SocketPath -> SocketPath -> SocketPath
forall a. Eq a => a -> a -> a -> a
o DirectOptions
defaultDirectOptions.nodeSocket DirectOptions
base.nodeSocket DirectOptions
cli.nodeSocket
      }
   where
    o :: Eq a => a -> a -> a -> a
    o :: forall a. Eq a => a -> a -> a -> a
o = a -> a -> a -> a
forall a. Eq a => a -> a -> a -> a
overrideField

instance Semigroup BlockfrostOptions where
  BlockfrostOptions
base <> :: BlockfrostOptions -> BlockfrostOptions -> BlockfrostOptions
<> BlockfrostOptions
cli =
    BlockfrostOptions
      { $sel:projectPath:BlockfrostOptions :: String
projectPath = String -> String -> ShowS
forall a. Eq a => a -> a -> a -> a
o BlockfrostOptions
defaultBlockfrostOptions.projectPath BlockfrostOptions
base.projectPath BlockfrostOptions
cli.projectPath
      }
   where
    o :: Eq a => a -> a -> a -> a
    o :: forall a. Eq a => a -> a -> a -> a
o = a -> a -> a -> a
forall a. Eq a => a -> a -> a -> a
overrideField

instance Semigroup LedgerConfig where
  CardanoLedgerConfig String
base <> :: LedgerConfig -> LedgerConfig -> LedgerConfig
<> CardanoLedgerConfig String
cli =
    String -> LedgerConfig
CardanoLedgerConfig (String -> LedgerConfig) -> String -> LedgerConfig
forall a b. (a -> b) -> a -> b
$
      String -> String -> ShowS
forall a. Eq a => a -> a -> a -> a
overrideField
        LedgerConfig
defaultLedgerConfig.cardanoLedgerProtocolParametersFile
        String
base
        String
cli

-- | Use @cli@ if it differs from @def@, otherwise keep @base@.
--
-- Note: if the user explicitly passes a CLI flag whose value happens to equal
-- the default (e.g. @--api-port 4001@ when 4001 is the default), the config
-- file value wins. This is a known limitation of inferring intent from equality
-- with the default; a proper fix would require tracking which flags were
-- explicitly set (e.g. via @Maybe@-wrapped parser results).
overrideField :: Eq a => a -> a -> a -> a
overrideField :: forall a. Eq a => a -> a -> a -> a
overrideField a
def a
base a
cli
  | a
cli a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
def = a
cli
  | Bool
otherwise = a
base

-- | Parser for running the cardano-node with all its 'RunOptions'.
runOptionsParser :: Parser RunOptions
runOptionsParser :: Parser RunOptions
runOptionsParser =
  Verbosity
-> NodeId
-> Host
-> Maybe Host
-> [Host]
-> IP
-> PortNumber
-> Maybe String
-> Maybe String
-> Maybe PortNumber
-> String
-> [String]
-> String
-> Maybe (Positive Natural)
-> ChainConfig
-> LedgerConfig
-> WhichEtcd
-> ApiTransactionTimeout
-> RunOptions
RunOptions
    (Verbosity
 -> NodeId
 -> Host
 -> Maybe Host
 -> [Host]
 -> IP
 -> PortNumber
 -> Maybe String
 -> Maybe String
 -> Maybe PortNumber
 -> String
 -> [String]
 -> String
 -> Maybe (Positive Natural)
 -> ChainConfig
 -> LedgerConfig
 -> WhichEtcd
 -> ApiTransactionTimeout
 -> RunOptions)
-> Parser Verbosity
-> Parser
     (NodeId
      -> Host
      -> Maybe Host
      -> [Host]
      -> IP
      -> PortNumber
      -> Maybe String
      -> Maybe String
      -> Maybe PortNumber
      -> String
      -> [String]
      -> String
      -> Maybe (Positive Natural)
      -> ChainConfig
      -> LedgerConfig
      -> WhichEtcd
      -> ApiTransactionTimeout
      -> RunOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Verbosity
verbosityParser
    Parser
  (NodeId
   -> Host
   -> Maybe Host
   -> [Host]
   -> IP
   -> PortNumber
   -> Maybe String
   -> Maybe String
   -> Maybe PortNumber
   -> String
   -> [String]
   -> String
   -> Maybe (Positive Natural)
   -> ChainConfig
   -> LedgerConfig
   -> WhichEtcd
   -> ApiTransactionTimeout
   -> RunOptions)
-> Parser NodeId
-> Parser
     (Host
      -> Maybe Host
      -> [Host]
      -> IP
      -> PortNumber
      -> Maybe String
      -> Maybe String
      -> Maybe PortNumber
      -> String
      -> [String]
      -> String
      -> Maybe (Positive Natural)
      -> ChainConfig
      -> LedgerConfig
      -> WhichEtcd
      -> ApiTransactionTimeout
      -> 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
  (Host
   -> Maybe Host
   -> [Host]
   -> IP
   -> PortNumber
   -> Maybe String
   -> Maybe String
   -> Maybe PortNumber
   -> String
   -> [String]
   -> String
   -> Maybe (Positive Natural)
   -> ChainConfig
   -> LedgerConfig
   -> WhichEtcd
   -> ApiTransactionTimeout
   -> RunOptions)
-> Parser Host
-> Parser
     (Maybe Host
      -> [Host]
      -> IP
      -> PortNumber
      -> Maybe String
      -> Maybe String
      -> Maybe PortNumber
      -> String
      -> [String]
      -> String
      -> Maybe (Positive Natural)
      -> ChainConfig
      -> LedgerConfig
      -> WhichEtcd
      -> ApiTransactionTimeout
      -> 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
listenParser
    Parser
  (Maybe Host
   -> [Host]
   -> IP
   -> PortNumber
   -> Maybe String
   -> Maybe String
   -> Maybe PortNumber
   -> String
   -> [String]
   -> String
   -> Maybe (Positive Natural)
   -> ChainConfig
   -> LedgerConfig
   -> WhichEtcd
   -> ApiTransactionTimeout
   -> RunOptions)
-> Parser (Maybe Host)
-> Parser
     ([Host]
      -> IP
      -> PortNumber
      -> Maybe String
      -> Maybe String
      -> Maybe PortNumber
      -> String
      -> [String]
      -> String
      -> Maybe (Positive Natural)
      -> ChainConfig
      -> LedgerConfig
      -> WhichEtcd
      -> ApiTransactionTimeout
      -> 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 (Maybe Host)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Host
advertiseParser
    Parser
  ([Host]
   -> IP
   -> PortNumber
   -> Maybe String
   -> Maybe String
   -> Maybe PortNumber
   -> String
   -> [String]
   -> String
   -> Maybe (Positive Natural)
   -> ChainConfig
   -> LedgerConfig
   -> WhichEtcd
   -> ApiTransactionTimeout
   -> RunOptions)
-> Parser [Host]
-> Parser
     (IP
      -> PortNumber
      -> Maybe String
      -> Maybe String
      -> Maybe PortNumber
      -> String
      -> [String]
      -> String
      -> Maybe (Positive Natural)
      -> ChainConfig
      -> LedgerConfig
      -> WhichEtcd
      -> ApiTransactionTimeout
      -> 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 String
   -> Maybe String
   -> Maybe PortNumber
   -> String
   -> [String]
   -> String
   -> Maybe (Positive Natural)
   -> ChainConfig
   -> LedgerConfig
   -> WhichEtcd
   -> ApiTransactionTimeout
   -> RunOptions)
-> Parser IP
-> Parser
     (PortNumber
      -> Maybe String
      -> Maybe String
      -> Maybe PortNumber
      -> String
      -> [String]
      -> String
      -> Maybe (Positive Natural)
      -> ChainConfig
      -> LedgerConfig
      -> WhichEtcd
      -> ApiTransactionTimeout
      -> 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 String
   -> Maybe String
   -> Maybe PortNumber
   -> String
   -> [String]
   -> String
   -> Maybe (Positive Natural)
   -> ChainConfig
   -> LedgerConfig
   -> WhichEtcd
   -> ApiTransactionTimeout
   -> RunOptions)
-> Parser PortNumber
-> Parser
     (Maybe String
      -> Maybe String
      -> Maybe PortNumber
      -> String
      -> [String]
      -> String
      -> Maybe (Positive Natural)
      -> ChainConfig
      -> LedgerConfig
      -> WhichEtcd
      -> ApiTransactionTimeout
      -> 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 String
   -> Maybe String
   -> Maybe PortNumber
   -> String
   -> [String]
   -> String
   -> Maybe (Positive Natural)
   -> ChainConfig
   -> LedgerConfig
   -> WhichEtcd
   -> ApiTransactionTimeout
   -> RunOptions)
-> Parser (Maybe String)
-> Parser
     (Maybe String
      -> Maybe PortNumber
      -> String
      -> [String]
      -> String
      -> Maybe (Positive Natural)
      -> ChainConfig
      -> LedgerConfig
      -> WhichEtcd
      -> ApiTransactionTimeout
      -> 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 String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser String
tlsCertPathParser
    Parser
  (Maybe String
   -> Maybe PortNumber
   -> String
   -> [String]
   -> String
   -> Maybe (Positive Natural)
   -> ChainConfig
   -> LedgerConfig
   -> WhichEtcd
   -> ApiTransactionTimeout
   -> RunOptions)
-> Parser (Maybe String)
-> Parser
     (Maybe PortNumber
      -> String
      -> [String]
      -> String
      -> Maybe (Positive Natural)
      -> ChainConfig
      -> LedgerConfig
      -> WhichEtcd
      -> ApiTransactionTimeout
      -> 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 String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser String
tlsKeyPathParser
    Parser
  (Maybe PortNumber
   -> String
   -> [String]
   -> String
   -> Maybe (Positive Natural)
   -> ChainConfig
   -> LedgerConfig
   -> WhichEtcd
   -> ApiTransactionTimeout
   -> RunOptions)
-> Parser (Maybe PortNumber)
-> Parser
     (String
      -> [String]
      -> String
      -> Maybe (Positive Natural)
      -> ChainConfig
      -> LedgerConfig
      -> WhichEtcd
      -> ApiTransactionTimeout
      -> 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
  (String
   -> [String]
   -> String
   -> Maybe (Positive Natural)
   -> ChainConfig
   -> LedgerConfig
   -> WhichEtcd
   -> ApiTransactionTimeout
   -> RunOptions)
-> Parser String
-> Parser
     ([String]
      -> String
      -> Maybe (Positive Natural)
      -> ChainConfig
      -> LedgerConfig
      -> WhichEtcd
      -> ApiTransactionTimeout
      -> 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 String
hydraSigningKeyFileParser
    Parser
  ([String]
   -> String
   -> Maybe (Positive Natural)
   -> ChainConfig
   -> LedgerConfig
   -> WhichEtcd
   -> ApiTransactionTimeout
   -> RunOptions)
-> Parser [String]
-> Parser
     (String
      -> Maybe (Positive Natural)
      -> ChainConfig
      -> LedgerConfig
      -> WhichEtcd
      -> ApiTransactionTimeout
      -> 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 String -> Parser [String]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser String
hydraVerificationKeyFileParser
    Parser
  (String
   -> Maybe (Positive Natural)
   -> ChainConfig
   -> LedgerConfig
   -> WhichEtcd
   -> ApiTransactionTimeout
   -> RunOptions)
-> Parser String
-> Parser
     (Maybe (Positive Natural)
      -> ChainConfig
      -> LedgerConfig
      -> WhichEtcd
      -> ApiTransactionTimeout
      -> 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 String
persistenceDirParser
    Parser
  (Maybe (Positive Natural)
   -> ChainConfig
   -> LedgerConfig
   -> WhichEtcd
   -> ApiTransactionTimeout
   -> RunOptions)
-> Parser (Maybe (Positive Natural))
-> Parser
     (ChainConfig
      -> LedgerConfig
      -> WhichEtcd
      -> ApiTransactionTimeout
      -> 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 (Positive Natural) -> Parser (Maybe (Positive Natural))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser (Positive Natural)
persistenceRotateAfterParser
    Parser
  (ChainConfig
   -> LedgerConfig
   -> WhichEtcd
   -> ApiTransactionTimeout
   -> RunOptions)
-> Parser ChainConfig
-> Parser
     (LedgerConfig -> WhichEtcd -> ApiTransactionTimeout -> 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 ChainConfig
chainConfigParser
    Parser
  (LedgerConfig -> WhichEtcd -> ApiTransactionTimeout -> RunOptions)
-> Parser LedgerConfig
-> Parser (WhichEtcd -> ApiTransactionTimeout -> 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
    Parser (WhichEtcd -> ApiTransactionTimeout -> RunOptions)
-> Parser WhichEtcd -> Parser (ApiTransactionTimeout -> 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 WhichEtcd
whichEtcdParser
    Parser (ApiTransactionTimeout -> RunOptions)
-> Parser ApiTransactionTimeout -> 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 ApiTransactionTimeout
apiTransactionTimeoutParser
      -- Consume --config FILE so it appears in --help and is accepted by the
      -- parser.  The value is stripped from argv before this parser runs (see
      -- Main.hs), so this is purely for documentation purposes.
      Parser RunOptions -> Parser (Maybe String) -> Parser RunOptions
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser String
configFileParser

configFileParser :: Parser FilePath
configFileParser :: Parser String
configFileParser =
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"config"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILE"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help
          String
"Path to a YAML configuration file. \
          \CLI flags take precedence over values in the file."
    )

whichEtcdParser :: Parser WhichEtcd
whichEtcdParser :: Parser WhichEtcd
whichEtcdParser =
  WhichEtcd
-> WhichEtcd -> Mod FlagFields WhichEtcd -> Parser WhichEtcd
forall a. a -> a -> Mod FlagFields a -> Parser a
flag
    WhichEtcd
EmbeddedEtcd
    WhichEtcd
SystemEtcd
    ( String -> Mod FlagFields WhichEtcd
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"use-system-etcd"
        Mod FlagFields WhichEtcd
-> Mod FlagFields WhichEtcd -> Mod FlagFields WhichEtcd
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields WhichEtcd
forall (f :: * -> *) a. String -> Mod f a
help String
"Use the `etcd` binary found on the path instead of the embedded one."
    )

chainConfigParser :: Parser ChainConfig
chainConfigParser :: Parser ChainConfig
chainConfigParser =
  CardanoChainConfig -> ChainConfig
Cardano (CardanoChainConfig -> ChainConfig)
-> Parser CardanoChainConfig -> Parser ChainConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CardanoChainConfig
cardanoChainConfigParser
    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

chainBackendOptionsParser :: Parser ChainBackendOptions
chainBackendOptionsParser :: Parser ChainBackendOptions
chainBackendOptionsParser = Parser ChainBackendOptions
directOptionsParser Parser ChainBackendOptions
-> Parser ChainBackendOptions -> Parser ChainBackendOptions
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ChainBackendOptions
blockfrostOptionsParser
 where
  directOptionsParser :: Parser ChainBackendOptions
directOptionsParser =
    (DirectOptions -> ChainBackendOptions)
-> Parser DirectOptions -> Parser ChainBackendOptions
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DirectOptions -> ChainBackendOptions
Direct (Parser DirectOptions -> Parser ChainBackendOptions)
-> Parser DirectOptions -> Parser ChainBackendOptions
forall a b. (a -> b) -> a -> b
$
      NetworkId -> SocketPath -> DirectOptions
DirectOptions
        (NetworkId -> SocketPath -> DirectOptions)
-> Parser NetworkId -> Parser (SocketPath -> DirectOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser NetworkId
networkIdParser
        Parser (SocketPath -> DirectOptions)
-> Parser SocketPath -> Parser DirectOptions
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

  blockfrostOptionsParser :: Parser ChainBackendOptions
blockfrostOptionsParser =
    BlockfrostOptions -> ChainBackendOptions
Blockfrost (BlockfrostOptions -> ChainBackendOptions)
-> (String -> BlockfrostOptions) -> String -> ChainBackendOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> BlockfrostOptions
BlockfrostOptions (String -> ChainBackendOptions)
-> Parser String -> Parser ChainBackendOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
blockfrostProjectPathParser

newtype GenerateKeyPair = GenerateKeyPair
  { GenerateKeyPair -> String
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 -> String
(Int -> GenerateKeyPair -> ShowS)
-> (GenerateKeyPair -> String)
-> ([GenerateKeyPair] -> ShowS)
-> Show GenerateKeyPair
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenerateKeyPair -> ShowS
showsPrec :: Int -> GenerateKeyPair -> ShowS
$cshow :: GenerateKeyPair -> String
show :: GenerateKeyPair -> String
$cshowList :: [GenerateKeyPair] -> ShowS
showList :: [GenerateKeyPair] -> ShowS
Show)

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

newtype LedgerConfig = CardanoLedgerConfig
  { LedgerConfig -> String
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 -> String
(Int -> LedgerConfig -> ShowS)
-> (LedgerConfig -> String)
-> ([LedgerConfig] -> ShowS)
-> Show LedgerConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LedgerConfig -> ShowS
showsPrec :: Int -> LedgerConfig -> ShowS
$cshow :: LedgerConfig -> String
show :: LedgerConfig -> String
$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 :: String
cardanoLedgerProtocolParametersFile = String
"protocol-parameters.json"
    }

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

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

data ChainConfig
  = Offline OfflineChainConfig
  | Cardano CardanoChainConfig
  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 -> String
(Int -> ChainConfig -> ShowS)
-> (ChainConfig -> String)
-> ([ChainConfig] -> ShowS)
-> Show ChainConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChainConfig -> ShowS
showsPrec :: Int -> ChainConfig -> ShowS
$cshow :: ChainConfig -> String
show :: ChainConfig -> String
$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"
    Cardano CardanoChainConfig
cfg -> CardanoChainConfig -> Value
forall a. ToJSON a => a -> Value
toJSON CardanoChainConfig
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
"CardanoChainConfig"

instance FromJSON ChainConfig where
  parseJSON :: Value -> Parser ChainConfig
parseJSON =
    String
-> (Object -> Parser ChainConfig) -> Value -> Parser ChainConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"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 String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tag" Parser String
-> (String -> 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
        String
"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)
        String
"CardanoChainConfig" -> CardanoChainConfig -> ChainConfig
Cardano (CardanoChainConfig -> ChainConfig)
-> Parser CardanoChainConfig -> Parser ChainConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser CardanoChainConfig
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
        String
tag -> String -> Parser ChainConfig
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ChainConfig) -> String -> Parser ChainConfig
forall a b. (a -> b) -> a -> b
$ String
"unexpected tag " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
tag

data OfflineChainConfig = OfflineChainConfig
  { OfflineChainConfig -> HeadSeed
offlineHeadSeed :: HeadSeed
  -- ^ Manually provided seed of the offline head.
  , OfflineChainConfig -> String
initialUTxOFile :: FilePath
  -- ^ Path to a json encoded starting 'UTxO' for the offline-mode head.
  , OfflineChainConfig -> Maybe String
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 -> String
(Int -> OfflineChainConfig -> ShowS)
-> (OfflineChainConfig -> String)
-> ([OfflineChainConfig] -> ShowS)
-> Show OfflineChainConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OfflineChainConfig -> ShowS
showsPrec :: Int -> OfflineChainConfig -> ShowS
$cshow :: OfflineChainConfig -> String
show :: OfflineChainConfig -> String
$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)

data CardanoChainConfig = CardanoChainConfig
  { CardanoChainConfig -> [TxId]
hydraScriptsTxId :: [TxId]
  -- ^ Identifier of transaction holding the hydra scripts to use.
  , CardanoChainConfig -> String
cardanoSigningKey :: FilePath
  -- ^ Path to the cardano signing key of the internal wallet.
  , CardanoChainConfig -> [String]
cardanoVerificationKeys :: [FilePath]
  -- ^ Paths to other node's verification keys.
  , CardanoChainConfig -> Maybe ChainPoint
startChainFrom :: Maybe ChainPoint
  -- ^ Point at which to start following the chain.
  , CardanoChainConfig -> ContestationPeriod
contestationPeriod :: ContestationPeriod
  , CardanoChainConfig -> DepositPeriod
depositPeriod :: DepositPeriod
  , CardanoChainConfig -> DepositPeriod
depositActivation :: DepositPeriod
  -- ^ Time a deposit must mature before it is considered active. Controls only
  -- the Inactive -> Active transition, independently of 'depositPeriod'.
  , CardanoChainConfig -> UnsyncedPeriod
unsyncedPeriod :: UnsyncedPeriod
  -- ^ Period of time after which we consider the node becoming unsynced with the chain.
  -- Defaults to half of the contestation period if not specified via CLI.
  , CardanoChainConfig -> ChainBackendOptions
chainBackendOptions :: ChainBackendOptions
  }
  deriving stock (CardanoChainConfig -> CardanoChainConfig -> Bool
(CardanoChainConfig -> CardanoChainConfig -> Bool)
-> (CardanoChainConfig -> CardanoChainConfig -> Bool)
-> Eq CardanoChainConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CardanoChainConfig -> CardanoChainConfig -> Bool
== :: CardanoChainConfig -> CardanoChainConfig -> Bool
$c/= :: CardanoChainConfig -> CardanoChainConfig -> Bool
/= :: CardanoChainConfig -> CardanoChainConfig -> Bool
Eq, Int -> CardanoChainConfig -> ShowS
[CardanoChainConfig] -> ShowS
CardanoChainConfig -> String
(Int -> CardanoChainConfig -> ShowS)
-> (CardanoChainConfig -> String)
-> ([CardanoChainConfig] -> ShowS)
-> Show CardanoChainConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CardanoChainConfig -> ShowS
showsPrec :: Int -> CardanoChainConfig -> ShowS
$cshow :: CardanoChainConfig -> String
show :: CardanoChainConfig -> String
$cshowList :: [CardanoChainConfig] -> ShowS
showList :: [CardanoChainConfig] -> ShowS
Show, (forall x. CardanoChainConfig -> Rep CardanoChainConfig x)
-> (forall x. Rep CardanoChainConfig x -> CardanoChainConfig)
-> Generic CardanoChainConfig
forall x. Rep CardanoChainConfig x -> CardanoChainConfig
forall x. CardanoChainConfig -> Rep CardanoChainConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CardanoChainConfig -> Rep CardanoChainConfig x
from :: forall x. CardanoChainConfig -> Rep CardanoChainConfig x
$cto :: forall x. Rep CardanoChainConfig x -> CardanoChainConfig
to :: forall x. Rep CardanoChainConfig x -> CardanoChainConfig
Generic)
  deriving anyclass ([CardanoChainConfig] -> Value
[CardanoChainConfig] -> Encoding
CardanoChainConfig -> Bool
CardanoChainConfig -> Value
CardanoChainConfig -> Encoding
(CardanoChainConfig -> Value)
-> (CardanoChainConfig -> Encoding)
-> ([CardanoChainConfig] -> Value)
-> ([CardanoChainConfig] -> Encoding)
-> (CardanoChainConfig -> Bool)
-> ToJSON CardanoChainConfig
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: CardanoChainConfig -> Value
toJSON :: CardanoChainConfig -> Value
$ctoEncoding :: CardanoChainConfig -> Encoding
toEncoding :: CardanoChainConfig -> Encoding
$ctoJSONList :: [CardanoChainConfig] -> Value
toJSONList :: [CardanoChainConfig] -> Value
$ctoEncodingList :: [CardanoChainConfig] -> Encoding
toEncodingList :: [CardanoChainConfig] -> Encoding
$comitField :: CardanoChainConfig -> Bool
omitField :: CardanoChainConfig -> Bool
ToJSON, Maybe CardanoChainConfig
Value -> Parser [CardanoChainConfig]
Value -> Parser CardanoChainConfig
(Value -> Parser CardanoChainConfig)
-> (Value -> Parser [CardanoChainConfig])
-> Maybe CardanoChainConfig
-> FromJSON CardanoChainConfig
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser CardanoChainConfig
parseJSON :: Value -> Parser CardanoChainConfig
$cparseJSONList :: Value -> Parser [CardanoChainConfig]
parseJSONList :: Value -> Parser [CardanoChainConfig]
$comittedField :: Maybe CardanoChainConfig
omittedField :: Maybe CardanoChainConfig
FromJSON)

defaultCardanoChainConfig :: CardanoChainConfig
defaultCardanoChainConfig :: CardanoChainConfig
defaultCardanoChainConfig =
  CardanoChainConfig
    { $sel:hydraScriptsTxId:CardanoChainConfig :: [TxId]
hydraScriptsTxId = []
    , $sel:cardanoSigningKey:CardanoChainConfig :: String
cardanoSigningKey = String
"cardano.sk"
    , $sel:cardanoVerificationKeys:CardanoChainConfig :: [String]
cardanoVerificationKeys = []
    , $sel:startChainFrom:CardanoChainConfig :: Maybe ChainPoint
startChainFrom = Maybe ChainPoint
forall a. Maybe a
Nothing
    , $sel:contestationPeriod:CardanoChainConfig :: ContestationPeriod
contestationPeriod = ContestationPeriod
defaultContestationPeriod
    , $sel:depositPeriod:CardanoChainConfig :: DepositPeriod
depositPeriod = DepositPeriod
defaultDepositPeriod
    , $sel:depositActivation:CardanoChainConfig :: DepositPeriod
depositActivation = DepositPeriod
defaultDepositActivation
    , $sel:unsyncedPeriod:CardanoChainConfig :: UnsyncedPeriod
unsyncedPeriod = UnsyncedPeriod
defaultUnsyncedPeriod
    , $sel:chainBackendOptions:CardanoChainConfig :: ChainBackendOptions
chainBackendOptions = DirectOptions -> ChainBackendOptions
Direct DirectOptions
defaultDirectOptions
    }

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

offlineHeadSeedParser :: Parser HeadSeed
offlineHeadSeedParser :: Parser HeadSeed
offlineHeadSeedParser =
  ReadM HeadSeed -> Mod OptionFields HeadSeed -> Parser HeadSeed
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ((String -> Either String HeadSeed) -> ReadM HeadSeed
forall a. (String -> Either String a) -> ReadM a
eitherReader ((String -> Either String HeadSeed) -> ReadM HeadSeed)
-> (String -> Either String HeadSeed) -> ReadM HeadSeed
forall a b. (a -> b) -> a -> b
$ (RawBytesHexError -> String)
-> Either RawBytesHexError HeadSeed -> Either String HeadSeed
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 -> String
forall b a. (Show a, IsString b) => a -> b
show (Either RawBytesHexError HeadSeed -> Either String HeadSeed)
-> (String -> Either RawBytesHexError HeadSeed)
-> String
-> Either String HeadSeed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either RawBytesHexError HeadSeed
forall a.
SerialiseAsRawBytes a =>
ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex (ByteString -> Either RawBytesHexError HeadSeed)
-> (String -> ByteString)
-> String
-> Either RawBytesHexError HeadSeed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BSC.pack)
    ( String -> Mod OptionFields HeadSeed
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"offline-head-seed"
        Mod OptionFields HeadSeed
-> Mod OptionFields HeadSeed -> Mod OptionFields HeadSeed
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields HeadSeed
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"HEX"
        Mod OptionFields HeadSeed
-> Mod OptionFields HeadSeed -> Mod OptionFields HeadSeed
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields HeadSeed
forall (f :: * -> *) a. String -> Mod f a
help String
"Offline mode: Hexadecimal seed bytes to derive the offline head id from. Needs to be consistent across the hydra-node instances."
    )

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

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

cardanoChainConfigParser :: Parser CardanoChainConfig
cardanoChainConfigParser :: Parser CardanoChainConfig
cardanoChainConfigParser =
  [TxId]
-> String
-> [String]
-> Maybe ChainPoint
-> ContestationPeriod
-> DepositPeriod
-> DepositPeriod
-> Maybe UnsyncedPeriod
-> ChainBackendOptions
-> CardanoChainConfig
mkCardanoChainConfig
    ([TxId]
 -> String
 -> [String]
 -> Maybe ChainPoint
 -> ContestationPeriod
 -> DepositPeriod
 -> DepositPeriod
 -> Maybe UnsyncedPeriod
 -> ChainBackendOptions
 -> CardanoChainConfig)
-> Parser [TxId]
-> Parser
     (String
      -> [String]
      -> Maybe ChainPoint
      -> ContestationPeriod
      -> DepositPeriod
      -> DepositPeriod
      -> Maybe UnsyncedPeriod
      -> ChainBackendOptions
      -> CardanoChainConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Parser [TxId]
hydraScriptsTxIdsParser Parser [TxId] -> Parser [TxId] -> Parser [TxId]
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TxId -> Parser [TxId]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser TxId
hydraScriptsTxIdParser) Parser [TxId] -> Parser [TxId] -> Parser [TxId]
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [TxId]
hydraScriptsDefaultParser)
    Parser
  (String
   -> [String]
   -> Maybe ChainPoint
   -> ContestationPeriod
   -> DepositPeriod
   -> DepositPeriod
   -> Maybe UnsyncedPeriod
   -> ChainBackendOptions
   -> CardanoChainConfig)
-> Parser String
-> Parser
     ([String]
      -> Maybe ChainPoint
      -> ContestationPeriod
      -> DepositPeriod
      -> DepositPeriod
      -> Maybe UnsyncedPeriod
      -> ChainBackendOptions
      -> CardanoChainConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String
cardanoSigningKeyFileParser
    Parser
  ([String]
   -> Maybe ChainPoint
   -> ContestationPeriod
   -> DepositPeriod
   -> DepositPeriod
   -> Maybe UnsyncedPeriod
   -> ChainBackendOptions
   -> CardanoChainConfig)
-> Parser [String]
-> Parser
     (Maybe ChainPoint
      -> ContestationPeriod
      -> DepositPeriod
      -> DepositPeriod
      -> Maybe UnsyncedPeriod
      -> ChainBackendOptions
      -> CardanoChainConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser [String]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser String
cardanoVerificationKeyFileParser
    Parser
  (Maybe ChainPoint
   -> ContestationPeriod
   -> DepositPeriod
   -> DepositPeriod
   -> Maybe UnsyncedPeriod
   -> ChainBackendOptions
   -> CardanoChainConfig)
-> Parser (Maybe ChainPoint)
-> Parser
     (ContestationPeriod
      -> DepositPeriod
      -> DepositPeriod
      -> Maybe UnsyncedPeriod
      -> ChainBackendOptions
      -> CardanoChainConfig)
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
   -> DepositPeriod
   -> DepositPeriod
   -> Maybe UnsyncedPeriod
   -> ChainBackendOptions
   -> CardanoChainConfig)
-> Parser ContestationPeriod
-> Parser
     (DepositPeriod
      -> DepositPeriod
      -> Maybe UnsyncedPeriod
      -> ChainBackendOptions
      -> CardanoChainConfig)
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
    Parser
  (DepositPeriod
   -> DepositPeriod
   -> Maybe UnsyncedPeriod
   -> ChainBackendOptions
   -> CardanoChainConfig)
-> Parser DepositPeriod
-> Parser
     (DepositPeriod
      -> Maybe UnsyncedPeriod
      -> ChainBackendOptions
      -> CardanoChainConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DepositPeriod
depositPeriodParser
    Parser
  (DepositPeriod
   -> Maybe UnsyncedPeriod
   -> ChainBackendOptions
   -> CardanoChainConfig)
-> Parser DepositPeriod
-> Parser
     (Maybe UnsyncedPeriod -> ChainBackendOptions -> CardanoChainConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DepositPeriod
depositActivationParser
    Parser
  (Maybe UnsyncedPeriod -> ChainBackendOptions -> CardanoChainConfig)
-> Parser (Maybe UnsyncedPeriod)
-> Parser (ChainBackendOptions -> CardanoChainConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser UnsyncedPeriod -> Parser (Maybe UnsyncedPeriod)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser UnsyncedPeriod
unsyncedPeriodParser
    Parser (ChainBackendOptions -> CardanoChainConfig)
-> Parser ChainBackendOptions -> Parser CardanoChainConfig
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ChainBackendOptions
chainBackendOptionsParser
 where
  mkCardanoChainConfig :: [TxId]
-> String
-> [String]
-> Maybe ChainPoint
-> ContestationPeriod
-> DepositPeriod
-> DepositPeriod
-> Maybe UnsyncedPeriod
-> ChainBackendOptions
-> CardanoChainConfig
mkCardanoChainConfig [TxId]
hydraScriptsTxId String
cardanoSigningKey [String]
cardanoVerificationKeys Maybe ChainPoint
startChainFrom ContestationPeriod
contestationPeriod DepositPeriod
depositPeriod DepositPeriod
depositActivation Maybe UnsyncedPeriod
maybeUnsyncedPeriod ChainBackendOptions
chainBackendOptions =
    CardanoChainConfig
      { [TxId]
$sel:hydraScriptsTxId:CardanoChainConfig :: [TxId]
hydraScriptsTxId :: [TxId]
hydraScriptsTxId
      , String
$sel:cardanoSigningKey:CardanoChainConfig :: String
cardanoSigningKey :: String
cardanoSigningKey
      , [String]
$sel:cardanoVerificationKeys:CardanoChainConfig :: [String]
cardanoVerificationKeys :: [String]
cardanoVerificationKeys
      , Maybe ChainPoint
$sel:startChainFrom:CardanoChainConfig :: Maybe ChainPoint
startChainFrom :: Maybe ChainPoint
startChainFrom
      , ContestationPeriod
$sel:contestationPeriod:CardanoChainConfig :: ContestationPeriod
contestationPeriod :: ContestationPeriod
contestationPeriod
      , DepositPeriod
$sel:depositPeriod:CardanoChainConfig :: DepositPeriod
depositPeriod :: DepositPeriod
depositPeriod
      , DepositPeriod
$sel:depositActivation:CardanoChainConfig :: DepositPeriod
depositActivation :: DepositPeriod
depositActivation
      , $sel:unsyncedPeriod:CardanoChainConfig :: UnsyncedPeriod
unsyncedPeriod = UnsyncedPeriod -> Maybe UnsyncedPeriod -> UnsyncedPeriod
forall a. a -> Maybe a -> a
fromMaybe (ContestationPeriod -> UnsyncedPeriod
defaultUnsyncedPeriodFor ContestationPeriod
contestationPeriod) Maybe UnsyncedPeriod
maybeUnsyncedPeriod
      , ChainBackendOptions
$sel:chainBackendOptions:CardanoChainConfig :: ChainBackendOptions
chainBackendOptions :: ChainBackendOptions
chainBackendOptions
      }

blockfrostProjectPathParser :: Parser FilePath
blockfrostProjectPathParser :: Parser String
blockfrostProjectPathParser =
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"blockfrost"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILE"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
"blockfrost.txt"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help
          String
"Blockfrost project path containing the api key."
    )

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
      ( String -> Mod FlagFields NetworkId
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"mainnet"
          Mod FlagFields NetworkId
-> Mod FlagFields NetworkId -> Mod FlagFields NetworkId
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields NetworkId
forall (f :: * -> *) a. String -> Mod f a
help String
"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
        ( String -> Mod OptionFields Word32
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"testnet-magic"
            Mod OptionFields Word32
-> Mod OptionFields Word32 -> Mod OptionFields Word32
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word32
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"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 ([String] -> Completer
listCompleter [String
"1", String
"2", String
"42"])
            Mod OptionFields Word32
-> Mod OptionFields Word32 -> Mod OptionFields Word32
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word32
forall (f :: * -> *) a. String -> Mod f a
help
              String
"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
    ( String -> Mod OptionFields SocketPath
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"node-socket"
        Mod OptionFields SocketPath
-> Mod OptionFields SocketPath -> Mod OptionFields SocketPath
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields SocketPath
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"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 DirectOptions
defaultDirectOptions.nodeSocket
        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
<> String -> Mod OptionFields SocketPath
forall (f :: * -> *) a. String -> Mod f a
help
          String
"Filepath to local unix domain socket used to communicate with \
          \the cardano node."
    )

cardanoSigningKeyFileParser :: Parser FilePath
cardanoSigningKeyFileParser :: Parser String
cardanoSigningKeyFileParser =
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"cardano-signing-key"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILE"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value CardanoChainConfig
defaultCardanoChainConfig.cardanoSigningKey
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help
          String
"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 String
cardanoVerificationKeyFileParser =
  ReadM String -> Mod OptionFields String -> Parser String
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ReadM String
forall s. IsString s => ReadM s
str
    ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"cardano-verification-key"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILE"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help
          ( String
"Cardano verification key of another party in the Head. Can be \
            \provided multiple times, once for each participant (current maximum limit is "
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall b a. (Show a, IsString b) => a -> b
show Int
maximumNumberOfParties
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")."
          )
    )

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

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

peerParser :: Parser Host
peerParser :: Parser Host
peerParser =
  ReadM Host -> Mod OptionFields Host -> Parser Host
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ((String -> Maybe Host) -> ReadM Host
forall a. (String -> Maybe a) -> ReadM a
maybeReader String -> Maybe Host
forall (m :: * -> *). MonadFail m => String -> m Host
readHost)
    ( String -> Mod OptionFields Host
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"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
<> String -> Mod OptionFields Host
forall (f :: * -> *) a. String -> Mod f a
help
          ( String
"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. Heads currently support at most "
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall b a. (Show a, IsString b) => a -> b
show Int
maximumNumberOfParties
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" parties; mirror nodes may also connect as 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
    ( String -> Mod OptionFields NodeId
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"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
<> String -> Mod OptionFields NodeId
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"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
<> String -> Mod OptionFields NodeId
forall (f :: * -> *) a. String -> Mod f a
help
          String
"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
    ( String -> Mod FlagFields Verbosity
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"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
<> String -> Mod FlagFields Verbosity
forall (f :: * -> *) a. String -> Mod f a
help String
"Turns off logging."
    )

listenParser :: Parser Host
listenParser :: Parser Host
listenParser =
  ReadM Host -> Mod OptionFields Host -> Parser Host
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ReadM Host
forall a. Read a => ReadM a
auto
    ( String -> Mod OptionFields Host
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"listen"
        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
'l'
        Mod OptionFields Host
-> Mod OptionFields Host -> Mod OptionFields Host
forall a. Semigroup a => a -> a -> a
<> Host -> Mod OptionFields Host
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (Text -> PortNumber -> Host
Host Text
"0.0.0.0" PortNumber
5001)
        Mod OptionFields Host
-> Mod OptionFields Host -> Mod OptionFields Host
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Host
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields Host
-> Mod OptionFields Host -> Mod OptionFields Host
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Host
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"HOST:PORT"
        Mod OptionFields Host
-> Mod OptionFields Host -> Mod OptionFields Host
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Host
forall (f :: * -> *) a. String -> Mod f a
help String
"Address and port to listen for Hydra network connections. If --advertise is not set, this will be also advertised to other peers on the network."
    )

advertiseParser :: Parser Host
advertiseParser :: Parser Host
advertiseParser =
  ReadM Host -> Mod OptionFields Host -> Parser Host
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ReadM Host
forall a. Read a => ReadM a
auto
    ( String -> Mod OptionFields Host
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"advertise"
        Mod OptionFields Host
-> Mod OptionFields Host -> Mod OptionFields Host
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Host
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"HOST:PORT"
        Mod OptionFields Host
-> Mod OptionFields Host -> Mod OptionFields Host
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Host
forall (f :: * -> *) a. String -> Mod f a
help String
"Address and port to advertise as public endpoint to other peers on the Hydra network. If this is not set, the --listen address is used."
    )

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
    ( String -> Mod OptionFields IP
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"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
<> String -> Mod OptionFields IP
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"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
<> String -> Mod OptionFields IP
forall (f :: * -> *) a. String -> Mod f a
help String
"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
    ((String -> Maybe PortNumber) -> ReadM PortNumber
forall a. (String -> Maybe a) -> ReadM a
maybeReader String -> Maybe PortNumber
forall (m :: * -> *). MonadFail m => String -> m PortNumber
readPort)
    ( String -> Mod OptionFields PortNumber
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"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
<> String -> Mod OptionFields PortNumber
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PORT"
        Mod OptionFields PortNumber
-> Mod OptionFields PortNumber -> Mod OptionFields PortNumber
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PortNumber
forall (f :: * -> *) a. String -> Mod f a
help String
"Listen port for incoming client API connections."
    )

tlsCertPathParser :: Parser FilePath
tlsCertPathParser :: Parser String
tlsCertPathParser =
  ReadM String -> Mod OptionFields String -> Parser String
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ReadM String
forall s. IsString s => ReadM s
str
    ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"tls-cert"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILE"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help
          String
"Path to the TLS certificate (chain). If this and --tls-key are \
          \set, the API server will expect TLS connections (WSS/HTTPS)."
    )

tlsKeyPathParser :: Parser FilePath
tlsKeyPathParser :: Parser String
tlsKeyPathParser =
  ReadM String -> Mod OptionFields String -> Parser String
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ReadM String
forall s. IsString s => ReadM s
str
    ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"tls-key"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILE"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help
          String
"Path to the TLS key. If this and --tls-cert are \
          \set, the API server will expect TLS connections (WSS/HTTPS)."
    )

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

defaultApiTransactionTimeout :: ApiTransactionTimeout
defaultApiTransactionTimeout :: ApiTransactionTimeout
defaultApiTransactionTimeout = NominalDiffTime -> ApiTransactionTimeout
ApiTransactionTimeout NominalDiffTime
300

apiTransactionTimeoutParser :: Parser ApiTransactionTimeout
apiTransactionTimeoutParser :: Parser ApiTransactionTimeout
apiTransactionTimeoutParser =
  ReadM ApiTransactionTimeout
-> Mod OptionFields ApiTransactionTimeout
-> Parser ApiTransactionTimeout
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    (NominalDiffTime -> ApiTransactionTimeout
ApiTransactionTimeout (NominalDiffTime -> ApiTransactionTimeout)
-> ReadM NominalDiffTime -> ReadM ApiTransactionTimeout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM NominalDiffTime
forall a. Read a => ReadM a
auto)
    ( String -> Mod OptionFields ApiTransactionTimeout
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"api-transaction-timeout"
        Mod OptionFields ApiTransactionTimeout
-> Mod OptionFields ApiTransactionTimeout
-> Mod OptionFields ApiTransactionTimeout
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ApiTransactionTimeout
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SECONDS"
        Mod OptionFields ApiTransactionTimeout
-> Mod OptionFields ApiTransactionTimeout
-> Mod OptionFields ApiTransactionTimeout
forall a. Semigroup a => a -> a -> a
<> ApiTransactionTimeout -> Mod OptionFields ApiTransactionTimeout
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value ApiTransactionTimeout
defaultApiTransactionTimeout
        Mod OptionFields ApiTransactionTimeout
-> Mod OptionFields ApiTransactionTimeout
-> Mod OptionFields ApiTransactionTimeout
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields ApiTransactionTimeout
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields ApiTransactionTimeout
-> Mod OptionFields ApiTransactionTimeout
-> Mod OptionFields ApiTransactionTimeout
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields ApiTransactionTimeout
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer ([String] -> Completer
listCompleter [String
"3600", String
"7200", String
"43200"])
        Mod OptionFields ApiTransactionTimeout
-> Mod OptionFields ApiTransactionTimeout
-> Mod OptionFields ApiTransactionTimeout
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ApiTransactionTimeout
forall (f :: * -> *) a. String -> Mod f a
help
          String
"Timeout for API transactions in seconds. If a transaction \
          \takes longer than this, it will be cancelled."
    )

startChainFromParser :: Parser ChainPoint
startChainFromParser :: Parser ChainPoint
startChainFromParser =
  ReadM ChainPoint
-> Mod OptionFields ChainPoint -> Parser ChainPoint
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ((String -> Maybe ChainPoint) -> ReadM ChainPoint
forall a. (String -> Maybe a) -> ReadM a
maybeReader String -> Maybe ChainPoint
readChainPoint)
    ( String -> Mod OptionFields ChainPoint
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"start-chain-from"
        Mod OptionFields ChainPoint
-> Mod OptionFields ChainPoint -> Mod OptionFields ChainPoint
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ChainPoint
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SLOT.HEADER_HASH"
        Mod OptionFields ChainPoint
-> Mod OptionFields ChainPoint -> Mod OptionFields ChainPoint
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ChainPoint
forall (f :: * -> *) a. String -> Mod f a
help
          String
"The id of the block we want to start observing the chain from. Only \
          \used if the last known head state is older than given point. If not \
          \given and no known head state, the chain tip is used. Composed by the \
          \slot number, a separator ('.') and the hash of the block header. For \
          \example: \
          \52970883.d36a9936ae7a07f5f4bdc9ad0b23761cb7b14f35007e54947e27a1510f897f04."
    )
 where
  readChainPoint :: String -> Maybe ChainPoint
  readChainPoint :: String -> Maybe ChainPoint
readChainPoint = \case
    String
"0" -> ChainPoint -> Maybe ChainPoint
forall a. a -> Maybe a
Just ChainPoint
ChainPointAtGenesis
    String
chainPointStr ->
      case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"." (String -> Text
forall a. ToText a => a -> Text
toText String
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
<$> String -> Maybe Word64
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
forall a. ToString a => a -> String
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
$
              ByteString -> Either RawBytesHexError (Hash BlockHeader)
forall a.
SerialiseAsRawBytes a =>
ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex (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

hydraScriptsTxIdsParser :: Parser [TxId]
hydraScriptsTxIdsParser :: Parser [TxId]
hydraScriptsTxIdsParser =
  ReadM [TxId] -> Mod OptionFields [TxId] -> Parser [TxId]
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ((String -> Either String [TxId]) -> ReadM [TxId]
forall a. (String -> Either String a) -> ReadM a
eitherReader ((String -> Either String [TxId]) -> ReadM [TxId])
-> (String -> Either String [TxId]) -> ReadM [TxId]
forall a b. (a -> b) -> a -> b
$ (RawBytesHexError -> String)
-> Either RawBytesHexError [TxId] -> Either String [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 -> String
forall b a. (Show a, IsString b) => a -> b
show (Either RawBytesHexError [TxId] -> Either String [TxId])
-> (String -> Either RawBytesHexError [TxId])
-> String
-> Either String [TxId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Either RawBytesHexError [TxId]
parseFromHex ([ByteString] -> Either RawBytesHexError [TxId])
-> (String -> [ByteString])
-> String
-> Either RawBytesHexError [TxId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> [ByteString]
BSC.split Char
',' (ByteString -> [ByteString])
-> (String -> ByteString) -> String -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BSC.pack)
    ( String -> Mod OptionFields [TxId]
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"hydra-scripts-tx-id"
        Mod OptionFields [TxId]
-> Mod OptionFields [TxId] -> Mod OptionFields [TxId]
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields [TxId]
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"TXID"
        Mod OptionFields [TxId]
-> Mod OptionFields [TxId] -> Mod OptionFields [TxId]
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields [TxId]
forall (f :: * -> *) a. String -> Mod f a
help
          String
"The transactions which are expected to have published Hydra scripts as \
          \reference scripts in their outputs. You can use the 'publish-scripts' \
          \sub-command to publish scripts yourself."
    )
 where
  parseFromHex :: [ByteString] -> Either RawBytesHexError [TxId]
parseFromHex = (ByteString -> Either RawBytesHexError TxId)
-> [ByteString] -> Either RawBytesHexError [TxId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ByteString -> Either RawBytesHexError TxId
forall a.
SerialiseAsRawBytes a =>
ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex

hydraScriptsTxIdParser :: Parser TxId
hydraScriptsTxIdParser :: Parser TxId
hydraScriptsTxIdParser =
  ReadM TxId -> Mod OptionFields TxId -> Parser TxId
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ((String -> Either String TxId) -> ReadM TxId
forall a. (String -> Either String a) -> ReadM a
eitherReader ((String -> Either String TxId) -> ReadM TxId)
-> (String -> Either String TxId) -> ReadM TxId
forall a b. (a -> b) -> a -> b
$ (RawBytesHexError -> String)
-> Either RawBytesHexError TxId -> Either String 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 -> String
forall b a. (Show a, IsString b) => a -> b
show (Either RawBytesHexError TxId -> Either String TxId)
-> (String -> Either RawBytesHexError TxId)
-> String
-> Either String TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either RawBytesHexError TxId
forall a.
SerialiseAsRawBytes a =>
ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex (ByteString -> Either RawBytesHexError TxId)
-> (String -> ByteString) -> String -> Either RawBytesHexError TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BSC.pack)
    ( String -> Mod OptionFields TxId
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"hydra-scripts-tx-id"
        Mod OptionFields TxId
-> Mod OptionFields TxId -> Mod OptionFields TxId
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields TxId
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"TXID"
        Mod OptionFields TxId
-> Mod OptionFields TxId -> Mod OptionFields TxId
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields TxId
forall (f :: * -> *) a. String -> Mod f a
help
          String
"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."
    )

hydraScriptsDefaultParser :: Parser [TxId]
hydraScriptsDefaultParser :: Parser [TxId]
hydraScriptsDefaultParser =
  ReadM [TxId] -> Mod OptionFields [TxId] -> Parser [TxId]
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ((String -> Either String [TxId]) -> ReadM [TxId]
forall a. (String -> Either String a) -> ReadM a
eitherReader String -> Either String [TxId]
validateNetwork)
    ( String -> Mod OptionFields [TxId]
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"network"
        Mod OptionFields [TxId]
-> Mod OptionFields [TxId] -> Mod OptionFields [TxId]
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields [TxId]
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NETWORK"
        Mod OptionFields [TxId]
-> Mod OptionFields [TxId] -> Mod OptionFields [TxId]
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields [TxId]
forall (f :: * -> *) a. String -> Mod f a
help String
"Uses the last pre-published hydra scripts for the given network."
    )
 where
  validateNetwork :: String -> Either String [TxId]
validateNetwork String
arg =
    case String
arg of
      String
"preview" -> Version -> String -> Either String [TxId]
forall (m :: * -> *). MonadFail m => Version -> String -> m [TxId]
parseNetworkTxIds Version
hydraNodeVersion String
arg
      String
"preprod" -> Version -> String -> Either String [TxId]
forall (m :: * -> *). MonadFail m => Version -> String -> m [TxId]
parseNetworkTxIds Version
hydraNodeVersion String
arg
      String
"mainnet" -> Version -> String -> Either String [TxId]
forall (m :: * -> *). MonadFail m => Version -> String -> m [TxId]
parseNetworkTxIds Version
hydraNodeVersion String
arg
      String
_ -> String -> Either String [TxId]
forall a b. a -> Either a b
Left (String -> Either String [TxId]) -> String -> Either String [TxId]
forall a b. (a -> b) -> a -> b
$ String
"Unknown network: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
arg

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

persistenceRotateAfterParser :: Parser (Positive Natural)
persistenceRotateAfterParser :: Parser (Positive Natural)
persistenceRotateAfterParser =
  ReadM (Positive Natural)
-> Mod OptionFields (Positive Natural) -> Parser (Positive Natural)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ((String -> Either String (Positive Natural))
-> ReadM (Positive Natural)
forall a. (String -> Either String a) -> ReadM a
eitherReader String -> Either String (Positive Natural)
validateRotateAfter)
    ( String -> Mod OptionFields (Positive Natural)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"persistence-rotate-after"
        Mod OptionFields (Positive Natural)
-> Mod OptionFields (Positive Natural)
-> Mod OptionFields (Positive Natural)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Positive Natural)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NATURAL"
        Mod OptionFields (Positive Natural)
-> Mod OptionFields (Positive Natural)
-> Mod OptionFields (Positive Natural)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Positive Natural)
forall (f :: * -> *) a. String -> Mod f a
help
          String
"The number of Hydra events to trigger rotation (default: no rotation).\
          \Note it must be a positive number."
    )
 where
  validateRotateAfter :: String -> Either String (Positive Natural)
  validateRotateAfter :: String -> Either String (Positive Natural)
validateRotateAfter String
arg =
    case String -> Maybe Natural
forall a. Read a => String -> Maybe a
readMaybe String
arg of
      Just Natural
n | Natural
n Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
0 -> Positive Natural -> Either String (Positive Natural)
forall a b. b -> Either a b
Right (Natural -> Positive Natural
forall a. a -> Positive a
Positive Natural
n)
      Maybe Natural
_ -> String -> Either String (Positive Natural)
forall a b. a -> Either a b
Left String
"--persistence-rotate-after must be a positive number"

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)
hydraScriptCatalogue
        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
<> String -> InfoMod Command
forall a. String -> InfoMod a
progDesc String
"Starts a Hydra Node"
        InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod Command
forall a. String -> InfoMod a
header String
"hydra-node - Implementation of the Hydra Head protocol"
    )
 where
  versionInfo :: Parser (a -> a)
  versionInfo :: forall a. Parser (a -> a)
versionInfo =
    String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption
      (Version -> String
showVersion Version
hydraNodeVersion)
      (String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"version" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
help String
"Show version")

  hydraScriptCatalogue :: Parser (a -> a)
  hydraScriptCatalogue :: forall a. Parser (a -> a)
hydraScriptCatalogue =
    String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption
      (ByteString -> String
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ HydraScriptCatalogue -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty HydraScriptCatalogue
Contract.hydraScriptCatalogue)
      (String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"hydra-script-catalogue" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
help String
"Dump Hydra script catalogue as JSON")

-- | Default contestation period of 12 hours, aligned with Cardano's safe zone
-- on mainnet. The safe zone is approximately 3 * k / f where k = 2160 (security
-- parameter) and f = 0.05 (active slot coefficient), ensuring finality guarantees.
-- See: https://github.com/cardano-scaling/hydra/issues/2389
defaultContestationPeriod :: ContestationPeriod
defaultContestationPeriod :: ContestationPeriod
defaultContestationPeriod = ContestationPeriod
43200 -- 12 hours in seconds

-- | Default unsynced period, computed as half of the default contestation period.
defaultUnsyncedPeriod :: UnsyncedPeriod
defaultUnsyncedPeriod :: UnsyncedPeriod
defaultUnsyncedPeriod = ContestationPeriod -> UnsyncedPeriod
defaultUnsyncedPeriodFor ContestationPeriod
defaultContestationPeriod

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 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)
    ( String -> Mod OptionFields ContestationPeriod
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"contestation-period"
        Mod OptionFields ContestationPeriod
-> Mod OptionFields ContestationPeriod
-> Mod OptionFields ContestationPeriod
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ContestationPeriod
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"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 ([String] -> Completer
listCompleter [String
"3600", String
"43200", String
"86400"])
        Mod OptionFields ContestationPeriod
-> Mod OptionFields ContestationPeriod
-> Mod OptionFields ContestationPeriod
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ContestationPeriod
forall (f :: * -> *) a. String -> Mod f a
help
          String
"Contestation period for close transaction in seconds. \
          \ If this value is not in sync with other participants hydra-node will ignore the initial tx.\
          \ WARNING: On mainnet, this value should be at least 12 hours (43200s) to ensure safety\
          \ against long chain forks. Shorter periods may not provide sufficient time for dispute\
          \ resolution. See https://github.com/cardano-scaling/hydra/issues/2389 for details."
    )

defaultDepositPeriod :: DepositPeriod
defaultDepositPeriod :: DepositPeriod
defaultDepositPeriod = NominalDiffTime -> DepositPeriod
DepositPeriod NominalDiffTime
3600

depositPeriodParser :: Parser DepositPeriod
depositPeriodParser :: Parser DepositPeriod
depositPeriodParser =
  ReadM DepositPeriod
-> Mod OptionFields DepositPeriod -> Parser DepositPeriod
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    (NominalDiffTime -> DepositPeriod
DepositPeriod (NominalDiffTime -> DepositPeriod)
-> ReadM NominalDiffTime -> ReadM DepositPeriod
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM NominalDiffTime
forall a. Read a => ReadM a
auto)
    ( String -> Mod OptionFields DepositPeriod
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"deposit-period"
        Mod OptionFields DepositPeriod
-> Mod OptionFields DepositPeriod -> Mod OptionFields DepositPeriod
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields DepositPeriod
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SECONDS"
        Mod OptionFields DepositPeriod
-> Mod OptionFields DepositPeriod -> Mod OptionFields DepositPeriod
forall a. Semigroup a => a -> a -> a
<> DepositPeriod -> Mod OptionFields DepositPeriod
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value DepositPeriod
defaultDepositPeriod
        Mod OptionFields DepositPeriod
-> Mod OptionFields DepositPeriod -> Mod OptionFields DepositPeriod
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields DepositPeriod
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields DepositPeriod
-> Mod OptionFields DepositPeriod -> Mod OptionFields DepositPeriod
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields DepositPeriod
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer ([String] -> Completer
listCompleter [String
"3600", String
"7200", String
"43200"])
        Mod OptionFields DepositPeriod
-> Mod OptionFields DepositPeriod -> Mod OptionFields DepositPeriod
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields DepositPeriod
forall (f :: * -> *) a. String -> Mod f a
help
          String
"Minimum time before deadline to consider deposits. Together with \
          \deposit-activation this sets the deadline on any drafted deposit \
          \transactions to now + deposit-activation + 2 x deposit-period."
    )

defaultDepositActivation :: DepositPeriod
defaultDepositActivation :: DepositPeriod
defaultDepositActivation = NominalDiffTime -> DepositPeriod
DepositPeriod NominalDiffTime
3600

depositActivationParser :: Parser DepositPeriod
depositActivationParser :: Parser DepositPeriod
depositActivationParser =
  ReadM DepositPeriod
-> Mod OptionFields DepositPeriod -> Parser DepositPeriod
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    (NominalDiffTime -> DepositPeriod
DepositPeriod (NominalDiffTime -> DepositPeriod)
-> ReadM NominalDiffTime -> ReadM DepositPeriod
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM NominalDiffTime
forall a. Read a => ReadM a
auto)
    ( String -> Mod OptionFields DepositPeriod
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"deposit-activation"
        Mod OptionFields DepositPeriod
-> Mod OptionFields DepositPeriod -> Mod OptionFields DepositPeriod
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields DepositPeriod
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SECONDS"
        Mod OptionFields DepositPeriod
-> Mod OptionFields DepositPeriod -> Mod OptionFields DepositPeriod
forall a. Semigroup a => a -> a -> a
<> DepositPeriod -> Mod OptionFields DepositPeriod
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value DepositPeriod
defaultDepositActivation
        Mod OptionFields DepositPeriod
-> Mod OptionFields DepositPeriod -> Mod OptionFields DepositPeriod
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields DepositPeriod
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields DepositPeriod
-> Mod OptionFields DepositPeriod -> Mod OptionFields DepositPeriod
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields DepositPeriod
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer ([String] -> Completer
listCompleter [String
"3600", String
"7200", String
"43200"])
        Mod OptionFields DepositPeriod
-> Mod OptionFields DepositPeriod -> Mod OptionFields DepositPeriod
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields DepositPeriod
forall (f :: * -> *) a. String -> Mod f a
help
          String
"Time a deposit must mature before it is considered active and can be \
          \incremented. Controls only the Inactive -> Active transition, \
          \independently of deposit-period."
    )

unsyncedPeriodParser :: Parser UnsyncedPeriod
unsyncedPeriodParser :: Parser UnsyncedPeriod
unsyncedPeriodParser =
  ReadM UnsyncedPeriod
-> Mod OptionFields UnsyncedPeriod -> Parser UnsyncedPeriod
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    (NominalDiffTime -> UnsyncedPeriod
UnsyncedPeriod (NominalDiffTime -> UnsyncedPeriod)
-> ReadM NominalDiffTime -> ReadM UnsyncedPeriod
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM NominalDiffTime
forall a. Read a => ReadM a
auto)
    ( String -> Mod OptionFields UnsyncedPeriod
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"unsynced-period"
        Mod OptionFields UnsyncedPeriod
-> Mod OptionFields UnsyncedPeriod
-> Mod OptionFields UnsyncedPeriod
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields UnsyncedPeriod
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SECONDS"
        Mod OptionFields UnsyncedPeriod
-> Mod OptionFields UnsyncedPeriod
-> Mod OptionFields UnsyncedPeriod
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields UnsyncedPeriod
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer ([String] -> Completer
listCompleter [String
"1800", String
"3600", String
"21600"])
        Mod OptionFields UnsyncedPeriod
-> Mod OptionFields UnsyncedPeriod
-> Mod OptionFields UnsyncedPeriod
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields UnsyncedPeriod
forall (f :: * -> *) a. String -> Mod f a
help
          String
"Period of time after which we consider the node becoming unsynced \
          \with the chain. Beyond this period the node will refuse to process \
          \new transactions and signing snapshots. If not provided, defaults to \
          \half of the contestation period."
    )

data InvalidOptions
  = MaximumNumberOfPartiesExceeded
  | CardanoAndHydraKeysMismatch
  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 -> String
(Int -> InvalidOptions -> ShowS)
-> (InvalidOptions -> String)
-> ([InvalidOptions] -> ShowS)
-> Show InvalidOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidOptions -> ShowS
showsPrec :: Int -> InvalidOptions -> ShowS
$cshow :: InvalidOptions -> String
show :: InvalidOptions -> String
$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{[String]
$sel:hydraVerificationKeys:RunOptions :: RunOptions -> [String]
hydraVerificationKeys :: [String]
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 ()
    Cardano CardanoChainConfig{[String]
$sel:cardanoVerificationKeys:CardanoChainConfig :: CardanoChainConfig -> [String]
cardanoVerificationKeys :: [String]
cardanoVerificationKeys}
      | Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
hydraVerificationKeys) ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
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
      | [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
cardanoVerificationKeys Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
hydraVerificationKeys ->
          InvalidOptions -> Either InvalidOptions ()
forall a b. a -> Either a b
Left InvalidOptions
CardanoAndHydraKeysMismatch
      | Bool
otherwise -> () -> Either InvalidOptions ()
forall a b. b -> Either a b
Right ()

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

-- | Parse the given list of arguments, exiting on failure.
parseHydraCommandFromArgsWith :: [String] -> IO Command
parseHydraCommandFromArgsWith :: [String] -> IO Command
parseHydraCommandFromArgsWith = ParserResult Command -> IO Command
forall a. ParserResult a -> IO a
handleParseResult (ParserResult Command -> IO Command)
-> ([String] -> ParserResult Command) -> [String] -> IO Command
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> ParserResult Command
parseHydraCommandFromArgs

-- | Convert an 'Options' instance into the corresponding list of command-line arguments.
--
-- This is useful in situations where one wants to programmatically define 'Options', providing
-- some measure of type safety, without having to juggle with strings.
toArgs :: RunOptions -> [String]
toArgs :: RunOptions -> [String]
toArgs
  RunOptions
    { Verbosity
$sel:verbosity:RunOptions :: RunOptions -> Verbosity
verbosity :: Verbosity
verbosity
    , NodeId
$sel:nodeId:RunOptions :: RunOptions -> NodeId
nodeId :: NodeId
nodeId
    , Host
$sel:listen:RunOptions :: RunOptions -> Host
listen :: Host
listen
    , Maybe Host
$sel:advertise:RunOptions :: RunOptions -> Maybe Host
advertise :: Maybe Host
advertise
    , [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 String
$sel:tlsCertPath:RunOptions :: RunOptions -> Maybe String
tlsCertPath :: Maybe String
tlsCertPath
    , Maybe String
$sel:tlsKeyPath:RunOptions :: RunOptions -> Maybe String
tlsKeyPath :: Maybe String
tlsKeyPath
    , Maybe PortNumber
$sel:monitoringPort:RunOptions :: RunOptions -> Maybe PortNumber
monitoringPort :: Maybe PortNumber
monitoringPort
    , String
$sel:hydraSigningKey:RunOptions :: RunOptions -> String
hydraSigningKey :: String
hydraSigningKey
    , [String]
$sel:hydraVerificationKeys:RunOptions :: RunOptions -> [String]
hydraVerificationKeys :: [String]
hydraVerificationKeys
    , String
$sel:persistenceDir:RunOptions :: RunOptions -> String
persistenceDir :: String
persistenceDir
    , Maybe (Positive Natural)
$sel:persistenceRotateAfter:RunOptions :: RunOptions -> Maybe (Positive Natural)
persistenceRotateAfter :: Maybe (Positive Natural)
persistenceRotateAfter
    , ChainConfig
$sel:chainConfig:RunOptions :: RunOptions -> ChainConfig
chainConfig :: ChainConfig
chainConfig
    , LedgerConfig
$sel:ledgerConfig:RunOptions :: RunOptions -> LedgerConfig
ledgerConfig :: LedgerConfig
ledgerConfig
    , WhichEtcd
$sel:whichEtcd:RunOptions :: RunOptions -> WhichEtcd
whichEtcd :: WhichEtcd
whichEtcd
    , ApiTransactionTimeout
$sel:apiTransactionTimeout:RunOptions :: RunOptions -> ApiTransactionTimeout
apiTransactionTimeout :: ApiTransactionTimeout
apiTransactionTimeout
    } =
    Verbosity -> [String]
isVerbose Verbosity
verbosity
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--node-id", Text -> String
unpack Text
nId]
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--listen", Host -> String
showHost Host
listen]
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String] -> (Host -> [String]) -> Maybe Host -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Host
h -> [String
"--advertise", Host -> String
showHost Host
h]) Maybe Host
advertise
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--api-host", IP -> String
forall b a. (Show a, IsString b) => a -> b
show IP
apiHost]
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> PortNumber -> [String]
toArgApiPort PortNumber
apiPort
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> WhichEtcd -> [String]
toWhichEtcd WhichEtcd
whichEtcd
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String] -> (String -> [String]) -> Maybe String -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
cert -> [String
"--tls-cert", String
cert]) Maybe String
tlsCertPath
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String] -> (String -> [String]) -> Maybe String -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
key -> [String
"--tls-key", String
key]) Maybe String
tlsKeyPath
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--hydra-signing-key", String
hydraSigningKey]
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\String
vk -> [String
"--hydra-verification-key", String
vk]) [String]
hydraVerificationKeys
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> (Host -> [String]) -> [Host] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Host -> [String]
toArgPeer [Host]
peers
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
-> (PortNumber -> [String]) -> Maybe PortNumber -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\PortNumber
port -> [String
"--monitoring-port", PortNumber -> String
forall b a. (Show a, IsString b) => a -> b
show PortNumber
port]) Maybe PortNumber
monitoringPort
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--persistence-dir", String
persistenceDir]
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
-> (Positive Natural -> [String])
-> Maybe (Positive Natural)
-> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Positive Natural
rotateAfter -> [String
"--persistence-rotate-after", Positive Natural -> String
forall a. Show a => Positive a -> String
showPositive Positive Natural
rotateAfter]) Maybe (Positive Natural)
persistenceRotateAfter
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> ChainConfig -> [String]
argsChainConfig ChainConfig
chainConfig
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
argsLedgerConfig
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--api-transaction-timeout", ApiTransactionTimeout -> String
forall b a. (Show a, IsString b) => a -> b
show ApiTransactionTimeout
apiTransactionTimeout]
   where
    (NodeId Text
nId) = NodeId
nodeId

    toWhichEtcd :: WhichEtcd -> [String]
toWhichEtcd = \case
      WhichEtcd
SystemEtcd -> [String
"--use-system-etcd"]
      WhichEtcd
EmbeddedEtcd -> []

    isVerbose :: Verbosity -> [String]
isVerbose = \case
      Verbosity
Quiet -> [String
"--quiet"]
      Verbosity
_ -> []

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

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

    argsChainConfig :: ChainConfig -> [String]
argsChainConfig = \case
      Offline
        OfflineChainConfig
          { HeadSeed
$sel:offlineHeadSeed:OfflineChainConfig :: OfflineChainConfig -> HeadSeed
offlineHeadSeed :: HeadSeed
offlineHeadSeed
          , String
$sel:initialUTxOFile:OfflineChainConfig :: OfflineChainConfig -> String
initialUTxOFile :: String
initialUTxOFile
          , Maybe String
$sel:ledgerGenesisFile:OfflineChainConfig :: OfflineChainConfig -> Maybe String
ledgerGenesisFile :: Maybe String
ledgerGenesisFile
          } ->
          [String
"--offline-head-seed", Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ HeadSeed -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText HeadSeed
offlineHeadSeed]
            [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--initial-utxo", String
initialUTxOFile]
            [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> case Maybe String
ledgerGenesisFile of
              Just String
fp -> [String
"--ledger-genesis", String
fp]
              Maybe String
Nothing -> []
      Cardano
        CardanoChainConfig
          { [TxId]
$sel:hydraScriptsTxId:CardanoChainConfig :: CardanoChainConfig -> [TxId]
hydraScriptsTxId :: [TxId]
hydraScriptsTxId
          , String
$sel:cardanoSigningKey:CardanoChainConfig :: CardanoChainConfig -> String
cardanoSigningKey :: String
cardanoSigningKey
          , [String]
$sel:cardanoVerificationKeys:CardanoChainConfig :: CardanoChainConfig -> [String]
cardanoVerificationKeys :: [String]
cardanoVerificationKeys
          , Maybe ChainPoint
$sel:startChainFrom:CardanoChainConfig :: CardanoChainConfig -> Maybe ChainPoint
startChainFrom :: Maybe ChainPoint
startChainFrom
          , ContestationPeriod
$sel:contestationPeriod:CardanoChainConfig :: CardanoChainConfig -> ContestationPeriod
contestationPeriod :: ContestationPeriod
contestationPeriod
          , DepositPeriod
$sel:depositPeriod:CardanoChainConfig :: CardanoChainConfig -> DepositPeriod
depositPeriod :: DepositPeriod
depositPeriod
          , DepositPeriod
$sel:depositActivation:CardanoChainConfig :: CardanoChainConfig -> DepositPeriod
depositActivation :: DepositPeriod
depositActivation
          , UnsyncedPeriod
$sel:unsyncedPeriod:CardanoChainConfig :: CardanoChainConfig -> UnsyncedPeriod
unsyncedPeriod :: UnsyncedPeriod
unsyncedPeriod
          , ChainBackendOptions
$sel:chainBackendOptions:CardanoChainConfig :: CardanoChainConfig -> ChainBackendOptions
chainBackendOptions :: ChainBackendOptions
chainBackendOptions
          } ->
          ( case ChainBackendOptions
chainBackendOptions of
              Blockfrost BlockfrostOptions{String
$sel:projectPath:BlockfrostOptions :: BlockfrostOptions -> String
projectPath :: String
projectPath} ->
                [String
"--blockfrost", String
projectPath]
              Direct DirectOptions{NetworkId
$sel:networkId:DirectOptions :: DirectOptions -> NetworkId
networkId :: NetworkId
networkId, SocketPath
$sel:nodeSocket:DirectOptions :: DirectOptions -> SocketPath
nodeSocket :: SocketPath
nodeSocket} ->
                NetworkId -> [String]
toArgNetworkId NetworkId
networkId
                  [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> SocketPath -> [String]
toArgNodeSocket SocketPath
nodeSocket
          )
            [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--hydra-scripts-tx-id", String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> (TxId -> Text) -> TxId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxId -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText (TxId -> String) -> [TxId] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxId]
hydraScriptsTxId]
            [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--cardano-signing-key", String
cardanoSigningKey]
            [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--contestation-period", ContestationPeriod -> String
forall b a. (Show a, IsString b) => a -> b
show ContestationPeriod
contestationPeriod]
            [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--deposit-period", DepositPeriod -> String
forall b a. (Show a, IsString b) => a -> b
show DepositPeriod
depositPeriod]
            [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--deposit-activation", DepositPeriod -> String
forall b a. (Show a, IsString b) => a -> b
show DepositPeriod
depositActivation]
            [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--unsynced-period", UnsyncedPeriod -> String
forall b a. (Show a, IsString b) => a -> b
show UnsyncedPeriod
unsyncedPeriod]
            [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\String
vk -> [String
"--cardano-verification-key", String
vk]) [String]
cardanoVerificationKeys
            [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> Maybe ChainPoint -> [String]
toArgStartChainFrom Maybe ChainPoint
startChainFrom

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

    CardanoLedgerConfig
      { String
$sel:cardanoLedgerProtocolParametersFile:CardanoLedgerConfig :: LedgerConfig -> String
cardanoLedgerProtocolParametersFile :: String
cardanoLedgerProtocolParametersFile
      } = LedgerConfig
ledgerConfig

    showPositive :: Show a => Positive a -> String
    showPositive :: forall a. Show a => Positive a -> String
showPositive (Positive a
x) = a -> String
forall b a. (Show a, IsString b) => a -> b
show a
x

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

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

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