{-# LANGUAGE OverloadedRecordDot #-}

-- | YAML-based configuration file support for hydra-node.
--
-- This module provides a user-friendly configuration file format that mirrors
-- the CLI flag names (kebab-case). A configuration file can be used instead of
-- CLI flags by passing @--config FILE@ to hydra-node.
--
-- Example configuration:
--
-- @
-- node-id: hydra-node-1
-- listen: "0.0.0.0:5001"
-- peers:
--   - address: "peer1:5001"
--     cardano-verification-key: peer1.cardano.vk
--     hydra-verification-key: peer1-hydra.vk
-- api-host: "127.0.0.1"
-- api-port: 4001
-- hydra-signing-key: hydra.sk
-- persistence-dir: "./"
-- ledger-protocol-parameters: protocol-parameters.json
-- chain:
--   mode: cardano
--   network: preview
--   cardano-signing-key: cardano.sk
--   contestation-period: 43200
--   deposit-period: 3600
--   backend:
--     mode: direct
--     testnet-magic: 2
--     node-socket: node.socket
-- @
module Hydra.Config (loadConfig, resolvePaths, renderConfig, isSelfAddress) where

import Hydra.Prelude

import Control.Exception (IOException)
import Control.Exception qualified as E
import Data.Aeson (KeyValue ((.=)), Value (..), object, withObject, (.:), (.:?))
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Aeson.Types (Object, Parser, parseEither, (.!=))
import Data.IP (IP)
import Data.Text qualified as T
import Data.Yaml qualified as Yaml
import Hydra.Cardano.Api (
  ChainPoint (..),
  File (..),
  NetworkId (..),
  NetworkMagic (..),
  SlotNo (..),
  SocketPath,
  TxId,
  deserialiseFromRawBytesHex,
  serialiseToRawBytesHexText,
 )
import Hydra.Logging (Verbosity (..))
import Hydra.Network (Host (..), NodeId (..), PortNumber, WhichEtcd (..), readHost, showHost)
import Hydra.NetworkVersions (hydraNodeVersion, parseNetworkTxIds)
import Hydra.Node.ApiTransactionTimeout (ApiTransactionTimeout (..))
import Hydra.Node.UnsyncedPeriod (UnsyncedPeriod (..), defaultUnsyncedPeriodFor)
import Hydra.Options (
  BlockfrostOptions (..),
  CardanoChainConfig (..),
  ChainBackendOptions (..),
  ChainConfig (..),
  DirectOptions (..),
  LedgerConfig (..),
  OfflineChainConfig (..),
  RunOptions (..),
  defaultBlockfrostOptions,
  defaultCardanoChainConfig,
  defaultContestationPeriod,
  defaultDepositActivation,
  defaultDepositPeriod,
  defaultRunOptions,
 )
import Hydra.Tx.HeadId (HeadSeed)
import System.FilePath (isRelative, takeDirectory, (</>))
import Test.QuickCheck (Positive (..))

-- | Load 'RunOptions' from a YAML configuration file.
--
-- Keys use kebab-case matching the CLI flag names, e.g. @node-id@, @api-host@.
-- Missing keys fall back to the same defaults as the CLI.
--
-- Relative file paths in the config are resolved relative to the directory
-- containing the config file, not the current working directory.
loadConfig :: FilePath -> IO RunOptions
loadConfig :: String -> IO RunOptions
loadConfig String
path = do
  Either IOException (Either ParseException Value)
ioOrValue <- IO (Either ParseException Value)
-> IO (Either IOException (Either ParseException Value))
forall e a. Exception e => IO a -> IO (Either e a)
E.try (String -> IO (Either ParseException Value)
forall a. FromJSON a => String -> IO (Either ParseException a)
Yaml.decodeFileEither String
path)
  Value
value <- case Either IOException (Either ParseException Value)
ioOrValue of
    Left (IOException
ioErr :: IOException) ->
      String -> IO Value
forall (m :: * -> *) a. MonadIO m => String -> m a
die (String -> IO Value) -> String -> IO Value
forall a b. (a -> b) -> a -> b
$ String
"Failed to read config file " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
path String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> IOException -> String
forall b a. (Show a, IsString b) => a -> b
show IOException
ioErr
    Right (Left ParseException
pe) ->
      String -> IO Value
forall (m :: * -> *) a. MonadIO m => String -> m a
die (String -> IO Value) -> String -> IO Value
forall a b. (a -> b) -> a -> b
$
        String
"Failed to parse config file "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
path
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" as YAML:\n  "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ParseException -> String
Yaml.prettyPrintParseException ParseException
pe
    Right (Right Value
v) -> Value -> IO Value
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
  case (Value -> Parser RunOptions) -> Value -> Either String RunOptions
forall a b. (a -> Parser b) -> a -> Either String b
parseEither Value -> Parser RunOptions
parseRunOptions Value
value of
    Left String
err -> String -> IO RunOptions
forall (m :: * -> *) a. MonadIO m => String -> m a
die (String -> IO RunOptions) -> String -> IO RunOptions
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse config file " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
path String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
":\n  " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err
    Right RunOptions
opts -> RunOptions -> IO RunOptions
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> RunOptions -> RunOptions
resolvePaths (String -> String
takeDirectory String
path) RunOptions
opts)

-- | Make all relative 'FilePath' fields in 'RunOptions' absolute by resolving
-- them against @dir@ (the directory containing the config file).  Absolute
-- paths are left unchanged.
resolvePaths :: FilePath -> RunOptions -> RunOptions
resolvePaths :: String -> RunOptions -> RunOptions
resolvePaths String
dir RunOptions
opts =
  RunOptions
opts
    { hydraSigningKey = resolve opts.hydraSigningKey
    , hydraVerificationKeys = map resolve opts.hydraVerificationKeys
    , persistenceDir = resolve opts.persistenceDir
    , ledgerConfig = resolveLedgerConfig opts.ledgerConfig
    , chainConfig = resolveChainConfig opts.chainConfig
    }
 where
  resolve :: String -> String
resolve String
p
    | String -> Bool
isRelative String
p = String
dir String -> String -> String
</> String
p
    | Bool
otherwise = String
p

  resolveLedgerConfig :: LedgerConfig -> LedgerConfig
resolveLedgerConfig (CardanoLedgerConfig String
f) =
    String -> LedgerConfig
CardanoLedgerConfig (String -> String
resolve String
f)

  resolveChainConfig :: ChainConfig -> ChainConfig
