module Hydra.Node.Run where

import Hydra.Prelude hiding (fromList)

import Cardano.Ledger.BaseTypes (Globals (..), boundRational, mkActiveSlotCoeff, unNonZero)
import Cardano.Ledger.Shelley.API (computeRandomnessStabilisationWindow, computeStabilityWindow)
import Cardano.Slotting.EpochInfo (fixedEpochInfo, hoistEpochInfo)
import Cardano.Slotting.Time (mkSlotLength)
import Control.Monad.Trans.Except (runExcept)
import Hydra.API.Server (APIServerConfig (..), withAPIServer)
import Hydra.API.ServerOutputFilter (serverOutputFilter)
import Hydra.Cardano.Api (EraHistory (EraHistory), GenesisParameters (..), LedgerEra, PParams, ProtocolParametersConversionError, ShelleyEra, SystemStart (..), Tx, toShelleyNetwork)
import Hydra.Chain (ChainComponent, ChainStateHistory, maximumNumberOfParties)
import Hydra.Chain.Backend (ChainBackend (queryEraHistory, queryGenesisParameters))
import Hydra.Chain.Blockfrost (runBlockfrostBackend)
import Hydra.Chain.Cardano (withCardanoChain)
import Hydra.Chain.CardanoClient (QueryPoint (..))
import Hydra.Chain.ChainState (IsChainState (..))
import Hydra.Chain.Direct (runDirectBackend)
import Hydra.Chain.Direct.State (initialChainState)
import Hydra.Chain.Offline (loadGenesisFile, withOfflineChain)
import Hydra.Contract.KZGTrustedSetup qualified as KZG
import Hydra.Events (EventSink)
import Hydra.Events.Rotation (EventStore (..), RotationConfig (..), newRotatedEventStore)
import Hydra.Events.SQLiteBased (withSQLiteEventStore)
import Hydra.HeadLogic (aggregateNodeState)
import Hydra.HeadLogic.StateEvent (StateEvent (StateEvent, stateChanged), mkCheckpoint)
import Hydra.Ledger (Ledger)
import Hydra.Ledger.Cardano (cardanoLedger, newLedgerEnv)
import Hydra.Logging (Tracer, traceWith, withTracer)
import Hydra.Logging.Messages (HydraLog (..))
import Hydra.Logging.Monitoring (withMonitoring)
import Hydra.Node (
  HydraNode (eventSinks),
  chainStateHistory,
  connect,
  hydrate,
  initEnvironment,
  runHydraNode,
  wireChainInput,
  wireClientInput,
  wireNetworkInput,
 )
import Hydra.Node.Environment (Environment (..))
import Hydra.Node.Network (NetworkConfiguration (..), withNetwork)
import Hydra.Node.State (NodeState (..), initNodeState)
import Hydra.Options (
  CardanoChainConfig (..),
  ChainBackendOptions (..),
  ChainConfig (..),
  InvalidOptions (..),
  LedgerConfig (..),
  OfflineChainConfig (..),
  RunOptions (..),
  validateRunOptions,
 )
import Hydra.Utils (readJsonFileThrow)
import Ouroboros.Consensus.HardFork.History qualified as Consensus
import System.FilePath ((</>))

data ConfigurationException
  = -- XXX: this is not used
    ConfigurationException ProtocolParametersConversionError
  | InvalidOptionException InvalidOptions
  | TrustedSetupException KZG.KZGSetupError
  deriving stock (Int -> ConfigurationException -> ShowS
[ConfigurationException] -> ShowS
ConfigurationException -> String
(Int -> ConfigurationException -> ShowS)
-> (ConfigurationException -> String)
-> ([ConfigurationException] -> ShowS)
-> Show ConfigurationException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfigurationException -> ShowS
showsPrec :: Int -> ConfigurationException -> ShowS
$cshow :: ConfigurationException -> String
show :: ConfigurationException -> String
$cshowList :: [ConfigurationException] -> ShowS
showList :: [ConfigurationException] -> ShowS
Show)

instance Exception ConfigurationException where
  displayException :: ConfigurationException -> String
displayException = \case
    InvalidOptionException InvalidOptions
MaximumNumberOfPartiesExceeded ->
      String
"Maximum number of parties is currently set to: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall b a. (Show a, IsString b) => a -> b
show Int
maximumNumberOfParties
    InvalidOptionException InvalidOptions
CardanoAndHydraKeysMismatch ->
      String
"Number of loaded cardano and hydra keys needs to match"
    ConfigurationException ProtocolParametersConversionError
err ->
      String
"Incorrect protocol parameters configuration provided: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ProtocolParametersConversionError -> String
forall b a. (Show a, IsString b) => a -> b
show ProtocolParametersConversionError
err
    TrustedSetupException KZGSetupError
err ->
      String
"Embedded KZG trusted setup could not be loaded: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> KZGSetupError -> String
forall b a. (Show a, IsString b) => a -> b
show KZGSetupError
err

run :: RunOptions -> IO ()
run :: RunOptions -> IO ()
run RunOptions
opts = do
  (InvalidOptions -> IO ())
-> (() -> IO ()) -> Either InvalidOptions () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ConfigurationException -> IO ()
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (ConfigurationException -> IO ())
-> (InvalidOptions -> ConfigurationException)
-> InvalidOptions
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InvalidOptions -> ConfigurationException
InvalidOptionException) () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either InvalidOptions () -> IO ())
-> Either InvalidOptions () -> IO ()
forall a b. (a -> b) -> a -> b
$ RunOptions -> Either InvalidOptions ()
validateRunOptions RunOptions
opts
  Verbosity -> (Tracer IO (HydraLog Tx) -> IO ()) -> IO ()
