module Hydra.Node.Run where
import Hydra.Prelude hiding (fromList)
import Hydra.API.Server (Server (..), withAPIServer)
import Hydra.API.ServerOutput (ServerOutput (..))
import Hydra.Cardano.Api (
ProtocolParametersConversionError,
)
import Hydra.Chain (maximumNumberOfParties)
import Hydra.Chain.CardanoClient (QueryPoint (..), queryGenesisParameters)
import Hydra.Chain.Direct (loadChainContext, mkTinyWallet, withDirectChain)
import Hydra.Chain.Direct.State (initialChainState)
import Hydra.Chain.Offline (loadGenesisFile, withOfflineChain)
import Hydra.Environment (Environment (..))
import Hydra.Events.FileBased (eventPairFromPersistenceIncremental)
import Hydra.Ledger.Cardano qualified as Ledger
import Hydra.Ledger.Cardano.Configuration (
Globals,
newGlobals,
newLedgerEnv,
pparamsFromJson,
readJsonFileThrow,
)
import Hydra.Logging (Verbosity (..), traceWith, withTracer)
import Hydra.Logging.Messages (HydraLog (..))
import Hydra.Logging.Monitoring (withMonitoring)
import Hydra.Network.Message (Connectivity (..))
import Hydra.Node (
chainStateHistory,
connect,
hydrate,
initEnvironment,
runHydraNode,
wireChainInput,
wireClientInput,
wireNetworkInput,
)
import Hydra.Node.Network (NetworkConfiguration (..), withNetwork)
import Hydra.Options (
ChainConfig (..),
DirectChainConfig (..),
InvalidOptions (..),
LedgerConfig (..),
OfflineChainConfig (..),
RunOptions (..),
validateRunOptions,
)
import Hydra.Persistence (createPersistenceIncremental)
data ConfigurationException
= ConfigurationException ProtocolParametersConversionError
| InvalidOptionException InvalidOptions
deriving stock (Int -> ConfigurationException -> ShowS
[ConfigurationException] -> ShowS
ConfigurationException -> FilePath
(Int -> ConfigurationException -> ShowS)
-> (ConfigurationException -> FilePath)
-> ([ConfigurationException] -> ShowS)
-> Show ConfigurationException
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfigurationException -> ShowS
showsPrec :: Int -> ConfigurationException -> ShowS
$cshow :: ConfigurationException -> FilePath
show :: ConfigurationException -> FilePath
$cshowList :: [ConfigurationException] -> ShowS
showList :: [ConfigurationException] -> ShowS
Show)
instance Exception ConfigurationException where
displayException :: ConfigurationException -> FilePath
displayException = \case
InvalidOptionException InvalidOptions
MaximumNumberOfPartiesExceeded ->
FilePath
"Maximum number of parties is currently set to: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall b a. (Show a, IsString b) => a -> b
show Int
maximumNumberOfParties
InvalidOptionException InvalidOptions
CardanoAndHydraKeysMissmatch ->
FilePath
"Number of loaded cardano and hydra keys needs to match"
ConfigurationException ProtocolParametersConversionError
err ->
FilePath
"Incorrect protocol parameters configuration provided: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> ProtocolParametersConversionError -> FilePath
forall b a. (Show a, IsString b) => a -> b
show ProtocolParametersConversionError
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
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message 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
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message Tx)))))))
-> IO ())
-> IO ())
-> (Tracer
IO
(HydraLog
Tx
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message Tx)))))))
-> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \Tracer
IO
(HydraLog
Tx
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message Tx)))))))
tracer' -> do
Tracer
IO
(HydraLog
Tx
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message Tx)))))))
-> HydraLog
Tx
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message Tx))))))
-> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
IO
(HydraLog
Tx
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message Tx)))))))
tracer' (RunOptions
-> HydraLog
Tx
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message Tx))))))
forall tx net. RunOptions -> HydraLog tx net
NodeOptions RunOptions
opts)
Maybe PortNumber
-> Tracer
IO
(HydraLog
Tx
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message Tx)))))))
-> (Tracer
IO
(HydraLog
Tx
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message Tx)))))))
-> IO ())
-> IO ()
forall (m :: * -> *) tx net.
(MonadIO m, MonadAsync m, IsTx tx, MonadMonotonicTime m) =>
Maybe PortNumber
-> Tracer m (HydraLog tx net)
-> (Tracer m (HydraLog tx net) -> m ())
-> m ()
withMonitoring Maybe PortNumber
monitoringPort Tracer
IO
(HydraLog
Tx
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message Tx)))))))
tracer' ((Tracer
IO
(HydraLog
Tx
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message Tx)))))))
-> IO ())
-> IO ())
-> (Tracer
IO
(HydraLog
Tx
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message Tx)))))))
-> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \Tracer
IO
(HydraLog
Tx
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message 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, SigningKey HydraKey
signingKey :: SigningKey HydraKey
$sel:signingKey:Environment :: Environment -> SigningKey HydraKey
signingKey} <- RunOptions -> IO Environment
initEnvironment RunOptions
opts
PParams StandardBabbage
pparams <- (Value -> Parser (PParams StandardBabbage))
-> FilePath -> IO (PParams StandardBabbage)
forall a. (Value -> Parser a) -> FilePath -> IO a
readJsonFileThrow Value -> Parser (PParams LedgerEra)
Value -> Parser (PParams StandardBabbage)
pparamsFromJson (LedgerConfig -> FilePath
cardanoLedgerProtocolParametersFile LedgerConfig
ledgerConfig)
Globals
globals <- ChainConfig -> IO Globals
getGlobalsForChain ChainConfig
chainConfig
PParams StandardBabbage -> Globals -> (Ledger Tx -> IO ()) -> IO ()
forall {t}.
PParams StandardBabbage -> Globals -> (Ledger Tx -> t) -> t
withCardanoLedger PParams StandardBabbage
pparams Globals
globals ((Ledger Tx -> IO ()) -> IO ()) -> (Ledger Tx -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ledger Tx
ledger -> do
(EventSource (StateEvent Tx) IO
eventSource, EventSink (StateEvent Tx) IO
filePersistenceSink) <-
PersistenceIncremental (PersistedStateChange Tx) IO
-> IO
(EventSource (StateEvent Tx) IO, EventSink (StateEvent Tx) IO)
forall tx (m :: * -> *).
(IsChainState tx, MonadSTM m) =>
PersistenceIncremental (PersistedStateChange tx) m
-> m (EventSource (StateEvent tx) m, EventSink (StateEvent tx) m)
eventPairFromPersistenceIncremental
(PersistenceIncremental (PersistedStateChange Tx) IO
-> IO
(EventSource (StateEvent Tx) IO, EventSink (StateEvent Tx) IO))
-> IO (PersistenceIncremental (PersistedStateChange Tx) IO)
-> IO
(EventSource (StateEvent Tx) IO, EventSink (StateEvent Tx) IO)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath
-> IO (PersistenceIncremental (PersistedStateChange Tx) IO)
forall a (m :: * -> *).
(MonadIO m, MonadThrow m, MonadSTM m, MonadThread m,
MonadThrow (STM m)) =>
FilePath -> m (PersistenceIncremental a m)
createPersistenceIncremental (FilePath
persistenceDir FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"/state")
let eventSinks :: [EventSink (StateEvent Tx) IO]
eventSinks =
[ EventSink (StateEvent Tx) IO
filePersistenceSink
]
DraftHydraNode Tx IO
wetHydraNode <- Tracer IO (HydraNodeLog Tx)
-> Environment
-> Ledger Tx
-> ChainStateType Tx
-> EventSource (StateEvent Tx) IO
-> [EventSink (StateEvent Tx) IO]
-> IO (DraftHydraNode Tx IO)
forall (m :: * -> *) tx.
(MonadDelay m, MonadLabelledSTM m, MonadAsync m, MonadThrow m,
IsChainState tx) =>
Tracer m (HydraNodeLog tx)
-> Environment
-> Ledger tx
-> ChainStateType tx
-> EventSource (StateEvent tx) m
-> [EventSink (StateEvent tx) m]
-> m (DraftHydraNode tx m)
hydrate ((HydraNodeLog Tx
-> HydraLog
Tx
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message Tx)))))))
-> Tracer
IO
(HydraLog
Tx
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message 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
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message Tx))))))
forall tx net. HydraNodeLog tx -> HydraLog tx net
Node Tracer
IO
(HydraLog
Tx
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message Tx)))))))
tracer) Environment
env Ledger Tx
ledger ChainStateType Tx
initialChainState EventSource (StateEvent Tx) IO
eventSource [EventSink (StateEvent Tx) IO]
eventSinks
ChainStateHistory Tx -> ChainComponent Tx IO ()
withChain <- Tracer
IO
(HydraLog
Tx
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message Tx)))))))
-> Environment
-> ChainConfig
-> IO (ChainStateHistory Tx -> ChainComponent Tx IO ())
forall {tx} {net} {a}.
Tracer IO (HydraLog tx net)
-> Environment
-> ChainConfig
-> IO (ChainStateHistory Tx -> ChainComponent Tx IO a)
prepareChainComponent Tracer
IO
(HydraLog
Tx
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message 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
PersistenceIncremental (TimedServerOutput Tx) IO
apiPersistence <- FilePath -> IO (PersistenceIncremental (TimedServerOutput Tx) IO)
forall a (m :: * -> *).
(MonadIO m, MonadThrow m, MonadSTM m, MonadThread m,
MonadThrow (STM m)) =>
FilePath -> m (PersistenceIncremental a m)
createPersistenceIncremental (FilePath -> IO (PersistenceIncremental (TimedServerOutput Tx) IO))
-> FilePath
-> IO (PersistenceIncremental (TimedServerOutput Tx) IO)
forall a b. (a -> b) -> a -> b
$ FilePath
persistenceDir FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"/server-output"
IP
-> PortNumber
-> Party
-> PersistenceIncremental (TimedServerOutput Tx) IO
-> Tracer IO APIServerLog
-> Chain Tx IO
-> PParams LedgerEra
-> ServerComponent Tx IO ()
forall tx.
IsChainState tx =>
IP
-> PortNumber
-> Party
-> PersistenceIncremental (TimedServerOutput tx) IO
-> Tracer IO APIServerLog
-> Chain tx IO
-> PParams LedgerEra
-> ServerComponent tx IO ()
withAPIServer IP
apiHost PortNumber
apiPort Party
party PersistenceIncremental (TimedServerOutput Tx) IO
apiPersistence ((APIServerLog
-> HydraLog
Tx
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message Tx)))))))
-> Tracer
IO
(HydraLog
Tx
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message 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
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message Tx))))))
forall tx net. APIServerLog -> HydraLog tx net
APIServer Tracer
IO
(HydraLog
Tx
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message Tx)))))))
tracer) Chain Tx IO
chain PParams LedgerEra
PParams StandardBabbage
pparams (DraftHydraNode Tx IO -> ClientInput Tx -> IO ()
forall tx (m :: * -> *).
DraftHydraNode tx m -> ClientInput tx -> m ()
wireClientInput DraftHydraNode Tx IO
wetHydraNode) ((Server Tx IO -> IO ()) -> IO ())
-> (Server Tx IO -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Server Tx IO
server -> do
let networkConfiguration :: NetworkConfiguration IO
networkConfiguration = NetworkConfiguration{FilePath
persistenceDir :: FilePath
$sel:persistenceDir:NetworkConfiguration :: FilePath
persistenceDir, SigningKey HydraKey
signingKey :: SigningKey HydraKey
$sel:signingKey:NetworkConfiguration :: SigningKey HydraKey
signingKey, [Party]
otherParties :: [Party]
$sel:otherParties:NetworkConfiguration :: [Party]
otherParties, IP
host :: IP
$sel:host:NetworkConfiguration :: IP
host, PortNumber
port :: PortNumber
$sel:port:NetworkConfiguration :: PortNumber
port, [Host]
peers :: [Host]
$sel:peers:NetworkConfiguration :: [Host]
peers, NodeId
nodeId :: NodeId
$sel:nodeId:NetworkConfiguration :: NodeId
nodeId}
Tracer
IO
(HydraLog
Tx
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message Tx)))))))
-> ConnectionMessages IO
-> NetworkConfiguration IO
-> NetworkComponent IO (Authenticated (Message Tx)) (Message Tx) ()
forall msg tx.
(ToCBOR msg, ToJSON msg, FromJSON msg, FromCBOR msg) =>
Tracer IO (LogEntry tx msg)
-> ConnectionMessages IO
-> NetworkConfiguration IO
-> NetworkComponent IO (Authenticated msg) msg ()
withNetwork Tracer
IO
(HydraLog
Tx
(WithHost
(TraceOuroborosNetwork
(Signed (ReliableMsg (Heartbeat (Message Tx)))))))
tracer (Server Tx IO -> ConnectionMessages IO
forall {tx} {m :: * -> *}. Server tx m -> Connectivity -> m ()
connectionMessages Server Tx IO
server) NetworkConfiguration IO
networkConfiguration (DraftHydraNode Tx IO -> Authenticated (Message Tx) -> IO ()
forall tx (m :: * -> *).
DraftHydraNode tx m -> 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
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 -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HydraNode Tx IO -> IO ()
forall (m :: * -> *) tx.
(MonadCatch m, MonadAsync m, IsChainState tx) =>
HydraNode tx m -> m ()
runHydraNode
where
connectionMessages :: Server tx m -> Connectivity -> m ()
connectionMessages Server{ServerOutput tx -> m ()
sendOutput :: ServerOutput tx -> m ()
$sel:sendOutput:Server :: forall tx (m :: * -> *). Server tx m -> ServerOutput tx -> m ()
sendOutput} = \case
Connected NodeId
nodeid -> ServerOutput tx -> m ()
sendOutput (ServerOutput tx -> m ()) -> ServerOutput tx -> m ()
forall a b. (a -> b) -> a -> b
$ NodeId -> ServerOutput tx
forall tx. NodeId -> ServerOutput tx
PeerConnected NodeId
nodeid
Disconnected NodeId
nodeid -> ServerOutput tx -> m ()
sendOutput (ServerOutput tx -> m ()) -> ServerOutput tx -> m ()
forall a b. (a -> b) -> a -> b
$ NodeId -> ServerOutput tx
forall tx. NodeId -> ServerOutput tx
PeerDisconnected NodeId
nodeid
withCardanoLedger :: PParams StandardBabbage -> Globals -> (Ledger Tx -> t) -> t
withCardanoLedger PParams StandardBabbage
protocolParams Globals
globals Ledger Tx -> t
action =
let ledgerEnv :: LedgerEnv LedgerEra
ledgerEnv = PParams LedgerEra -> LedgerEnv LedgerEra
newLedgerEnv PParams LedgerEra
PParams StandardBabbage
protocolParams
in Ledger Tx -> t
action (Globals -> LedgerEnv LedgerEra -> Ledger Tx
Ledger.cardanoLedger Globals
globals LedgerEnv LedgerEra
ledgerEnv)
prepareChainComponent :: Tracer IO (HydraLog tx net)
-> Environment
-> ChainConfig
-> IO (ChainStateHistory Tx -> ChainComponent Tx IO a)
prepareChainComponent Tracer IO (HydraLog tx net)
tracer Environment{Party
$sel:party:Environment :: Environment -> Party
party :: Party
party} = \case
Offline OfflineChainConfig
cfg ->
(ChainStateHistory Tx -> ChainComponent Tx IO a)
-> IO (ChainStateHistory Tx -> ChainComponent Tx IO a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ChainStateHistory Tx -> ChainComponent Tx IO a)
-> IO (ChainStateHistory Tx -> ChainComponent Tx IO a))
-> (ChainStateHistory Tx -> ChainComponent Tx IO a)
-> IO (ChainStateHistory Tx -> ChainComponent Tx IO a)
forall a b. (a -> b) -> a -> b
$ OfflineChainConfig
-> Party -> ChainStateHistory Tx -> ChainComponent Tx IO a
forall a.
OfflineChainConfig
-> Party -> ChainStateHistory Tx -> ChainComponent Tx IO a
withOfflineChain OfflineChainConfig
cfg Party
party
Direct DirectChainConfig
cfg -> do
ChainContext
ctx <- DirectChainConfig -> Party -> IO ChainContext
loadChainContext DirectChainConfig
cfg Party
party
TinyWallet IO
wallet <- Tracer IO DirectChainLog -> DirectChainConfig -> IO (TinyWallet IO)
mkTinyWallet ((DirectChainLog -> HydraLog tx net)
-> Tracer IO (HydraLog tx net) -> Tracer IO DirectChainLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap DirectChainLog -> HydraLog tx net
forall tx net. DirectChainLog -> HydraLog tx net
DirectChain Tracer IO (HydraLog tx net)
tracer) DirectChainConfig
cfg
(ChainStateHistory Tx -> ChainComponent Tx IO a)
-> IO (ChainStateHistory Tx -> ChainComponent Tx IO a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ChainStateHistory Tx -> ChainComponent Tx IO a)
-> IO (ChainStateHistory Tx -> ChainComponent Tx IO a))
-> (ChainStateHistory Tx -> ChainComponent Tx IO a)
-> IO (ChainStateHistory Tx -> ChainComponent Tx IO a)
forall a b. (a -> b) -> a -> b
$ Tracer IO DirectChainLog
-> DirectChainConfig
-> ChainContext
-> TinyWallet IO
-> ChainStateHistory Tx
-> ChainComponent Tx IO a
forall a.
Tracer IO DirectChainLog
-> DirectChainConfig
-> ChainContext
-> TinyWallet IO
-> ChainStateHistory Tx
-> ChainComponent Tx IO a
withDirectChain ((DirectChainLog -> HydraLog tx net)
-> Tracer IO (HydraLog tx net) -> Tracer IO DirectChainLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap DirectChainLog -> HydraLog tx net
forall tx net. DirectChainLog -> HydraLog tx net
DirectChain Tracer IO (HydraLog tx net)
tracer) DirectChainConfig
cfg ChainContext
ctx TinyWallet IO
wallet
RunOptions
{ Verbosity
verbosity :: Verbosity
$sel:verbosity:RunOptions :: RunOptions -> Verbosity
verbosity
, Maybe PortNumber
monitoringPort :: Maybe PortNumber
$sel:monitoringPort:RunOptions :: RunOptions -> Maybe PortNumber
monitoringPort
, FilePath
persistenceDir :: FilePath
$sel:persistenceDir:RunOptions :: RunOptions -> FilePath
persistenceDir
, ChainConfig
chainConfig :: ChainConfig
$sel:chainConfig:RunOptions :: RunOptions -> ChainConfig
chainConfig
, LedgerConfig
ledgerConfig :: LedgerConfig
$sel:ledgerConfig:RunOptions :: RunOptions -> LedgerConfig
ledgerConfig
, IP
host :: IP
$sel:host:RunOptions :: RunOptions -> IP
host
, PortNumber
port :: PortNumber
$sel:port:RunOptions :: RunOptions -> PortNumber
port
, [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
} = RunOptions
opts
getGlobalsForChain :: ChainConfig -> IO Globals
getGlobalsForChain :: ChainConfig -> IO Globals
getGlobalsForChain = \case
Offline OfflineChainConfig{Maybe FilePath
ledgerGenesisFile :: Maybe FilePath
$sel:ledgerGenesisFile:OfflineChainConfig :: OfflineChainConfig -> Maybe FilePath
ledgerGenesisFile} ->
Maybe FilePath -> IO (GenesisParameters ShelleyEra)
loadGenesisFile Maybe FilePath
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
Direct DirectChainConfig{NetworkId
networkId :: NetworkId
$sel:networkId:DirectChainConfig :: DirectChainConfig -> NetworkId
networkId, SocketPath
nodeSocket :: SocketPath
$sel:nodeSocket:DirectChainConfig :: DirectChainConfig -> SocketPath
nodeSocket} ->
NetworkId
-> SocketPath -> QueryPoint -> IO (GenesisParameters ShelleyEra)
queryGenesisParameters NetworkId
networkId SocketPath
nodeSocket QueryPoint
QueryTip
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
identifyNode :: RunOptions -> RunOptions
identifyNode :: RunOptions -> RunOptions
identifyNode opt :: RunOptions
opt@RunOptions{$sel:verbosity:RunOptions :: RunOptions -> Verbosity
verbosity = Verbose Text
"HydraNode", NodeId
$sel:nodeId:RunOptions :: RunOptions -> NodeId
nodeId :: NodeId
nodeId} = RunOptions
opt{verbosity = Verbose $ "HydraNode-" <> show nodeId}
identifyNode RunOptions
opt = RunOptions
opt