resolveChainConfig (Cardano CardanoChainConfig
cfg) = CardanoChainConfig -> ChainConfig
Cardano (CardanoChainConfig -> CardanoChainConfig
resolveCardanoChainConfig CardanoChainConfig
cfg)
  resolveChainConfig (Offline OfflineChainConfig
cfg) = OfflineChainConfig -> ChainConfig
Offline (OfflineChainConfig -> OfflineChainConfig
resolveOfflineChainConfig OfflineChainConfig
cfg)

  resolveCardanoChainConfig :: CardanoChainConfig -> CardanoChainConfig
resolveCardanoChainConfig CardanoChainConfig
cfg =
    CardanoChainConfig
cfg
      { cardanoSigningKey = resolve cfg.cardanoSigningKey
      , cardanoVerificationKeys = map resolve cfg.cardanoVerificationKeys
      , chainBackendOptions = resolveChainBackend cfg.chainBackendOptions
      }

  resolveChainBackend :: ChainBackendOptions -> ChainBackendOptions
resolveChainBackend (Direct DirectOptions
o) =
    DirectOptions -> ChainBackendOptions
Direct DirectOptions
o{nodeSocket = case o.nodeSocket of File String
p -> String -> File Socket 'InOut
forall content (direction :: FileDirection).
String -> File content direction
File (String -> String
resolve String
p)}
  resolveChainBackend (Blockfrost BlockfrostOptions
o) =
    BlockfrostOptions -> ChainBackendOptions
Blockfrost BlockfrostOptions
o{projectPath = resolve o.projectPath}

  resolveOfflineChainConfig :: OfflineChainConfig -> OfflineChainConfig
resolveOfflineChainConfig OfflineChainConfig
cfg =
    OfflineChainConfig
cfg
      { initialUTxOFile = resolve cfg.initialUTxOFile
      , ledgerGenesisFile = fmap resolve cfg.ledgerGenesisFile
      }

-- | Fail the 'Parser' if @obj@ contains any key not in @knownKeys@.
-- This catches typos and stale keys from older config files early.
checkUnknownKeys :: [Text] -> Object -> Parser ()
checkUnknownKeys :: [Text] -> Object -> Parser ()
checkUnknownKeys [Text]
knownKeys Object
obj =
  case (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> [Text] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`notElem` [Text]
knownKeys) ((Key -> Text) -> [Key] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Key -> Text
Key.toText (Object -> [Key]
forall v. KeyMap v -> [Key]
KeyMap.keys Object
obj)) of
    [] -> () -> Parser ()
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    [Text]
unknown ->
      String -> Parser ()
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ()) -> (Text -> String) -> Text -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString (Text -> Parser ()) -> Text -> Parser ()
forall a b. (a -> b) -> a -> b
$
        Text
"Unknown configuration key(s): "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " [Text]
unknown
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\nValid keys are: "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " [Text]
knownKeys

-- ---------------------------------------------------------------------------
-- Top-level parser

parseRunOptions :: Value -> Parser RunOptions
parseRunOptions :: Value -> Parser RunOptions
parseRunOptions = String
-> (Object -> Parser RunOptions) -> Value -> Parser RunOptions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RunOptions" ((Object -> Parser RunOptions) -> Value -> Parser RunOptions)
-> (Object -> Parser RunOptions) -> Value -> Parser RunOptions
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
  [Text] -> Object -> Parser ()
checkUnknownKeys
    [ Text
"quiet"
    , Text
"node-id"
    , Text
"listen"
    , Text
"advertise"
    , Text
"peers"
    , Text
"api-host"
    , Text
"api-port"
    , Text
"tls-cert"
    , Text
"tls-key"
    , Text
"monitoring-port"
    , Text
"hydra-signing-key"
    , Text
"hydra-verification-keys"
    , Text
"persistence-dir"
    , Text
"persistence-rotate-after"
    , Text
"chain"
    , Text
"ledger-protocol-parameters"
    , Text
"use-system-etcd"
    , Text
"api-transaction-timeout"
    ]
    Object
o
  Bool
quiet <- Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"quiet" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
  let verbosity :: Verbosity
verbosity = if Bool
quiet then Verbosity
Quiet else Text -> Verbosity
Verbose Text
"HydraNode"
  NodeId
nodeId <- Text -> NodeId
NodeId (Text -> NodeId) -> Parser Text -> Parser NodeId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"node-id" Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
.!= Text
"hydra-node-1")
  String
listenStr <- Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"listen" Parser (Maybe String) -> String -> Parser String
forall a. Parser (Maybe a) -> a -> Parser a
.!= (String
"0.0.0.0:5001" :: String)
  Host
listen <- String -> String -> Parser Host
forall (m :: * -> *). MonadFail m => String -> String -> m Host
parseHost String
"listen" String
listenStr
  Maybe String
mAdvertiseStr <- Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"advertise" :: Parser (Maybe String)
  Maybe Host
advertise <- (String -> Parser Host) -> Maybe String -> Parser (Maybe Host)
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) -> Maybe a -> m (Maybe b)
mapM (String -> String -> Parser Host
forall (m :: * -> *). MonadFail m => String -> String -> m Host
parseHost String
"advertise") Maybe String
mAdvertiseStr
  [PeerEntry]
peerEntries <- Object
o Object -> Key -> Parser (Maybe [Value])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"peers" Parser (Maybe [Value]) -> [Value] -> Parser [Value]
forall a. Parser (Maybe a) -> a -> Parser a
.!= ([] :: [Value]) Parser [Value]
-> ([Value] -> Parser [PeerEntry]) -> Parser [PeerEntry]
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser PeerEntry) -> [Value] -> Parser [PeerEntry]
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 Value -> Parser PeerEntry
parsePeerEntry
  [String]
extraHydraVKs <- Object
o Object -> Key -> Parser (Maybe [String])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"hydra-verification-keys" Parser (Maybe [String]) -> [String] -> Parser [String]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
  let filteredEntries :: [PeerEntry]
filteredEntries = (PeerEntry -> Bool) -> [PeerEntry] -> [PeerEntry]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (PeerEntry -> Bool) -> PeerEntry -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Host -> Maybe Host -> Host -> Bool
isSelfAddress Host
listen Maybe Host
advertise (Host -> Bool) -> (PeerEntry -> Host) -> PeerEntry -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.peerHost)) [PeerEntry]
peerEntries
      peers :: [Host]