forall (m :: * -> *) msg a.
(MonadIO m, MonadFork m, MonadTime m, ToJSON msg) =>
Verbosity -> (Tracer m msg -> IO a) -> IO a
withTracer Verbosity
verbosity ((Tracer IO (HydraLog Tx) -> IO ()) -> IO ())
-> (Tracer IO (HydraLog Tx) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Tracer IO (HydraLog Tx)
tracer' -> do
    Tracer IO (HydraLog Tx) -> HydraLog Tx -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog Tx)
tracer' (RunOptions -> HydraLog Tx
forall tx. RunOptions -> HydraLog tx
NodeOptions RunOptions
opts)
    -- Force the KZG trusted setup before opening any socket, so that the API
    -- server only starts once it is in memory and clients cannot connect and
    -- time out waiting for HeadIsOpen mid warm-up (see 'KZG.warmup'). Traced
    -- because it is the one startup step with no bound on how long it takes.
    Tracer IO (HydraLog Tx) -> HydraLog Tx -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog Tx)
tracer' HydraLog Tx
forall tx. HydraLog tx
LoadingTrustedSetup
    Int
numG1Points <- (KZGSetupError -> IO Int)
-> (Int -> IO Int) -> Either KZGSetupError Int -> IO Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ConfigurationException -> IO Int
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (ConfigurationException -> IO Int)
-> (KZGSetupError -> ConfigurationException)
-> KZGSetupError
-> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KZGSetupError -> ConfigurationException
TrustedSetupException) Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either KZGSetupError Int
KZG.warmup
    Tracer IO (HydraLog Tx) -> HydraLog Tx -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog Tx)
tracer' TrustedSetupLoaded{Int
numG1Points :: Int
$sel:numG1Points:DirectChain :: Int
numG1Points}
    Maybe PortNumber
-> Tracer IO (HydraLog Tx)
-> (Tracer IO (HydraLog Tx) -> IO ())
-> IO ()
forall (m :: * -> *) tx.
(MonadIO m, MonadAsync m, IsTx tx, MonadMonotonicTime m,
 MonadTime m, MonadLabelledSTM m) =>