peers = (PeerEntry -> Host) -> [PeerEntry] -> [Host]
forall a b. (a -> b) -> [a] -> [b]
map (.peerHost) [PeerEntry]
filteredEntries
      peerCardanoVKs :: [String]
peerCardanoVKs = (PeerEntry -> Maybe String) -> [PeerEntry] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (.peerCardanoVK) [PeerEntry]
filteredEntries
      hydraVerificationKeys :: [String]
hydraVerificationKeys = (PeerEntry -> Maybe String) -> [PeerEntry] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (.peerHydraVK) [PeerEntry]
filteredEntries [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
extraHydraVKs
  String
apiHostStr <- Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"api-host" Parser (Maybe String) -> String -> Parser String
forall a. Parser (Maybe a) -> a -> Parser a
.!= (String
"127.0.0.1" :: String)
  IP
apiHost <- String -> String -> Parser IP
forall (m :: * -> *). MonadFail m => String -> String -> m IP
parseIP String
"api-host" String
apiHostStr
  PortNumber
apiPort <- Object
o Object -> Key -> Parser (Maybe PortNumber)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"api-port" Parser (Maybe PortNumber) -> PortNumber -> Parser PortNumber
forall a. Parser (Maybe a) -> a -> Parser a
.!= (PortNumber
4001 :: PortNumber)
  Maybe String
tlsCertPath <- Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tls-cert"
  Maybe String
tlsKeyPath <- Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tls-key"
  Maybe PortNumber
monitoringPort <- Object
o Object -> Key -> Parser (Maybe PortNumber)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"monitoring-port"
  String
hydraSigningKey <- Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"hydra-signing-key" Parser (Maybe String) -> String -> Parser String
forall a. Parser (Maybe a) -> a -> Parser a
.!= String
"hydra.sk"
  String
persistenceDir <- Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"persistence-dir" Parser (Maybe String) -> String -> Parser String
forall a. Parser (Maybe a) -> a -> Parser a
.!= String
"./"
  Maybe (Positive Natural)
persistenceRotateAfter <- (Natural -> Positive Natural)
-> Maybe Natural -> Maybe (Positive Natural)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Natural -> Positive Natural
forall a. a -> Positive a
Positive (Maybe Natural -> Maybe (Positive Natural))
-> Parser (Maybe Natural) -> Parser (Maybe (Positive Natural))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Natural)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"persistence-rotate-after" :: Parser (Maybe Natural))
  Maybe Value
mChain <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"chain"
  ChainConfig
chainConfig <- case Maybe Value
mChain of
    Just Value
v -> [String] -> Value -> Parser ChainConfig
parseChainConfig [String]
peerCardanoVKs Value
v
    Maybe Value
Nothing -> ChainConfig -> Parser ChainConfig
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChainConfig -> Parser ChainConfig)
-> ChainConfig -> Parser ChainConfig
forall a b. (a -> b) -> a -> b
$ [String] -> ChainConfig -> ChainConfig
applyPeerCardanoVKs [String]
peerCardanoVKs RunOptions
defaultRunOptions.chainConfig
  String
ledgerProtocolParams <- Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ledger-protocol-parameters" Parser (Maybe String) -> String -> Parser String
forall a. Parser (Maybe a) -> a -> Parser a
.!= String
"protocol-parameters.json"
  let ledgerConfig :: LedgerConfig
ledgerConfig = String -> LedgerConfig
CardanoLedgerConfig String
ledgerProtocolParams
  Bool
useSystemEtcd <- Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"use-system-etcd" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
  let whichEtcd :: WhichEtcd
whichEtcd = if Bool
useSystemEtcd then WhichEtcd
SystemEtcd else WhichEtcd
EmbeddedEtcd
  ApiTransactionTimeout
apiTransactionTimeout <- Object
o Object -> Key -> Parser (Maybe ApiTransactionTimeout)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"api-transaction-timeout" Parser (Maybe ApiTransactionTimeout)
-> ApiTransactionTimeout -> Parser ApiTransactionTimeout
forall a. Parser (Maybe a) -> a -> Parser a
.!= NominalDiffTime -> ApiTransactionTimeout
ApiTransactionTimeout NominalDiffTime
300
  RunOptions -> Parser RunOptions
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    RunOptions
      { Verbosity
verbosity :: Verbosity
$sel:verbosity:RunOptions :: Verbosity
verbosity
      , NodeId
nodeId :: NodeId
$sel:nodeId:RunOptions :: NodeId
nodeId
      , Host
listen :: Host
$sel:listen:RunOptions :: Host
listen
      , Maybe Host
advertise :: Maybe Host
$sel:advertise:RunOptions :: Maybe Host
advertise
      , [Host]
peers :: [Host]
$sel:peers:RunOptions :: [Host]
peers
      , IP
apiHost :: IP
$sel:apiHost:RunOptions :: IP
apiHost
      , PortNumber
apiPort :: PortNumber
$sel:apiPort:RunOptions :: PortNumber
apiPort
      , Maybe String
tlsCertPath :: Maybe String
$sel:tlsCertPath:RunOptions :: Maybe String
tlsCertPath
      , Maybe String
tlsKeyPath :: Maybe String
$sel:tlsKeyPath:RunOptions :: Maybe String
tlsKeyPath
      , Maybe PortNumber
monitoringPort :: Maybe PortNumber
$sel:monitoringPort:RunOptions :: Maybe PortNumber
monitoringPort
      , String
$sel:hydraSigningKey:RunOptions :: String
hydraSigningKey :: String
hydraSigningKey
      , [String]
$sel:hydraVerificationKeys:RunOptions :: [String]
hydraVerificationKeys :: [String]
hydraVerificationKeys
      , String
$sel:persistenceDir:RunOptions :: String
persistenceDir :: String
persistenceDir
      , Maybe (Positive Natural)
persistenceRotateAfter :: Maybe (Positive Natural)
$sel:persistenceRotateAfter:RunOptions :: Maybe (Positive Natural)
persistenceRotateAfter
      , ChainConfig
$sel:chainConfig:RunOptions :: ChainConfig
chainConfig :: ChainConfig
chainConfig
      , LedgerConfig
$sel:ledgerConfig:RunOptions :: LedgerConfig
ledgerConfig :: LedgerConfig
ledgerConfig
      , WhichEtcd
whichEtcd :: WhichEtcd
$sel:whichEtcd:RunOptions :: WhichEtcd
whichEtcd
      , ApiTransactionTimeout
apiTransactionTimeout :: ApiTransactionTimeout
$sel:apiTransactionTimeout:RunOptions :: ApiTransactionTimeout
apiTransactionTimeout
      }

-- ---------------------------------------------------------------------------
-- Chain config

parseChainConfig :: [FilePath] -> Value -> Parser ChainConfig
parseChainConfig :: [String] -> Value -> Parser ChainConfig
parseChainConfig [String]
peerCardanoVKs = String
-> (Object -> Parser ChainConfig) -> Value -> Parser ChainConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"chain" ((Object -> Parser ChainConfig) -> Value -> Parser ChainConfig)
-> (Object -> Parser ChainConfig) -> Value -> Parser ChainConfig
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
  Text
mode <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mode" Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
.!= (Text
"cardano" :: Text)
  case Text
mode of
    Text
"cardano" -> CardanoChainConfig -> ChainConfig
Cardano (CardanoChainConfig -> ChainConfig)
-> Parser CardanoChainConfig -> Parser ChainConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Object -> Parser CardanoChainConfig
parseCardanoChainConfig [String]
peerCardanoVKs Object
o
    Text
"offline" -> OfflineChainConfig -> ChainConfig
Offline (OfflineChainConfig -> ChainConfig)
-> Parser OfflineChainConfig -> Parser ChainConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser OfflineChainConfig
parseOfflineChainConfig Object
o
    Text
other -> 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
"Unknown chain mode '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString Text
other String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'. Expected 'cardano' or 'offline'."

parseCardanoChainConfig :: [FilePath] -> Object -> Parser CardanoChainConfig
parseCardanoChainConfig :: [String] -> Object -> Parser CardanoChainConfig
parseCardanoChainConfig [String]
peerCardanoVKs Object
o = do
  [Text] -> Object -> Parser ()
checkUnknownKeys
    [ Text
"mode"
    , Text
"network"
    , Text
"hydra-scripts-tx-id"
    , Text
"cardano-signing-key"
    , Text
"cardano-verification-keys"
    , Text
"start-chain-from"
    , Text
"contestation-period"
    , Text
"deposit-period"
    , Text
"deposit-activation"
    , Text
"unsynced-period"
    , Text
"backend"
    ]
    Object
o
  [TxId]
hydraScriptsTxId <- Object -> Parser [TxId]
parseHydraScripts Object
o
  String
cardanoSigningKey <- Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"cardano-signing-key" Parser (Maybe String) -> String -> Parser String
forall a. Parser (Maybe a) -> a -> Parser a
.!= CardanoChainConfig
defaultCardanoChainConfig.cardanoSigningKey
  [String]
chainVKs <- Object
o Object -> Key -> Parser (Maybe [String])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"cardano-verification-keys" Parser (Maybe [String]) -> [String] -> Parser [String]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
  let cardanoVerificationKeys :: [String]
cardanoVerificationKeys = [String]
peerCardanoVKs [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
chainVKs
  Maybe Text
mStartChainFrom <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"start-chain-from" :: Parser (Maybe Text)
  Maybe ChainPoint
startChainFrom <- (Text -> Parser ChainPoint)
-> Maybe Text -> Parser (Maybe ChainPoint)
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) -> Maybe a -> m (Maybe b)
mapM Text -> Parser ChainPoint
forall (m :: * -> *). MonadFail m => Text -> m ChainPoint
parseChainPointText Maybe Text
mStartChainFrom
  ContestationPeriod
contestationPeriod <- Object
o Object -> Key -> Parser (Maybe ContestationPeriod)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"contestation-period" Parser (Maybe ContestationPeriod)
-> ContestationPeriod -> Parser ContestationPeriod
forall a. Parser (Maybe a) -> a -> Parser a
.!= ContestationPeriod
defaultContestationPeriod
  DepositPeriod
depositPeriod <- Object
o Object -> Key -> Parser (Maybe DepositPeriod)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"deposit-period" Parser (Maybe DepositPeriod)
-> DepositPeriod -> Parser DepositPeriod
forall a. Parser (Maybe a) -> a -> Parser a
.!= DepositPeriod
defaultDepositPeriod
  DepositPeriod
depositActivation <- Object
o Object -> Key -> Parser (Maybe DepositPeriod)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"deposit-activation" Parser (Maybe DepositPeriod)
-> DepositPeriod -> Parser DepositPeriod
forall a. Parser (Maybe a) -> a -> Parser a
.!= DepositPeriod
defaultDepositActivation
  Maybe UnsyncedPeriod
mUnsyncedPeriod <- Object
o Object -> Key -> Parser (Maybe UnsyncedPeriod)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"unsynced-period" :: Parser (Maybe UnsyncedPeriod)
  let unsyncedPeriod :: UnsyncedPeriod
unsyncedPeriod = UnsyncedPeriod -> Maybe UnsyncedPeriod -> UnsyncedPeriod
forall a. a -> Maybe a -> a
fromMaybe (ContestationPeriod -> UnsyncedPeriod
defaultUnsyncedPeriodFor ContestationPeriod
contestationPeriod) Maybe UnsyncedPeriod
mUnsyncedPeriod
  ChainBackendOptions
chainBackendOptions <-
    Parser ChainBackendOptions
-> (Value -> Parser ChainBackendOptions)
-> Maybe Value
-> Parser ChainBackendOptions
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ChainBackendOptions -> Parser ChainBackendOptions
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CardanoChainConfig
defaultCardanoChainConfig.chainBackendOptions) Value -> Parser ChainBackendOptions
parseChainBackend (Maybe Value -> Parser ChainBackendOptions)
-> Parser (Maybe Value) -> Parser ChainBackendOptions
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"backend")
  CardanoChainConfig -> Parser CardanoChainConfig
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    CardanoChainConfig
      { [TxId]
hydraScriptsTxId :: [TxId]
$sel:hydraScriptsTxId:CardanoChainConfig :: [TxId]
hydraScriptsTxId
      , String
$sel:cardanoSigningKey:CardanoChainConfig :: String
cardanoSigningKey :: String
cardanoSigningKey
      , [String]
$sel:cardanoVerificationKeys:CardanoChainConfig :: [String]
cardanoVerificationKeys :: [String]
cardanoVerificationKeys
      , Maybe ChainPoint
startChainFrom :: Maybe ChainPoint
$sel:startChainFrom:CardanoChainConfig :: Maybe ChainPoint
startChainFrom
      , ContestationPeriod
contestationPeriod :: ContestationPeriod
$sel:contestationPeriod:CardanoChainConfig :: ContestationPeriod
contestationPeriod
      , DepositPeriod
depositPeriod :: DepositPeriod
$sel:depositPeriod:CardanoChainConfig :: DepositPeriod
depositPeriod
      , DepositPeriod
depositActivation :: DepositPeriod
$sel:depositActivation:CardanoChainConfig :: DepositPeriod
depositActivation
      , UnsyncedPeriod
unsyncedPeriod :: UnsyncedPeriod
$sel:unsyncedPeriod:CardanoChainConfig :: UnsyncedPeriod
unsyncedPeriod
      , ChainBackendOptions
$sel:chainBackendOptions:CardanoChainConfig :: ChainBackendOptions
chainBackendOptions :: ChainBackendOptions
chainBackendOptions
      }