Maybe PortNumber
-> Tracer m (HydraLog tx)
-> (Tracer m (HydraLog tx) -> m ())
-> m ()
withMonitoring Maybe PortNumber
monitoringPort Tracer IO (HydraLog Tx)
tracer' ((Tracer IO (HydraLog Tx) -> IO ()) -> IO ())
-> (Tracer IO (HydraLog Tx) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Tracer IO (HydraLog Tx)
tracer -> do
      env :: Environment
env@Environment{Party
party :: Party
$sel:party:Environment :: Environment -> Party
party, [Party]
otherParties :: [Party]
$sel:otherParties:Environment :: Environment -> [Party]
otherParties, Secret (SigningKey HydraKey)
signingKey :: Secret (SigningKey HydraKey)
$sel:signingKey:Environment :: Environment -> Secret (SigningKey HydraKey)
signingKey} <- RunOptions -> IO Environment
initEnvironment RunOptions
opts
      -- Ledger
      PParams ConwayEra
pparams <- (Value -> Parser (PParams ConwayEra))
-> String -> IO (PParams ConwayEra)
forall a. (Value -> Parser a) -> String -> IO a
readJsonFileThrow Value -> Parser (PParams ConwayEra)
forall a. FromJSON a => Value -> Parser a
parseJSON (LedgerConfig -> String
cardanoLedgerProtocolParametersFile LedgerConfig
ledgerConfig)
      Globals
globals <- ChainConfig -> IO Globals
getGlobalsForChain ChainConfig
chainConfig
      PParams LedgerEra -> Globals -> (Ledger Tx -> IO ()) -> IO ()
forall {k} (m :: k -> *) (a :: k).
PParams LedgerEra -> Globals -> (Ledger Tx -> m a) -> m a
withCardanoLedger PParams ConwayEra
PParams LedgerEra
pparams Globals
globals ((Ledger Tx -> IO ()) -> IO ()) -> (Ledger Tx -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ledger Tx
ledger -> do
        -- Hydrate with event source and sinks
        let stateFile :: String
stateFile = String
persistenceDir String -> ShowS
</> String
"state"
            dbFile :: String
dbFile = String
persistenceDir String -> ShowS
</> String
"hydra.db"
        Tracer IO SQLiteLog
-> String
-> String
-> (EventStore (StateEvent Tx) IO -> IO ())
-> IO ()
forall e a.
(ToCBOR e, FromCBOR e, FromJSON e, HasEventId e) =>
Tracer IO SQLiteLog
-> String -> String -> (EventStore e IO -> IO a) -> IO a
withSQLiteEventStore ((SQLiteLog -> HydraLog Tx)
-> Tracer IO (HydraLog Tx) -> Tracer IO SQLiteLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap SQLiteLog -> HydraLog Tx
forall tx. SQLiteLog -> HydraLog tx
SQLite Tracer IO (HydraLog Tx)
tracer') String
dbFile String
stateFile ((EventStore (StateEvent Tx) IO -> IO ()) -> IO ())
-> (EventStore (StateEvent Tx) IO -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \EventStore (StateEvent Tx) IO
store -> do
          eventStore :: EventStore (StateEvent Tx) IO
eventStore@EventStore{EventSource (StateEvent Tx) IO
eventSource :: EventSource (StateEvent Tx) IO
$sel:eventSource:EventStore :: forall e (m :: * -> *). EventStore e m -> EventSource e m
eventSource} <- EventStore (StateEvent Tx) IO -> IO (EventStore (StateEvent Tx) IO)
prepareEventStore EventStore (StateEvent Tx) IO
store
          -- NOTE: Add any custom sinks here
          let [EventSink (StateEvent Tx) IO]
eventSinks :: [EventSink (StateEvent Tx) IO] = []
          DraftHydraNode Tx IO
wetHydraNode <- Tracer IO (HydraNodeLog Tx)
-> Environment
-> Ledger Tx
-> ChainStateType Tx
-> EventStore (StateEvent Tx) IO
-> [EventSink (StateEvent Tx) IO]
-> IO (DraftHydraNode Tx IO)
forall tx (m :: * -> *).
(IsChainState tx, MonadDelay m, MonadLabelledSTM m, MonadAsync m,
 MonadThrow m, MonadUnliftIO m) =>
Tracer m (HydraNodeLog tx)
-> Environment
-> Ledger tx
-> ChainStateType tx
-> EventStore (StateEvent tx) m
-> [EventSink (StateEvent tx) m]
-> m (DraftHydraNode tx m)
hydrate ((HydraNodeLog Tx -> HydraLog Tx)
-> Tracer IO (HydraLog Tx) -> Tracer IO (HydraNodeLog Tx)
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog Tx -> HydraLog Tx
forall tx. HydraNodeLog tx -> HydraLog tx
Node Tracer IO (HydraLog Tx)
tracer) Environment
env Ledger Tx
ledger ChainStateType Tx
initialChainState EventStore (StateEvent Tx) IO
eventStore [EventSink (StateEvent Tx) IO]
eventSinks
          Tracer IO (HydraLog Tx) -> HydraLog Tx -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog Tx)
tracer' HydraLog Tx
forall tx. HydraLog tx
NodeHydrated
          -- Chain
          ChainStateHistory Tx -> ChainComponent Tx IO ()
withChain <- Tracer IO (HydraLog Tx)
-> Environment
-> ChainConfig
-> IO (ChainStateHistory Tx -> ChainComponent Tx IO ())
forall (m :: * -> *) tx a.
Monad m =>
Tracer IO (HydraLog tx)
-> Environment
-> ChainConfig
-> m (ChainStateHistory Tx -> ChainComponent Tx IO a)
prepareChainComponent Tracer IO (HydraLog Tx)
tracer Environment
env ChainConfig
chainConfig
          ChainStateHistory Tx -> ChainComponent Tx IO ()
withChain (DraftHydraNode Tx IO -> ChainStateHistory Tx
forall tx (m :: * -> *).
DraftHydraNode tx m -> ChainStateHistory tx
chainStateHistory DraftHydraNode Tx IO
wetHydraNode) (DraftHydraNode Tx IO -> ChainEvent Tx -> IO ()
forall tx (m :: * -> *).
DraftHydraNode tx m -> ChainEvent tx -> m ()
wireChainInput DraftHydraNode Tx IO
wetHydraNode) ((Chain Tx IO -> IO ()) -> IO ())
-> (Chain Tx IO -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Chain Tx IO
chain -> do
            Tracer IO (HydraLog Tx) -> HydraLog Tx -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog Tx)
tracer' HydraLog Tx
forall tx. HydraLog tx
ChainBackendStarted
            -- API
            let apiServerConfig :: APIServerConfig
apiServerConfig = APIServerConfig{$sel:host:APIServerConfig :: IP
host = IP
apiHost, $sel:port:APIServerConfig :: PortNumber
port = PortNumber
apiPort, Maybe String
tlsCertPath :: Maybe String
$sel:tlsCertPath:APIServerConfig :: Maybe String
tlsCertPath, Maybe String
tlsKeyPath :: Maybe String
$sel:tlsKeyPath:APIServerConfig :: Maybe String
tlsKeyPath, ApiTransactionTimeout
apiTransactionTimeout :: ApiTransactionTimeout
$sel:apiTransactionTimeout:APIServerConfig :: ApiTransactionTimeout
apiTransactionTimeout}
            APIServerConfig
-> RunOptions
-> Environment
-> Party
-> EventSource (StateEvent Tx) IO
-> Tracer IO APIServerLog
-> ChainStateType Tx
-> Chain Tx IO
-> PParams LedgerEra
-> ServerOutputFilter Tx
-> (ClientInput Tx -> IO ())
-> ((EventSink (StateEvent Tx) IO, Server Tx IO) -> IO ())
-> IO ()
forall tx.
IsChainState tx =>
APIServerConfig
-> RunOptions
-> Environment
-> Party
-> EventSource (StateEvent tx) IO
-> Tracer IO APIServerLog
-> ChainStateType tx
-> Chain tx IO
-> PParams LedgerEra
-> ServerOutputFilter tx
-> (ClientInput tx -> IO ())
-> ((EventSink (StateEvent tx) IO, Server tx IO) -> IO ())
-> IO ()
withAPIServer APIServerConfig
apiServerConfig RunOptions
opts Environment
env Party
party EventSource (StateEvent Tx) IO
eventSource ((APIServerLog -> HydraLog Tx)
-> Tracer IO (HydraLog Tx) -> Tracer IO APIServerLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap APIServerLog -> HydraLog Tx
forall tx. APIServerLog -> HydraLog tx
APIServer Tracer IO (HydraLog Tx)
tracer) ChainStateType Tx
initialChainState Chain Tx IO
chain PParams ConwayEra
PParams LedgerEra
pparams ServerOutputFilter Tx
serverOutputFilter (DraftHydraNode Tx IO -> ClientInput Tx -> IO ()
forall tx (m :: * -> *).
DraftHydraNode tx m -> ClientInput tx -> m ()
wireClientInput DraftHydraNode Tx IO
wetHydraNode) (((EventSink (StateEvent Tx) IO, Server Tx IO) -> IO ()) -> IO ())
-> ((EventSink (StateEvent Tx) IO, Server Tx IO) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(EventSink (StateEvent Tx) IO
apiSink, Server Tx IO
server) -> do
              -- Network
              let networkConfiguration :: NetworkConfiguration
networkConfiguration =
                    NetworkConfiguration
                      { String
persistenceDir :: String
$sel:persistenceDir:NetworkConfiguration :: String
persistenceDir
                      , Secret (SigningKey HydraKey)
signingKey :: Secret (SigningKey HydraKey)
$sel:signingKey:NetworkConfiguration :: Secret (SigningKey HydraKey)
signingKey
                      , [Party]
otherParties :: [Party]
$sel:otherParties:NetworkConfiguration :: [Party]
otherParties
                      , Host
listen :: Host
$sel:listen:NetworkConfiguration :: Host
listen
                      , $sel:advertise:NetworkConfiguration :: Host
advertise = Host -> Maybe Host -> Host
forall a. a -> Maybe a -> a
fromMaybe Host
listen Maybe Host
advertise
                      , [Host]
peers :: [Host]
$sel:peers:NetworkConfiguration :: [Host]
peers
                      , NodeId
nodeId :: NodeId
$sel:nodeId:NetworkConfiguration :: NodeId
nodeId
                      , WhichEtcd
whichEtcd :: WhichEtcd
$sel:whichEtcd:NetworkConfiguration :: WhichEtcd
whichEtcd
                      }
              Tracer IO NetworkLog
-> NetworkConfiguration
-> NetworkComponent IO (Authenticated (Message Tx)) (Message Tx) ()
forall tx.
IsTx tx =>
Tracer IO NetworkLog
-> NetworkConfiguration
-> NetworkComponent IO (Authenticated (Message tx)) (Message tx) ()
withNetwork
                ((NetworkLog -> HydraLog Tx)
-> Tracer IO (HydraLog Tx) -> Tracer IO NetworkLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap NetworkLog -> HydraLog Tx
forall tx. NetworkLog -> HydraLog tx
Network Tracer IO (HydraLog Tx)
tracer)
                NetworkConfiguration
networkConfiguration
                (DraftHydraNode Tx IO
-> NetworkCallback (Authenticated (Message Tx)) IO
forall tx (m :: * -> *).
DraftHydraNode tx m
-> NetworkCallback (Authenticated (Message tx)) m
wireNetworkInput DraftHydraNode Tx IO
wetHydraNode)
                ((Network IO (Message Tx) -> IO ()) -> IO ())
-> (Network IO (Message Tx) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Network IO (Message Tx)
network -> do
                  Tracer IO (HydraLog Tx) -> HydraLog Tx -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog Tx)
tracer' HydraLog Tx
forall tx. HydraLog tx
NetworkStarted
                  -- Main loop
                  HydraNode Tx IO
node <-
                    Chain Tx IO
-> Network IO (Message Tx)
-> Server Tx IO
-> DraftHydraNode Tx IO
-> IO (HydraNode Tx IO)
forall (m :: * -> *) tx.
Monad m =>
Chain tx m
-> Network m (Message tx)
-> Server tx m
-> DraftHydraNode tx m
-> m (HydraNode tx m)
connect Chain Tx IO
chain Network IO (Message Tx)
network Server Tx IO
server DraftHydraNode Tx IO
wetHydraNode
                      IO (HydraNode Tx IO)
-> (HydraNode Tx IO -> HydraNode Tx IO) -> IO (HydraNode Tx IO)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> EventSink (StateEvent Tx) IO -> HydraNode Tx IO -> HydraNode Tx IO
forall tx (m :: * -> *).
EventSink (StateEvent tx) m -> HydraNode tx m -> HydraNode tx m
addEventSink EventSink (StateEvent Tx) IO
apiSink
                  Tracer IO (HydraLog Tx) -> HydraLog Tx -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO (HydraLog Tx)
tracer' HydraLog Tx
forall tx. HydraLog tx
EnteringMainloop
                  HydraNode Tx IO -> IO ()
forall (m :: * -> *) tx.
(MonadCatch m, MonadAsync m, MonadTime m, IsChainState tx) =>
HydraNode tx m -> m ()
runHydraNode HydraNode Tx IO
node
 where
  addEventSink :: EventSink (StateEvent tx) m -> HydraNode tx m -> HydraNode tx m
  addEventSink :: forall tx (m :: * -> *).
EventSink (StateEvent tx) m -> HydraNode tx m -> HydraNode tx m
addEventSink EventSink (StateEvent tx) m
sink HydraNode tx m
node = HydraNode tx m
node{eventSinks = sink : eventSinks node}

  withCardanoLedger :: PParams LedgerEra -> Globals -> (Ledger Tx -> m a) -> m a
  withCardanoLedger :: forall {k} (m :: k -> *) (a :: k).
PParams LedgerEra -> Globals -> (Ledger Tx -> m a) -> m a
withCardanoLedger PParams LedgerEra
protocolParams Globals
globals Ledger Tx -> m a
action =
    let ledgerEnv :: LedgerEnv LedgerEra
ledgerEnv = PParams LedgerEra -> LedgerEnv LedgerEra
newLedgerEnv PParams LedgerEra
protocolParams
     in Ledger Tx -> m a
action (Globals -> LedgerEnv LedgerEra -> Ledger Tx
cardanoLedger Globals
globals LedgerEnv LedgerEra
ledgerEnv)

  prepareChainComponent ::
    Monad m =>
    Tracer IO (HydraLog tx) ->
    Environment ->
    ChainConfig ->
    m (ChainStateHistory Tx -> ChainComponent Tx IO a)
  prepareChainComponent :: forall (m :: * -> *) tx a.
Monad m =>
Tracer IO (HydraLog tx)
-> Environment
-> ChainConfig
-> m (ChainStateHistory Tx -> ChainComponent Tx IO a)
prepareChainComponent Tracer IO (HydraLog tx)
tracer Environment{Party
$sel:party:Environment :: Environment -> Party
party :: Party
party, [Party]
$sel:otherParties:Environment :: Environment -> [Party]
otherParties :: [Party]
otherParties} = \case
    Offline OfflineChainConfig
cfg -> (ChainStateHistory Tx -> ChainComponent Tx IO a)
-> m (ChainStateHistory Tx -> ChainComponent Tx IO a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ChainStateHistory Tx -> ChainComponent Tx IO a)
 -> m (ChainStateHistory Tx -> ChainComponent Tx IO a))
-> (ChainStateHistory Tx -> ChainComponent Tx IO a)
-> m (ChainStateHistory Tx -> ChainComponent Tx IO a)
forall a b. (a -> b) -> a -> b
$ OfflineChainConfig
-> Party
-> [Party]
-> ChainStateHistory Tx
-> ChainComponent Tx IO a
forall a.
OfflineChainConfig
-> Party
-> [Party]
-> ChainStateHistory Tx
-> ChainComponent Tx IO a
withOfflineChain OfflineChainConfig
cfg Party
party [Party]
otherParties
    Cardano CardanoChainConfig
cfg -> (ChainStateHistory Tx -> ChainComponent Tx IO a)
-> m (ChainStateHistory Tx -> ChainComponent Tx IO a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ChainStateHistory Tx -> ChainComponent Tx IO a)
 -> m (ChainStateHistory Tx -> ChainComponent Tx IO a))
-> (ChainStateHistory Tx -> ChainComponent Tx IO a)
-> m (ChainStateHistory Tx -> ChainComponent Tx IO a)
forall a b. (a -> b) -> a -> b
$ Tracer IO CardanoChainLog
-> CardanoChainConfig
-> Party
-> ChainStateHistory Tx
-> ChainComponent Tx IO a
forall a.
Tracer IO CardanoChainLog
-> CardanoChainConfig
-> Party
-> ChainStateHistory Tx
-> ChainComponent Tx IO a
withCardanoChain ((CardanoChainLog -> HydraLog tx)
-> Tracer IO (HydraLog tx) -> Tracer IO CardanoChainLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap CardanoChainLog -> HydraLog tx
forall tx. CardanoChainLog -> HydraLog tx
DirectChain Tracer IO (HydraLog tx)
tracer) CardanoChainConfig
cfg Party
party

  prepareEventStore :: EventStore (StateEvent Tx) IO -> IO (EventStore (StateEvent Tx) IO)
prepareEventStore EventStore (StateEvent Tx) IO
eventStore = do
    case Positive Natural -> RotationConfig
RotateAfter (Positive Natural -> RotationConfig)
-> Maybe (Positive Natural) -> Maybe RotationConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Positive Natural)
persistenceRotateAfter of
      Maybe RotationConfig
Nothing ->
        EventStore (StateEvent Tx) IO -> IO (EventStore (StateEvent Tx) IO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EventStore (StateEvent Tx) IO
eventStore
      Just RotationConfig
rotationConfig -> do
        let initialState :: NodeState Tx
initialState = ChainStateType Tx -> NodeState Tx
forall tx. IsChainState tx => ChainStateType tx -> NodeState tx
initNodeState ChainStateType Tx
initialChainState
        let aggregator :: IsChainState tx => NodeState tx -> StateEvent tx -> NodeState tx
            aggregator :: forall tx.
IsChainState tx =>
NodeState tx -> StateEvent tx -> NodeState tx
aggregator NodeState tx
s StateEvent{StateChanged tx
$sel:stateChanged:StateEvent :: forall tx. StateEvent tx -> StateChanged tx
stateChanged :: StateChanged tx
stateChanged} = NodeState tx -> StateChanged tx -> NodeState tx
forall tx.
IsChainState tx =>
NodeState tx -> StateChanged tx -> NodeState tx
aggregateNodeState NodeState tx
s StateChanged tx
stateChanged
        RotationConfig
-> NodeState Tx
-> (NodeState Tx -> StateEvent Tx -> NodeState Tx)
-> (NodeState Tx -> EventId -> UTCTime -> StateEvent Tx)
-> EventStore (StateEvent Tx) IO
-> IO (EventStore (StateEvent Tx) IO)
forall e (m :: * -> *) s.
(HasEventId e, MonadUnliftIO m, MonadTime m, MonadLabelledSTM m) =>
RotationConfig
-> s
-> (s -> e -> s)
-> (s -> EventId -> UTCTime -> e)
-> EventStore e m
-> m (EventStore e m)
newRotatedEventStore RotationConfig
rotationConfig NodeState Tx
initialState NodeState Tx -> StateEvent Tx -> NodeState Tx
forall tx.
IsChainState tx =>
NodeState tx -> StateEvent tx -> NodeState tx
aggregator NodeState Tx -> EventId -> UTCTime -> StateEvent Tx
forall tx. NodeState tx -> EventId -> UTCTime -> StateEvent tx
mkCheckpoint EventStore (StateEvent Tx) IO
eventStore

  RunOptions
    { Verbosity
verbosity :: Verbosity
$sel:verbosity:RunOptions :: RunOptions -> Verbosity
verbosity
    , Maybe PortNumber
monitoringPort :: Maybe PortNumber
$sel:monitoringPort:RunOptions :: RunOptions -> Maybe PortNumber
monitoringPort
    , String
persistenceDir :: String
$sel:persistenceDir:RunOptions :: RunOptions -> String
persistenceDir
    , Maybe (Positive Natural)
persistenceRotateAfter :: Maybe (Positive Natural)
$sel:persistenceRotateAfter:RunOptions :: RunOptions -> Maybe (Positive Natural)
persistenceRotateAfter
    , ChainConfig
chainConfig :: ChainConfig
$sel:chainConfig:RunOptions :: RunOptions -> ChainConfig
chainConfig
    , LedgerConfig
ledgerConfig :: LedgerConfig
$sel:ledgerConfig:RunOptions :: RunOptions -> LedgerConfig
ledgerConfig
    , Host
listen :: Host
$sel:listen:RunOptions :: RunOptions -> Host
listen
    , Maybe Host
advertise :: Maybe Host
$sel:advertise:RunOptions :: RunOptions -> Maybe Host
advertise
    , [Host]
peers :: [Host]
$sel:peers:RunOptions :: RunOptions -> [Host]
peers
    , NodeId
nodeId :: NodeId
$sel:nodeId:RunOptions :: RunOptions -> NodeId
nodeId
    , IP
apiHost :: IP
$sel:apiHost:RunOptions :: RunOptions -> IP
apiHost
    , PortNumber
apiPort :: PortNumber
$sel:apiPort:RunOptions :: RunOptions -> PortNumber
apiPort
    , Maybe String
tlsCertPath :: Maybe String
$sel:tlsCertPath:RunOptions :: RunOptions -> Maybe String
tlsCertPath
    , Maybe String
tlsKeyPath :: Maybe String
$sel:tlsKeyPath:RunOptions :: RunOptions -> Maybe String
tlsKeyPath
    , WhichEtcd
whichEtcd :: WhichEtcd
$sel:whichEtcd:RunOptions :: RunOptions -> WhichEtcd
whichEtcd
    , ApiTransactionTimeout
apiTransactionTimeout :: ApiTransactionTimeout
$sel:apiTransactionTimeout:RunOptions :: RunOptions -> ApiTransactionTimeout
apiTransactionTimeout
    } = RunOptions
opts

getGlobalsForChain :: ChainConfig -> IO Globals
getGlobalsForChain :: ChainConfig -> IO Globals
getGlobalsForChain = \case
  Offline OfflineChainConfig{Maybe String
ledgerGenesisFile :: Maybe String
$sel:ledgerGenesisFile:OfflineChainConfig :: OfflineChainConfig -> Maybe String
ledgerGenesisFile} ->
    -- Offline/devnet: single era, fixedEpochInfo is correct
    Maybe String -> IO (GenesisParameters ShelleyEra)
loadGenesisFile Maybe String
ledgerGenesisFile
      IO (GenesisParameters ShelleyEra)
-> (GenesisParameters ShelleyEra -> IO Globals) -> IO Globals
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GenesisParameters ShelleyEra -> IO Globals
forall (m :: * -> *).
MonadThrow m =>
GenesisParameters ShelleyEra -> m Globals
newGlobals
  Cardano CardanoChainConfig{ChainBackendOptions
chainBackendOptions :: ChainBackendOptions
$sel:chainBackendOptions:CardanoChainConfig :: CardanoChainConfig -> ChainBackendOptions
chainBackendOptions} ->
    -- Online mode: query era history from the chain for correct
    -- slot-to-time conversions in Plutus script evaluation.
    case ChainBackendOptions
chainBackendOptions of
      Direct DirectOptions
directOptions -> DirectOptions -> DirectBackend Globals -> IO Globals
forall a. DirectOptions -> DirectBackend a -> IO a
runDirectBackend DirectOptions
directOptions DirectBackend Globals
forall (m :: * -> *). (ChainBackend m, MonadThrow m) => m Globals
globalsFromBackend
      Blockfrost BlockfrostOptions
blockfrostOptions -> BlockfrostOptions -> BlockfrostBackend Globals -> IO Globals
forall a. BlockfrostOptions -> BlockfrostBackend a -> IO a
runBlockfrostBackend BlockfrostOptions
blockfrostOptions BlockfrostBackend Globals
forall (m :: * -> *). (ChainBackend m, MonadThrow m) => m Globals
globalsFromBackend
 where
  globalsFromBackend :: (ChainBackend m, MonadThrow m) => m Globals
  globalsFromBackend :: forall (m :: * -> *). (ChainBackend m, MonadThrow m) => m Globals
globalsFromBackend = do
    GenesisParameters ShelleyEra
genesis <- m (GenesisParameters ShelleyEra)
forall (m :: * -> *).
ChainBackend m =>
m (GenesisParameters ShelleyEra)
queryGenesisParameters
    EraHistory
eraHistory <- QueryPoint -> m EraHistory
forall (m :: * -> *). ChainBackend m => QueryPoint -> m EraHistory
queryEraHistory QueryPoint
QueryTip
    GenesisParameters ShelleyEra -> EraHistory -> m Globals
forall (m :: * -> *).
MonadThrow m =>
GenesisParameters ShelleyEra -> EraHistory -> m Globals
newGlobalsWithEraHistory GenesisParameters ShelleyEra
genesis EraHistory
eraHistory

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

instance Exception GlobalsTranslationException

-- | Create new L2 ledger 'Globals' from 'GenesisParameters'.
--
-- Throws at least 'GlobalsTranslationException'
newGlobals :: MonadThrow m => GenesisParameters ShelleyEra -> m Globals
newGlobals :: forall (m :: * -> *).
MonadThrow m =>
GenesisParameters ShelleyEra -> m Globals
newGlobals GenesisParameters ShelleyEra
genesisParameters = do
  case PositiveUnitInterval -> ActiveSlotCoeff
mkActiveSlotCoeff (PositiveUnitInterval -> ActiveSlotCoeff)
-> Maybe PositiveUnitInterval -> Maybe ActiveSlotCoeff
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rational -> Maybe PositiveUnitInterval
forall r. BoundedRational r => Rational -> Maybe r
boundRational Rational
protocolParamActiveSlotsCoefficient of
    Maybe ActiveSlotCoeff
Nothing -> GlobalsTranslationException -> m Globals
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO GlobalsTranslationException
GlobalsTranslationException
    Just ActiveSlotCoeff
slotCoeff -> do
      let k :: EventId
k = NonZero EventId -> EventId
forall a. NonZero a -> a
unNonZero NonZero EventId
protocolParamSecurity
      Globals -> m Globals
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Globals -> m Globals) -> Globals -> m Globals
forall a b. (a -> b) -> a -> b
$
        Globals
          { activeSlotCoeff :: ActiveSlotCoeff
activeSlotCoeff = ActiveSlotCoeff
slotCoeff
          , EpochInfo (Either Text)
epochInfo :: EpochInfo (Either Text)
epochInfo :: EpochInfo (Either Text)
epochInfo
          , maxKESEvo :: EventId
maxKESEvo = Int -> EventId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
protocolParamMaxKESEvolutions
          , maxLovelaceSupply :: EventId
maxLovelaceSupply = Coin -> EventId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Coin
protocolParamMaxLovelaceSupply
          , networkId :: Network
networkId = NetworkId -> Network
toShelleyNetwork NetworkId
protocolParamNetworkId
          , quorum :: EventId
quorum = Int -> EventId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
protocolParamUpdateQuorum
          , randomnessStabilisationWindow :: EventId
randomnessStabilisationWindow = EventId -> ActiveSlotCoeff -> EventId
computeRandomnessStabilisationWindow EventId
k ActiveSlotCoeff
slotCoeff
          , securityParameter :: NonZero EventId
securityParameter = NonZero EventId
protocolParamSecurity
          , slotsPerKESPeriod :: EventId
slotsPerKESPeriod = Int -> EventId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
protocolParamSlotsPerKESPeriod
          , stabilityWindow :: EventId
stabilityWindow = EventId -> ActiveSlotCoeff -> EventId
computeStabilityWindow EventId
k ActiveSlotCoeff
slotCoeff
          , systemStart :: SystemStart
systemStart = UTCTime -> SystemStart
SystemStart UTCTime
protocolParamSystemStart
          }
 where
  GenesisParameters
    { Int
protocolParamSlotsPerKESPeriod :: Int
protocolParamSlotsPerKESPeriod :: forall era. GenesisParameters era -> Int
protocolParamSlotsPerKESPeriod
    , Int
protocolParamUpdateQuorum :: Int
protocolParamUpdateQuorum :: forall era. GenesisParameters era -> Int
protocolParamUpdateQuorum
    , Coin
protocolParamMaxLovelaceSupply :: Coin
protocolParamMaxLovelaceSupply :: forall era. GenesisParameters era -> Coin
protocolParamMaxLovelaceSupply
    , NonZero EventId
protocolParamSecurity :: NonZero EventId
protocolParamSecurity :: forall era. GenesisParameters era -> NonZero EventId
protocolParamSecurity
    , Rational
protocolParamActiveSlotsCoefficient :: Rational
protocolParamActiveSlotsCoefficient :: forall era. GenesisParameters era -> Rational
protocolParamActiveSlotsCoefficient
    , UTCTime
protocolParamSystemStart :: UTCTime
protocolParamSystemStart :: forall era. GenesisParameters era -> UTCTime
protocolParamSystemStart
    , NetworkId
protocolParamNetworkId :: NetworkId
protocolParamNetworkId :: forall era. GenesisParameters era -> NetworkId
protocolParamNetworkId
    , Int
protocolParamMaxKESEvolutions :: Int
protocolParamMaxKESEvolutions :: forall era. GenesisParameters era -> Int
protocolParamMaxKESEvolutions
    , EpochSize
protocolParamEpochLength :: EpochSize
protocolParamEpochLength :: forall era. GenesisParameters era -> EpochSize
protocolParamEpochLength
    , NominalDiffTime
protocolParamSlotLength :: NominalDiffTime
protocolParamSlotLength :: forall era. GenesisParameters era -> NominalDiffTime
protocolParamSlotLength
    } = GenesisParameters ShelleyEra
genesisParameters
  -- NOTE: uses fixed epoch info for our L2 ledger (only correct for devnet/offline)
  epochInfo :: EpochInfo (Either Text)
epochInfo = EpochSize -> SlotLength -> EpochInfo (Either Text)
forall (m :: * -> *).
Monad m =>
EpochSize -> SlotLength -> EpochInfo m
fixedEpochInfo EpochSize
protocolParamEpochLength SlotLength
slotLength
  slotLength :: SlotLength
slotLength = NominalDiffTime -> SlotLength
mkSlotLength NominalDiffTime
protocolParamSlotLength

-- | Create new L2 ledger 'Globals' using a proper 'EraHistory' for era-aware
-- slot-to-time conversions. This ensures Plutus scripts receive correct
-- POSIXTime values in their ScriptContext on multi-era chains (mainnet/testnet).
--
-- The last era of the given 'EraHistory' is extended to be unbounded, because
-- the queried era history has a forecast horizon anchored at the tip when the
-- node started. As these 'Globals' are used for the lifetime of the hydra-node,
-- a node running longer than the horizon (3k/f slots, i.e. 36 hours on
-- mainnet) would otherwise reject every Plutus transaction with a validity
-- bound as 'OutsideForecast'. Extending assumes the current era's slot length
-- does not change, matching the linear extrapolation the ledger already
-- applies to time translations via 'unsafeLinearExtendEpochInfo'.
--
-- Throws at least 'GlobalsTranslationException'
newGlobalsWithEraHistory :: MonadThrow m => GenesisParameters ShelleyEra -> EraHistory -> m Globals
newGlobalsWithEraHistory :: forall (m :: * -> *).
MonadThrow m =>
GenesisParameters ShelleyEra -> EraHistory -> m Globals
newGlobalsWithEraHistory GenesisParameters ShelleyEra
genesisParameters (EraHistory Interpreter xs
interpreter) = do
  case PositiveUnitInterval -> ActiveSlotCoeff
mkActiveSlotCoeff (PositiveUnitInterval -> ActiveSlotCoeff)
-> Maybe PositiveUnitInterval -> Maybe ActiveSlotCoeff
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rational -> Maybe PositiveUnitInterval
forall r. BoundedRational r => Rational -> Maybe r
boundRational Rational
protocolParamActiveSlotsCoefficient of
    Maybe ActiveSlotCoeff
Nothing -> GlobalsTranslationException -> m Globals
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO GlobalsTranslationException
GlobalsTranslationException
    Just ActiveSlotCoeff
slotCoeff -> do
      let k :: EventId
k = NonZero EventId -> EventId
forall a. NonZero a -> a
unNonZero NonZero EventId
protocolParamSecurity
      Globals -> m Globals
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Globals -> m Globals) -> Globals -> m Globals
forall a b. (a -> b) -> a -> b
$
        Globals
          { activeSlotCoeff :: ActiveSlotCoeff
activeSlotCoeff = ActiveSlotCoeff
slotCoeff
          , epochInfo :: EpochInfo (Either Text)
epochInfo = EpochInfo (Either Text)
eraAwareEpochInfo
          , maxKESEvo :: EventId
maxKESEvo = Int -> EventId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
protocolParamMaxKESEvolutions
          , maxLovelaceSupply :: EventId
maxLovelaceSupply = Coin -> EventId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Coin
protocolParamMaxLovelaceSupply
          , networkId :: Network
networkId = NetworkId -> Network
toShelleyNetwork NetworkId
protocolParamNetworkId
          , quorum :: EventId
quorum = Int -> EventId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
protocolParamUpdateQuorum
          , randomnessStabilisationWindow :: EventId
randomnessStabilisationWindow = EventId -> ActiveSlotCoeff -> EventId
computeRandomnessStabilisationWindow EventId
k ActiveSlotCoeff
slotCoeff
          , securityParameter :: NonZero EventId
securityParameter = NonZero EventId
protocolParamSecurity
          , slotsPerKESPeriod :: EventId
slotsPerKESPeriod = Int -> EventId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
protocolParamSlotsPerKESPeriod
          , stabilityWindow :: EventId
stabilityWindow = EventId -> ActiveSlotCoeff -> EventId
computeStabilityWindow EventId
k ActiveSlotCoeff
slotCoeff
          , systemStart :: SystemStart
systemStart = UTCTime -> SystemStart
SystemStart UTCTime
protocolParamSystemStart
          }
 where
  GenesisParameters
    { Int
protocolParamSlotsPerKESPeriod :: forall era. GenesisParameters era -> Int
protocolParamSlotsPerKESPeriod :: Int
protocolParamSlotsPerKESPeriod
    , Int
protocolParamUpdateQuorum :: forall era. GenesisParameters era -> Int
protocolParamUpdateQuorum :: Int
protocolParamUpdateQuorum
    , Coin
protocolParamMaxLovelaceSupply :: forall era. GenesisParameters era -> Coin
protocolParamMaxLovelaceSupply :: Coin
protocolParamMaxLovelaceSupply
    , NonZero EventId
protocolParamSecurity :: forall era. GenesisParameters era -> NonZero EventId
protocolParamSecurity :: NonZero EventId
protocolParamSecurity
    , Rational
protocolParamActiveSlotsCoefficient :: forall era. GenesisParameters era -> Rational
protocolParamActiveSlotsCoefficient :: Rational
protocolParamActiveSlotsCoefficient
    , UTCTime
protocolParamSystemStart :: forall era. GenesisParameters era -> UTCTime
protocolParamSystemStart :: UTCTime
protocolParamSystemStart
    , NetworkId
protocolParamNetworkId :: forall era. GenesisParameters era -> NetworkId
protocolParamNetworkId :: NetworkId
protocolParamNetworkId
    , Int
protocolParamMaxKESEvolutions :: forall era. GenesisParameters era -> Int
protocolParamMaxKESEvolutions :: Int
protocolParamMaxKESEvolutions
    } = GenesisParameters ShelleyEra