parseHydraScripts :: Object -> Parser [TxId]
parseHydraScripts :: Object -> Parser [TxId]
parseHydraScripts Object
o = do
  Maybe Text
mNetwork <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"network" :: Parser (Maybe Text)
  Maybe [Text]
mTxIds <- Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"hydra-scripts-tx-id" :: Parser (Maybe [Text])
  case (Maybe Text
mNetwork, Maybe [Text]
mTxIds) of
    (Just Text
_, Just [Text]
_) ->
      String -> Parser [TxId]
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
        String
"Both 'network' and 'hydra-scripts-tx-id' are set; they are mutually exclusive. \
        \Use 'network' to auto-select known Hydra scripts for a network, \
        \or 'hydra-scripts-tx-id' to pin specific transaction IDs — not both."
    (Just Text
network, Maybe [Text]
Nothing) ->
      Version -> String -> Parser [TxId]
forall (m :: * -> *). MonadFail m => Version -> String -> m [TxId]
parseNetworkTxIds Version
hydraNodeVersion (Text -> String
forall a. ToString a => a -> String
toString Text
network)
    (Maybe Text
Nothing, Just [Text]
txIdTexts) ->
      (Text -> Parser TxId) -> [Text] -> Parser [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 Text -> Parser TxId
parseTxId [Text]
txIdTexts
    (Maybe Text
Nothing, Maybe [Text]
Nothing) ->
      [TxId] -> Parser [TxId]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
 where
  parseTxId :: Text -> Parser TxId
  parseTxId :: Text -> Parser TxId
parseTxId Text
t =
    case ByteString -> Either RawBytesHexError TxId
forall a.
SerialiseAsRawBytes a =>
ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
t) of
      Left RawBytesHexError
err -> String -> Parser TxId
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser TxId) -> String -> Parser TxId
forall a b. (a -> b) -> a -> b
$ String
"Invalid hydra-scripts-tx-id '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString Text
t String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"': " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> RawBytesHexError -> String
forall b a. (Show a, IsString b) => a -> b
show RawBytesHexError
err
      Right TxId
txId -> TxId -> Parser TxId
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxId
txId

parseOfflineChainConfig :: Object -> Parser OfflineChainConfig
parseOfflineChainConfig :: Object -> Parser OfflineChainConfig
parseOfflineChainConfig Object
o = do
  [Text] -> Object -> Parser ()
checkUnknownKeys [Text
"mode", Text
"offline-head-seed", Text
"initial-utxo", Text
"ledger-genesis"] Object
o
  Maybe Text
mSeedText <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"offline-head-seed" :: Parser (Maybe Text)
  HeadSeed
offlineHeadSeed <- Parser HeadSeed
-> (Text -> Parser HeadSeed) -> Maybe Text -> Parser HeadSeed
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser HeadSeed
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"offline mode requires 'offline-head-seed'") Text -> Parser HeadSeed
forall (m :: * -> *). MonadFail m => Text -> m HeadSeed
parseHeadSeed Maybe Text
mSeedText
  String
initialUTxOFile <- Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"initial-utxo" Parser (Maybe String) -> String -> Parser String
forall a. Parser (Maybe a) -> a -> Parser a
.!= String
"utxo.json"
  Maybe String
ledgerGenesisFile <- Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ledger-genesis"
  OfflineChainConfig -> Parser OfflineChainConfig
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OfflineChainConfig{HeadSeed
offlineHeadSeed :: HeadSeed
$sel:offlineHeadSeed:OfflineChainConfig :: HeadSeed
offlineHeadSeed, String
$sel:initialUTxOFile:OfflineChainConfig :: String
initialUTxOFile :: String
initialUTxOFile, Maybe String
$sel:ledgerGenesisFile:OfflineChainConfig :: Maybe String
ledgerGenesisFile :: Maybe String
ledgerGenesisFile}

-- ---------------------------------------------------------------------------
-- Chain backend

parseChainBackend :: Value -> Parser ChainBackendOptions
parseChainBackend :: Value -> Parser ChainBackendOptions
parseChainBackend = String
-> (Object -> Parser ChainBackendOptions)
-> Value
-> Parser ChainBackendOptions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"backend" ((Object -> Parser ChainBackendOptions)
 -> Value -> Parser ChainBackendOptions)
-> (Object -> Parser ChainBackendOptions)
-> Value
-> Parser ChainBackendOptions
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
  Text
mode <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mode" Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
.!= (Text
"direct" :: Text)
  case Text
mode of
    Text
"direct" -> DirectOptions -> ChainBackendOptions
Direct (DirectOptions -> ChainBackendOptions)
-> Parser DirectOptions -> Parser ChainBackendOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser DirectOptions
parseDirectOptions Object
o
    Text
"blockfrost" -> BlockfrostOptions -> ChainBackendOptions
Blockfrost (BlockfrostOptions -> ChainBackendOptions)
-> Parser BlockfrostOptions -> Parser ChainBackendOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser BlockfrostOptions
parseBlockfrostOptions Object
o
    Text
other -> String -> Parser ChainBackendOptions
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ChainBackendOptions)
-> String -> Parser ChainBackendOptions
forall a b. (a -> b) -> a -> b
$ String
"Unknown backend mode '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString Text
other String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'. Expected 'direct' or 'blockfrost'."

parseDirectOptions :: Object -> Parser DirectOptions
parseDirectOptions :: Object -> Parser DirectOptions
parseDirectOptions Object
o = do
  [Text] -> Object -> Parser ()
checkUnknownKeys [Text
"mode", Text
"mainnet", Text
"testnet-magic", Text
"node-socket"] Object
o
  Bool
mainnet <- Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mainnet" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
  NetworkId
networkId <-
    if Bool
mainnet
      then NetworkId -> Parser NetworkId
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NetworkId
Mainnet
      else NetworkMagic -> NetworkId
Testnet (NetworkMagic -> NetworkId)
-> (Word32 -> NetworkMagic) -> Word32 -> NetworkId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> NetworkMagic
NetworkMagic (Word32 -> NetworkId) -> Parser Word32 -> Parser NetworkId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Word32)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"testnet-magic" Parser (Maybe Word32) -> Word32 -> Parser Word32
forall a. Parser (Maybe a) -> a -> Parser a
.!= Word32
42)
  String
nodeSocketStr <- Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"node-socket" Parser (Maybe String) -> String -> Parser String
forall a. Parser (Maybe a) -> a -> Parser a
.!= String
"node.socket"
  let nodeSocket :: File Socket 'InOut
nodeSocket = String -> File Socket 'InOut
forall content (direction :: FileDirection).
String -> File content direction
File String
nodeSocketStr :: SocketPath
  DirectOptions -> Parser DirectOptions
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DirectOptions{NetworkId
networkId :: NetworkId
$sel:networkId:DirectOptions :: NetworkId
networkId, File Socket 'InOut
$sel:nodeSocket:DirectOptions :: File Socket 'InOut
nodeSocket :: File Socket 'InOut
nodeSocket}

parseBlockfrostOptions :: Object -> Parser BlockfrostOptions
parseBlockfrostOptions :: Object -> Parser BlockfrostOptions
parseBlockfrostOptions Object
o = do
  [Text] -> Object -> Parser ()
checkUnknownKeys [Text
"mode", Text
"project-path"] Object
o
  String
projectPath <- Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"project-path" Parser (Maybe String) -> String -> Parser String
forall a. Parser (Maybe a) -> a -> Parser a
.!= BlockfrostOptions
defaultBlockfrostOptions.projectPath
  BlockfrostOptions -> Parser BlockfrostOptions
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlockfrostOptions{String
$sel:projectPath:BlockfrostOptions :: String
projectPath :: String
projectPath}

-- ---------------------------------------------------------------------------
-- Helpers

data PeerEntry = PeerEntry
  { PeerEntry -> Host
peerHost :: Host
  , PeerEntry -> Maybe String
peerCardanoVK :: Maybe FilePath
  , PeerEntry -> Maybe String
peerHydraVK :: Maybe FilePath
  }

-- | Parse a peer entry which may be a plain "HOST:PORT" string or an object
-- with @address@ and optional @cardano-verification-key@ / @hydra-verification-key@ fields.
--
-- For object-form entries, either both verification keys are present (a
-- signing peer) or both are absent (a mirror/observer peer). Providing
-- exactly one is rejected with a pointed error — it was almost certainly
-- a mistake, and silently accepting it causes a later, confusing key-count
-- mismatch during validation.
parsePeerEntry :: Value -> Parser PeerEntry
parsePeerEntry :: Value -> Parser PeerEntry
parsePeerEntry (String Text
s) = do
  Host
h <- String -> String -> Parser Host
forall (m :: * -> *). MonadFail m => String -> String -> m Host
parseHost String
"peers" (Text -> String
forall a. ToString a => a -> String
toString Text
s)
  PeerEntry -> Parser PeerEntry
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PeerEntry{$sel:peerHost:PeerEntry :: Host
peerHost = Host
h, $sel:peerCardanoVK:PeerEntry :: Maybe String
peerCardanoVK = Maybe String
forall a. Maybe a
Nothing, $sel:peerHydraVK:PeerEntry :: Maybe String
peerHydraVK = Maybe String
forall a. Maybe a
Nothing}
parsePeerEntry Value
v =
  String -> (Object -> Parser PeerEntry) -> Value -> Parser PeerEntry
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
    String
"peer"
    ( \Object
o -> do
        [Text] -> Object -> Parser ()
checkUnknownKeys [Text
"address", Text
"cardano-verification-key", Text
"hydra-verification-key"] Object
o
        String
addrStr <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"address"
        Host
h <- String -> String -> Parser Host
forall (m :: * -> *). MonadFail m => String -> String -> m Host
parseHost String
"peers.address" String
addrStr
        Maybe String
cardanoVK <- Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"cardano-verification-key"
        Maybe String
hydraVK <- Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"hydra-verification-key"
        case (Maybe String
cardanoVK, Maybe String
hydraVK) of
          (Just String
_, Maybe String
Nothing) ->
            String -> Parser PeerEntry
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser PeerEntry) -> String -> Parser PeerEntry
forall a b. (a -> b) -> a -> b
$
              String
"Peer entry for '"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Host -> String
showHost Host
h
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' has 'cardano-verification-key' but no 'hydra-verification-key'. \
                   \For a signing peer, provide both; for an observer/mirror peer, omit both."
          (Maybe String
Nothing, Just String
_) ->
            String -> Parser PeerEntry
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser PeerEntry) -> String -> Parser PeerEntry
forall a b. (a -> b) -> a -> b
$
              String
"Peer entry for '"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Host -> String
showHost Host
h
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' has 'hydra-verification-key' but no 'cardano-verification-key'. \
                   \For a signing peer, provide both; for an observer/mirror peer, omit both."
          (Maybe String, Maybe String)
_ ->
            PeerEntry -> Parser PeerEntry
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PeerEntry{$sel:peerHost:PeerEntry :: Host
peerHost = Host
h, $sel:peerCardanoVK:PeerEntry :: Maybe String
peerCardanoVK = Maybe String
cardanoVK, $sel:peerHydraVK:PeerEntry :: Maybe String
peerHydraVK = Maybe String
hydraVK}
    )
    Value
v

-- | Does the given peer address refer to the same node as us, given our
-- 'listen' and optional 'advertise' hosts?
--
-- The comparison normalizes wildcard/loopback variants:
--
-- * If 'advertise' is set, the peer must match it exactly (same host, same
--   port) — we trust the operator's explicit choice.
-- * Otherwise, same-port peers are self when:
--     * the host string is identical to the listen host (even if it's
--       @0.0.0.0@, matching the "self-entry with same address" convention);
--     * the listen host is a wildcard (@0.0.0.0@, @::@, @*@) and the peer
--       host is a loopback (@127.0.0.1@, @localhost@, @::1@); or
--     * both are loopback in some combination.
--
-- We deliberately do *not* treat wildcard listen as matching arbitrary
-- remote peers on the same port — those may be legitimate other-host
-- participants.
isSelfAddress :: Host -> Maybe Host -> Host -> Bool
isSelfAddress :: Host -> Maybe Host -> Host -> Bool
isSelfAddress Host
listenHost Maybe Host
mAdvertise Host
peer =
  case Maybe Host