genesisParameters
  eraAwareEpochInfo :: EpochInfo (Either Text)
eraAwareEpochInfo =
    (forall a. Except PastHorizonException a -> Either Text a)
-> EpochInfo (Except PastHorizonException)
-> EpochInfo (Either Text)
forall (m :: * -> *) (n :: * -> *).
(forall a. m a -> n a) -> EpochInfo m -> EpochInfo n
hoistEpochInfo ((PastHorizonException -> Text)
-> Either PastHorizonException a -> Either Text a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first PastHorizonException -> Text
forall b a. (Show a, IsString b) => a -> b
show (Either PastHorizonException a -> Either Text a)
-> (Except PastHorizonException a -> Either PastHorizonException a)
-> Except PastHorizonException a
-> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Except PastHorizonException a -> Either PastHorizonException a
forall e a. Except e a -> Either e a
runExcept) (EpochInfo (Except PastHorizonException)
 -> EpochInfo (Either Text))
-> EpochInfo (Except PastHorizonException)
-> EpochInfo (Either Text)
forall a b. (a -> b) -> a -> b
$
      Interpreter xs -> EpochInfo (Except PastHorizonException)
forall (xs :: [*]).
Interpreter xs -> EpochInfo (Except PastHorizonException)
Consensus.interpreterToEpochInfo (Interpreter xs -> Interpreter xs
forall (xs :: [*]). Interpreter xs -> Interpreter xs
Consensus.unsafeExtendSafeZone Interpreter xs
interpreter)