mAdvertise of
    Just Host
adv ->
      Host
adv.port PortNumber -> PortNumber -> Bool
forall a. Eq a => a -> a -> Bool
== Host
peer.port Bool -> Bool -> Bool
&& Host
adv.hostname Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Host
peer.hostname
    Maybe Host
Nothing ->
      Host
listenHost.port PortNumber -> PortNumber -> Bool
forall a. Eq a => a -> a -> Bool
== Host
peer.port
        Bool -> Bool -> Bool
&& ( Host
listenHost.hostname Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Host
peer.hostname
              Bool -> Bool -> Bool
|| (Text -> Bool
isWildcard Host
listenHost.hostname Bool -> Bool -> Bool
&& Text -> Bool
isLoopback Host
peer.hostname)
              Bool -> Bool -> Bool
|| (Text -> Bool
isLoopback Host
listenHost.hostname Bool -> Bool -> Bool
&& Text -> Bool
isLoopback Host
peer.hostname)
           )
 where
  isWildcard, isLoopback :: Text -> Bool
  isWildcard :: Text -> Bool
isWildcard Text
h = Text
h Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"0.0.0.0" Bool -> Bool -> Bool
|| Text
h Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"::" Bool -> Bool -> Bool
|| Text
h Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"*"
  isLoopback :: Text -> Bool
isLoopback Text
h = Text
h Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"127.0.0.1" Bool -> Bool -> Bool
|| Text
h Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"localhost" Bool -> Bool -> Bool
|| Text
h Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"::1"

-- | Inject peer-sourced cardano VKs into an existing 'ChainConfig'.
applyPeerCardanoVKs :: [FilePath] -> ChainConfig -> ChainConfig
applyPeerCardanoVKs :: [String] -> ChainConfig -> ChainConfig
applyPeerCardanoVKs [] ChainConfig
cfg = ChainConfig
cfg
applyPeerCardanoVKs [String]
vks (Cardano CardanoChainConfig
cfg) = CardanoChainConfig -> ChainConfig
Cardano CardanoChainConfig
cfg{cardanoVerificationKeys = vks <> cfg.cardanoVerificationKeys}
applyPeerCardanoVKs [String]
_ ChainConfig
cfg = ChainConfig
cfg

parseHost :: MonadFail m => String -> String -> m Host
parseHost :: forall (m :: * -> *). MonadFail m => String -> String -> m Host
parseHost String
fieldName String
str =
  case String -> Maybe Host
forall (m :: * -> *). MonadFail m => String -> m Host
readHost String
str of
    Maybe Host
Nothing -> String -> m Host
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Host) -> String -> m Host
forall a b. (a -> b) -> a -> b
$ String
"Invalid '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fieldName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' value '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
str String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'. Expected HOST:PORT format."
    Just Host
h -> Host -> m Host
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Host
h

parseIP :: MonadFail m => String -> String -> m IP
parseIP :: forall (m :: * -> *). MonadFail m => String -> String -> m IP
parseIP String
fieldName String
str =
  case String -> Maybe IP
forall a. Read a => String -> Maybe a
readMaybe String
str of
    Just IP
ip -> IP -> m IP
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IP
ip
    Maybe IP
Nothing -> String -> m IP
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m IP) -> String -> m IP
forall a b. (a -> b) -> a -> b
$ String
"Invalid '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fieldName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' value '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
str String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'. Expected an IP address."

parseHeadSeed :: MonadFail m => Text -> m HeadSeed
parseHeadSeed :: forall (m :: * -> *). MonadFail m => Text -> m HeadSeed
parseHeadSeed Text
t =
  case ByteString -> Either RawBytesHexError HeadSeed
forall a.
SerialiseAsRawBytes a =>
ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
t) of
    Left RawBytesHexError
err -> String -> m HeadSeed
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m HeadSeed) -> String -> m HeadSeed
forall a b. (a -> b) -> a -> b
$ String
"Invalid offline-head-seed '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString Text
t String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"': " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> RawBytesHexError -> String
forall b a. (Show a, IsString b) => a -> b
show RawBytesHexError
err
    Right HeadSeed
seed -> HeadSeed -> m HeadSeed
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HeadSeed
seed

parseChainPointText :: MonadFail m => Text -> m ChainPoint
parseChainPointText :: forall (m :: * -> *). MonadFail m => Text -> m ChainPoint
parseChainPointText Text
"0" = ChainPoint -> m ChainPoint
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChainPoint
ChainPointAtGenesis
parseChainPointText Text
t =
  case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"." Text
t of
    [Text
slotTxt, Text
hashTxt] -> do
      SlotNo
slotNo <- case String -> Maybe Word64
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
forall a. ToString a => a -> String
toString Text
slotTxt) of
        Just Word64
n -> SlotNo -> m SlotNo
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo -> m SlotNo) -> SlotNo -> m SlotNo
forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
n
        Maybe Word64
Nothing -> String -> m SlotNo
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m SlotNo) -> String -> m SlotNo
forall a b. (a -> b) -> a -> b
$ String
"Invalid slot number in start-chain-from: '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString Text
slotTxt String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'"
      Hash BlockHeader
headerHash <- case 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
hashTxt) of
        Left RawBytesHexError
err -> String -> m (Hash BlockHeader)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (Hash BlockHeader)) -> String -> m (Hash BlockHeader)
forall a b. (a -> b) -> a -> b
$ String
"Invalid block hash in start-chain-from: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> RawBytesHexError -> String
forall b a. (Show a, IsString b) => a -> b
show RawBytesHexError
err
        Right Hash BlockHeader
h -> Hash BlockHeader -> m (Hash BlockHeader)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Hash BlockHeader
h
      ChainPoint -> m ChainPoint
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChainPoint -> m ChainPoint) -> ChainPoint -> m ChainPoint
forall a b. (a -> b) -> a -> b
$ SlotNo -> Hash BlockHeader -> ChainPoint
ChainPoint SlotNo
slotNo Hash BlockHeader
headerHash
    [Text]
_ ->
      String -> m ChainPoint
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ChainPoint) -> String -> m ChainPoint
forall a b. (a -> b) -> a -> b
$ String
"Invalid start-chain-from '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString Text
t String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'. Expected format: SLOT.HEADER_HASH"

-- ---------------------------------------------------------------------------
-- Rendering

-- | Render 'RunOptions' as a JSON document whose structure matches the YAML
-- config file format (kebab-case keys, same hierarchy).  This is the inverse
-- of 'loadConfig' and is served at the @GET /config@ HTTP endpoint so
-- operators can inspect the effective configuration the node is running with.
renderConfig :: RunOptions -> Value
renderConfig :: RunOptions -> Value
renderConfig RunOptions
opts =
  [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ Key
"node-id" Key -> NodeId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RunOptions
opts.nodeId
    , Key
"quiet" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (RunOptions
opts.verbosity Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
Quiet)
    , Key
"listen" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Host -> String
showHost RunOptions
opts.listen
    , Key
"api-host" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (IP -> Text
forall b a. (Show a, IsString b) => a -> b
show RunOptions
opts.apiHost :: Text)
    , Key
"api-port" Key -> PortNumber -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RunOptions
opts.apiPort
    , Key
"hydra-signing-key" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RunOptions
opts.hydraSigningKey
    , Key
"hydra-verification-keys" Key -> [String] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RunOptions
opts.hydraVerificationKeys
    , Key
"peers" Key -> [String] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Host -> String) -> [Host] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Host -> String
showHost RunOptions
opts.peers
    , Key
"persistence-dir" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RunOptions
opts.persistenceDir
    , Key
"ledger-protocol-parameters" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= LedgerConfig -> String
ledgerParamsFile RunOptions
opts.ledgerConfig
    , Key
"use-system-etcd" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (RunOptions
opts.whichEtcd WhichEtcd -> WhichEtcd -> Bool
forall a. Eq a => a -> a -> Bool
== WhichEtcd
SystemEtcd)
    , Key
"api-transaction-timeout" Key -> ApiTransactionTimeout -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RunOptions
opts.apiTransactionTimeout
    , Key
"chain" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ChainConfig -> Value
renderChainConfig RunOptions
opts.chainConfig
    ]
      [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
        [ (Key
"advertise" .=) (String -> Pair) -> (Host -> String) -> Host -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Host -> String
showHost (Host -> Pair) -> Maybe Host -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RunOptions
opts.advertise
        , (Key
"monitoring-port" .=) (PortNumber -> Pair) -> Maybe PortNumber -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RunOptions
opts.monitoringPort
        , (Key
"tls-cert" .=) (String -> Pair) -> Maybe String -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RunOptions
opts.tlsCertPath
        , (Key
"tls-key" .=) (String -> Pair) -> Maybe String -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RunOptions
opts.tlsKeyPath
        , (Key
"persistence-rotate-after" .=) (Positive Natural -> Pair)
-> Maybe (Positive Natural) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RunOptions
opts.persistenceRotateAfter
        ]
 where
  ledgerParamsFile :: LedgerConfig -> String
ledgerParamsFile (CardanoLedgerConfig String
f) = String
f

  renderChainConfig :: ChainConfig -> Value
renderChainConfig (Cardano CardanoChainConfig
cfg) =
    [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      [ Key
"mode" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"cardano" :: Text)
      , Key
"cardano-signing-key" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CardanoChainConfig
cfg.cardanoSigningKey
      , Key
"cardano-verification-keys" Key -> [String] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CardanoChainConfig
cfg.cardanoVerificationKeys
      , Key
"contestation-period" Key -> ContestationPeriod -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CardanoChainConfig
cfg.contestationPeriod
      , Key
"deposit-period" Key -> DepositPeriod -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CardanoChainConfig
cfg.depositPeriod
      , Key
"deposit-activation" Key -> DepositPeriod -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CardanoChainConfig
cfg.depositActivation
      , Key
"unsynced-period" Key -> UnsyncedPeriod -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CardanoChainConfig
cfg.unsyncedPeriod
      , Key
"backend" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ChainBackendOptions -> Value
renderBackend CardanoChainConfig
cfg.chainBackendOptions
      ]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
          [ (Key
"start-chain-from" .=) (Text -> Pair) -> (ChainPoint -> Text) -> ChainPoint -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainPoint -> Text
renderChainPoint (ChainPoint -> Pair) -> Maybe ChainPoint -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CardanoChainConfig
cfg.startChainFrom
          ]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Key
"hydra-scripts-tx-id" Key -> [Text] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (TxId -> Text) -> [TxId] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map TxId -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText CardanoChainConfig
cfg.hydraScriptsTxId | Bool -> Bool
not ([TxId] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null CardanoChainConfig
cfg.hydraScriptsTxId)]
  renderChainConfig (Offline OfflineChainConfig
cfg) =
    [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      [ Key
"mode" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"offline" :: Text)
      , Key
"offline-head-seed" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadSeed -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText OfflineChainConfig
cfg.offlineHeadSeed
      , Key
"initial-utxo" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= OfflineChainConfig
cfg.initialUTxOFile
      ]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [(Key
"ledger-genesis" .=) (String -> Pair) -> Maybe String -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OfflineChainConfig
cfg.ledgerGenesisFile]

  renderBackend :: ChainBackendOptions -> Value
renderBackend (Direct DirectOptions
o) =
    [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      [ Key
"mode" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"direct" :: Text)
      , Key
"node-socket" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (case DirectOptions
o.nodeSocket of File String
p -> String
p)
      ]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> case DirectOptions
o.networkId of
          NetworkId
Mainnet -> [Key
"mainnet" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
True]
          Testnet (NetworkMagic Word32
n) -> [Key
"testnet-magic" Key -> Word32 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32
n]
  renderBackend (Blockfrost BlockfrostOptions
o) =
    [Pair] -> Value
object
      [ Key
"mode" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"blockfrost" :: Text)
      , Key
"project-path" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BlockfrostOptions
o.projectPath
      ]

  renderChainPoint :: ChainPoint -> Text
  renderChainPoint :: ChainPoint -> Text
renderChainPoint ChainPoint
ChainPointAtGenesis = Text
"0"
  renderChainPoint (ChainPoint (SlotNo Word64
s) Hash BlockHeader
h) = String -> Text
T.pack (Word64 -> String
forall b a. (Show a, IsString b) => a -> b
show Word64
s) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Hash BlockHeader -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash BlockHeader
h