{-# LANGUAGE DuplicateRecordFields #-}

module CardanoNode where

import Hydra.Prelude

import Cardano.Slotting.Time (diffRelativeTime, getRelativeTime, toRelativeTime)
import CardanoClient (QueryPoint (QueryTip))
import Control.Lens ((?~), (^?!))
import Control.Tracer (Tracer, traceWith)
import Data.Aeson (Value (String), (.=))
import Data.Aeson qualified as Aeson
import Data.Aeson.Lens (atKey, key, _Number)
import Data.Fixed (Centi)
import Data.Text qualified as Text
import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
import Hydra.Cardano.Api (
  File (..),
  NetworkId,
  NetworkMagic (..),
  SocketPath,
  getProgress,
 )
import Hydra.Cardano.Api qualified as Api
import Hydra.Chain.Backend (ChainBackend)
import Hydra.Chain.Backend qualified as Backend
import Hydra.Chain.Blockfrost (BlockfrostBackend (..))
import Hydra.Chain.Direct (DirectBackend (..))
import Hydra.Cluster.Fixture (KnownNetwork (..), toNetworkId)
import Hydra.Cluster.Util (readConfigFile)
import Hydra.Options (BlockfrostOptions (..), DirectOptions (..))
import Network.HTTP.Simple (getResponseBody, httpBS, parseRequestThrow)
import System.Directory (createDirectoryIfMissing, doesFileExist, removeFile)
import System.Exit (ExitCode (..))
import System.FilePath (takeDirectory, (</>))
import System.Posix (ownerReadMode, setFileMode)
import System.Process (
  CreateProcess (..),
  StdStream (CreatePipe, UseHandle),
  proc,
  readProcess,
  withCreateProcess,
 )
import Test.Hydra.Prelude

data NodeLog
  = MsgNodeCmdSpec {NodeLog -> Text
cmd :: Text}
  | MsgCLI [Text]
  | MsgCLIStatus Text Text
  | MsgCLIRetry Text
  | MsgCLIRetryResult Text Int
  | MsgNodeStarting {NodeLog -> FilePath
stateDirectory :: FilePath}
  | MsgSocketIsReady SocketPath
  | MsgSynchronizing {NodeLog -> Centi
percentDone :: Centi}
  | MsgQueryGenesisParametersFailed {NodeLog -> Text
err :: Text}
  deriving stock (NodeLog -> NodeLog -> Bool
(NodeLog -> NodeLog -> Bool)
-> (NodeLog -> NodeLog -> Bool) -> Eq NodeLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeLog -> NodeLog -> Bool
== :: NodeLog -> NodeLog -> Bool
$c/= :: NodeLog -> NodeLog -> Bool
/= :: NodeLog -> NodeLog -> Bool
Eq, Int -> NodeLog -> ShowS
[NodeLog] -> ShowS
NodeLog -> FilePath
(Int -> NodeLog -> ShowS)
-> (NodeLog -> FilePath) -> ([NodeLog] -> ShowS) -> Show NodeLog
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeLog -> ShowS
showsPrec :: Int -> NodeLog -> ShowS
$cshow :: NodeLog -> FilePath
show :: NodeLog -> FilePath
$cshowList :: [NodeLog] -> ShowS
showList :: [NodeLog] -> ShowS
Show, (forall x. NodeLog -> Rep NodeLog x)
-> (forall x. Rep NodeLog x -> NodeLog) -> Generic NodeLog
forall x. Rep NodeLog x -> NodeLog
forall x. NodeLog -> Rep NodeLog x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NodeLog -> Rep NodeLog x
from :: forall x. NodeLog -> Rep NodeLog x
$cto :: forall x. Rep NodeLog x -> NodeLog
to :: forall x. Rep NodeLog x -> NodeLog
Generic)
  deriving anyclass ([NodeLog] -> Value
[NodeLog] -> Encoding
NodeLog -> Bool
NodeLog -> Value
NodeLog -> Encoding
(NodeLog -> Value)
-> (NodeLog -> Encoding)
-> ([NodeLog] -> Value)
-> ([NodeLog] -> Encoding)
-> (NodeLog -> Bool)
-> ToJSON NodeLog
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: NodeLog -> Value
toJSON :: NodeLog -> Value
$ctoEncoding :: NodeLog -> Encoding
toEncoding :: NodeLog -> Encoding
$ctoJSONList :: [NodeLog] -> Value
toJSONList :: [NodeLog] -> Value
$ctoEncodingList :: [NodeLog] -> Encoding
toEncodingList :: [NodeLog] -> Encoding
$comitField :: NodeLog -> Bool
omitField :: NodeLog -> Bool
ToJSON)

type Port = Int

newtype NodeId = NodeId Int
  deriving newtype (NodeId -> NodeId -> Bool
(NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool) -> Eq NodeId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeId -> NodeId -> Bool
== :: NodeId -> NodeId -> Bool
$c/= :: NodeId -> NodeId -> Bool
/= :: NodeId -> NodeId -> Bool
Eq, Int -> NodeId -> ShowS
[NodeId] -> ShowS
NodeId -> FilePath
(Int -> NodeId -> ShowS)
-> (NodeId -> FilePath) -> ([NodeId] -> ShowS) -> Show NodeId
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeId -> ShowS
showsPrec :: Int -> NodeId -> ShowS
$cshow :: NodeId -> FilePath
show :: NodeId -> FilePath
$cshowList :: [NodeId] -> ShowS
showList :: [NodeId] -> ShowS
Show, Integer -> NodeId
NodeId -> NodeId
NodeId -> NodeId -> NodeId
(NodeId -> NodeId -> NodeId)
-> (NodeId -> NodeId -> NodeId)
-> (NodeId -> NodeId -> NodeId)
-> (NodeId -> NodeId)
-> (NodeId -> NodeId)
-> (NodeId -> NodeId)
-> (Integer -> NodeId)
-> Num NodeId
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: NodeId -> NodeId -> NodeId
+ :: NodeId -> NodeId -> NodeId
$c- :: NodeId -> NodeId -> NodeId
- :: NodeId -> NodeId -> NodeId
$c* :: NodeId -> NodeId -> NodeId
* :: NodeId -> NodeId -> NodeId
$cnegate :: NodeId -> NodeId
negate :: NodeId -> NodeId
$cabs :: NodeId -> NodeId
abs :: NodeId -> NodeId
$csignum :: NodeId -> NodeId
signum :: NodeId -> NodeId
$cfromInteger :: Integer -> NodeId
fromInteger :: Integer -> NodeId
Num)

-- | Configuration parameters for a single node devnet
data DevnetConfig = DevnetConfig
  { DevnetConfig -> FilePath
stateDirectory :: FilePath
  -- ^ Parent state directory
  , DevnetConfig -> UTCTime
systemStart :: UTCTime
  -- ^ Blockchain start time
  , DevnetConfig -> PortsConfig
ports :: PortsConfig
  -- ^ A list of port
  }
  deriving stock (DevnetConfig -> DevnetConfig -> Bool
(DevnetConfig -> DevnetConfig -> Bool)
-> (DevnetConfig -> DevnetConfig -> Bool) -> Eq DevnetConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DevnetConfig -> DevnetConfig -> Bool
== :: DevnetConfig -> DevnetConfig -> Bool
$c/= :: DevnetConfig -> DevnetConfig -> Bool
/= :: DevnetConfig -> DevnetConfig -> Bool
Eq, Int -> DevnetConfig -> ShowS
[DevnetConfig] -> ShowS
DevnetConfig -> FilePath
(Int -> DevnetConfig -> ShowS)
-> (DevnetConfig -> FilePath)
-> ([DevnetConfig] -> ShowS)
-> Show DevnetConfig
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DevnetConfig -> ShowS
showsPrec :: Int -> DevnetConfig -> ShowS
$cshow :: DevnetConfig -> FilePath
show :: DevnetConfig -> FilePath
$cshowList :: [DevnetConfig] -> ShowS
showList :: [DevnetConfig] -> ShowS
Show, (forall x. DevnetConfig -> Rep DevnetConfig x)
-> (forall x. Rep DevnetConfig x -> DevnetConfig)
-> Generic DevnetConfig
forall x. Rep DevnetConfig x -> DevnetConfig
forall x. DevnetConfig -> Rep DevnetConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DevnetConfig -> Rep DevnetConfig x
from :: forall x. DevnetConfig -> Rep DevnetConfig x
$cto :: forall x. Rep DevnetConfig x -> DevnetConfig
to :: forall x. Rep DevnetConfig x -> DevnetConfig
Generic)

-- | Arguments given to the 'cardano-node' command-line to run a node.
data CardanoNodeArgs = CardanoNodeArgs
  { CardanoNodeArgs -> FilePath
nodeSocket :: FilePath
  , CardanoNodeArgs -> FilePath
nodeConfigFile :: FilePath
  , CardanoNodeArgs -> FilePath
nodeByronGenesisFile :: FilePath
  , CardanoNodeArgs -> FilePath
nodeShelleyGenesisFile :: FilePath
  , CardanoNodeArgs -> FilePath
nodeAlonzoGenesisFile :: FilePath
  , CardanoNodeArgs -> FilePath
nodeConwayGenesisFile :: FilePath
  , CardanoNodeArgs -> FilePath
nodeTopologyFile :: FilePath
  , CardanoNodeArgs -> FilePath
nodeDatabaseDir :: FilePath
  , CardanoNodeArgs -> Maybe FilePath
nodeDlgCertFile :: Maybe FilePath
  , CardanoNodeArgs -> Maybe FilePath
nodeSignKeyFile :: Maybe FilePath
  , CardanoNodeArgs -> Maybe FilePath
nodeOpCertFile :: Maybe FilePath
  , CardanoNodeArgs -> Maybe FilePath
nodeKesKeyFile :: Maybe FilePath
  , CardanoNodeArgs -> Maybe FilePath
nodeVrfKeyFile :: Maybe FilePath
  , CardanoNodeArgs -> Maybe Int
nodePort :: Maybe Port
  }

defaultCardanoNodeArgs :: CardanoNodeArgs
defaultCardanoNodeArgs :: CardanoNodeArgs
defaultCardanoNodeArgs =
  CardanoNodeArgs
    { $sel:nodeSocket:CardanoNodeArgs :: FilePath
nodeSocket = FilePath
"node.socket"
    , $sel:nodeConfigFile:CardanoNodeArgs :: FilePath
nodeConfigFile = FilePath
"cardano-node.json"
    , $sel:nodeByronGenesisFile:CardanoNodeArgs :: FilePath
nodeByronGenesisFile = FilePath
"genesis-byron.json"
    , $sel:nodeShelleyGenesisFile:CardanoNodeArgs :: FilePath
nodeShelleyGenesisFile = FilePath
"genesis-shelley.json"
    , $sel:nodeAlonzoGenesisFile:CardanoNodeArgs :: FilePath
nodeAlonzoGenesisFile = FilePath
"genesis-alonzo.json"
    , $sel:nodeConwayGenesisFile:CardanoNodeArgs :: FilePath
nodeConwayGenesisFile = FilePath
"genesis-conway.json"
    , $sel:nodeTopologyFile:CardanoNodeArgs :: FilePath
nodeTopologyFile = FilePath
"topology.json"
    , $sel:nodeDatabaseDir:CardanoNodeArgs :: FilePath
nodeDatabaseDir = FilePath
"db"
    , $sel:nodeDlgCertFile:CardanoNodeArgs :: Maybe FilePath
nodeDlgCertFile = Maybe FilePath
forall a. Maybe a
Nothing
    , $sel:nodeSignKeyFile:CardanoNodeArgs :: Maybe FilePath
nodeSignKeyFile = Maybe FilePath
forall a. Maybe a
Nothing
    , $sel:nodeOpCertFile:CardanoNodeArgs :: Maybe FilePath
nodeOpCertFile = Maybe FilePath
forall a. Maybe a
Nothing
    , $sel:nodeKesKeyFile:CardanoNodeArgs :: Maybe FilePath
nodeKesKeyFile = Maybe FilePath
forall a. Maybe a
Nothing
    , $sel:nodeVrfKeyFile:CardanoNodeArgs :: Maybe FilePath
nodeVrfKeyFile = Maybe FilePath
forall a. Maybe a
Nothing
    , $sel:nodePort:CardanoNodeArgs :: Maybe Int
nodePort = Maybe Int
forall a. Maybe a
Nothing
    }

-- | Configuration of ports from the perspective of a peer in the context of a
-- fully sockected topology.
data PortsConfig = PortsConfig
  { PortsConfig -> Int
ours :: Port
  -- ^ Our node TCP port.
  , PortsConfig -> [Int]
peers :: [Port]
  -- ^ Other peers TCP ports.
  }
  deriving stock (Int -> PortsConfig -> ShowS
[PortsConfig] -> ShowS
PortsConfig -> FilePath
(Int -> PortsConfig -> ShowS)
-> (PortsConfig -> FilePath)
-> ([PortsConfig] -> ShowS)
-> Show PortsConfig
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PortsConfig -> ShowS
showsPrec :: Int -> PortsConfig -> ShowS
$cshow :: PortsConfig -> FilePath
show :: PortsConfig -> FilePath
$cshowList :: [PortsConfig] -> ShowS
showList :: [PortsConfig] -> ShowS
Show, PortsConfig -> PortsConfig -> Bool
(PortsConfig -> PortsConfig -> Bool)
-> (PortsConfig -> PortsConfig -> Bool) -> Eq PortsConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PortsConfig -> PortsConfig -> Bool
== :: PortsConfig -> PortsConfig -> Bool
$c/= :: PortsConfig -> PortsConfig -> Bool
/= :: PortsConfig -> PortsConfig -> Bool
Eq, (forall x. PortsConfig -> Rep PortsConfig x)
-> (forall x. Rep PortsConfig x -> PortsConfig)
-> Generic PortsConfig
forall x. Rep PortsConfig x -> PortsConfig
forall x. PortsConfig -> Rep PortsConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PortsConfig -> Rep PortsConfig x
from :: forall x. PortsConfig -> Rep PortsConfig x
$cto :: forall x. Rep PortsConfig x -> PortsConfig
to :: forall x. Rep PortsConfig x -> PortsConfig
Generic)

getCardanoNodeVersion :: IO String
getCardanoNodeVersion :: IO FilePath
getCardanoNodeVersion =
  FilePath -> [FilePath] -> FilePath -> IO FilePath
readProcess FilePath
"cardano-node" [FilePath
"--version"] FilePath
""

-- | Tries to find an communicate with an existing cardano-node running in given
-- work directory. NOTE: This is using the default node socket name as defined
-- by 'defaultCardanoNodeArgs'.
findRunningCardanoNode :: Tracer IO NodeLog -> FilePath -> KnownNetwork -> IO (Maybe (NominalDiffTime, DirectBackend))
findRunningCardanoNode :: Tracer IO NodeLog
-> FilePath
-> KnownNetwork
-> IO (Maybe (NominalDiffTime, DirectBackend))
findRunningCardanoNode Tracer IO NodeLog
tracer FilePath
workDir KnownNetwork
knownNetwork = do
  Tracer IO NodeLog
-> NetworkId
-> SocketPath
-> IO (Maybe (NominalDiffTime, DirectBackend))
findRunningCardanoNode' Tracer IO NodeLog
tracer NetworkId
knownNetworkId SocketPath
socketPath
 where
  knownNetworkId :: NetworkId
knownNetworkId = KnownNetwork -> NetworkId
toNetworkId KnownNetwork
knownNetwork

  socketPath :: SocketPath
socketPath = FilePath -> SocketPath
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath -> SocketPath) -> FilePath -> SocketPath
forall a b. (a -> b) -> a -> b
$ FilePath
workDir FilePath -> ShowS
</> FilePath
nodeSocket

  CardanoNodeArgs{FilePath
$sel:nodeSocket:CardanoNodeArgs :: CardanoNodeArgs -> FilePath
nodeSocket :: FilePath
nodeSocket} = CardanoNodeArgs
defaultCardanoNodeArgs

-- | Tries to find an communicate with an existing cardano-node running in given
-- network id and socket path.
findRunningCardanoNode' :: Tracer IO NodeLog -> NetworkId -> SocketPath -> IO (Maybe (NominalDiffTime, DirectBackend))
findRunningCardanoNode' :: Tracer IO NodeLog
-> NetworkId
-> SocketPath
-> IO (Maybe (NominalDiffTime, DirectBackend))
findRunningCardanoNode' Tracer IO NodeLog
tracer NetworkId
networkId SocketPath
nodeSocket = do
  let backend :: DirectBackend
backend = DirectOptions -> DirectBackend
DirectBackend (DirectOptions -> DirectBackend) -> DirectOptions -> DirectBackend
forall a b. (a -> b) -> a -> b
$ DirectOptions{NetworkId
networkId :: NetworkId
$sel:networkId:DirectOptions :: NetworkId
networkId, SocketPath
nodeSocket :: SocketPath
$sel:nodeSocket:DirectOptions :: SocketPath
nodeSocket}
  IO NominalDiffTime -> IO (Either SomeException NominalDiffTime)
forall e a. Exception e => IO a -> IO (Either e a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (DirectBackend -> (MonadIO IO, MonadThrow IO) => IO NominalDiffTime
forall a (m :: * -> *).
ChainBackend a =>
a -> (MonadIO m, MonadThrow m) => m NominalDiffTime
forall (m :: * -> *).
DirectBackend -> (MonadIO m, MonadThrow m) => m NominalDiffTime
Backend.getBlockTime DirectBackend
backend) IO (Either SomeException NominalDiffTime)
-> (Either SomeException NominalDiffTime
    -> IO (Maybe (NominalDiffTime, DirectBackend)))
-> IO (Maybe (NominalDiffTime, DirectBackend))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left (SomeException
e :: SomeException) ->
      Tracer IO NodeLog -> NodeLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO NodeLog
tracer MsgQueryGenesisParametersFailed{$sel:err:MsgNodeCmdSpec :: Text
err = SomeException -> Text
forall b a. (Show a, IsString b) => a -> b
show SomeException
e} IO ()
-> Maybe (NominalDiffTime, DirectBackend)
-> IO (Maybe (NominalDiffTime, DirectBackend))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe (NominalDiffTime, DirectBackend)
forall a. Maybe a
Nothing
    Right NominalDiffTime
blockTime ->
      Maybe (NominalDiffTime, DirectBackend)
-> IO (Maybe (NominalDiffTime, DirectBackend))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (NominalDiffTime, DirectBackend)
 -> IO (Maybe (NominalDiffTime, DirectBackend)))
-> Maybe (NominalDiffTime, DirectBackend)
-> IO (Maybe (NominalDiffTime, DirectBackend))
forall a b. (a -> b) -> a -> b
$ (NominalDiffTime, DirectBackend)
-> Maybe (NominalDiffTime, DirectBackend)
forall a. a -> Maybe a
Just (NominalDiffTime
blockTime, DirectBackend
backend)

-- | Start a single cardano-node devnet using the config from config/ and
-- credentials from config/credentials/. Only the 'Faucet' actor will receive
-- "initialFunds". Use 'seedFromFaucet' to distribute funds other wallets.
withCardanoNodeDevnet ::
  Tracer IO NodeLog ->
  -- | State directory in which credentials, db & logs are persisted.
  FilePath ->
  (NominalDiffTime -> DirectBackend -> IO a) ->
  IO a
withCardanoNodeDevnet :: forall a.
Tracer IO NodeLog
-> FilePath -> (NominalDiffTime -> DirectBackend -> IO a) -> IO a
withCardanoNodeDevnet Tracer IO NodeLog
tracer FilePath
stateDirectory NominalDiffTime -> DirectBackend -> IO a
action = do
  CardanoNodeArgs
args <- FilePath -> IO CardanoNodeArgs
setupCardanoDevnet FilePath
stateDirectory
  Tracer IO NodeLog
-> FilePath
-> CardanoNodeArgs
-> (NominalDiffTime -> DirectBackend -> IO a)
-> IO a
forall a.
Tracer IO NodeLog
-> FilePath
-> CardanoNodeArgs
-> (NominalDiffTime -> DirectBackend -> IO a)
-> IO a
withCardanoNode Tracer IO NodeLog
tracer FilePath
stateDirectory CardanoNodeArgs
args NominalDiffTime -> DirectBackend -> IO a
action

withBlockfrostBackend ::
  Tracer IO NodeLog ->
  -- | State directory in which credentials, db & logs are persisted.
  FilePath ->
  (NominalDiffTime -> BlockfrostBackend -> IO a) ->
  IO a
withBlockfrostBackend :: forall a.
Tracer IO NodeLog
-> FilePath
-> (NominalDiffTime -> BlockfrostBackend -> IO a)
-> IO a
withBlockfrostBackend Tracer IO NodeLog
_tracer FilePath
stateDirectory NominalDiffTime -> BlockfrostBackend -> IO a
action = do
  CardanoNodeArgs
args <- FilePath -> IO CardanoNodeArgs
setupCardanoDevnet FilePath
stateDirectory
  Value
shelleyGenesis <- FilePath -> IO ByteString
forall (m :: * -> *). MonadIO m => FilePath -> m ByteString
readFileBS (FilePath -> IO ByteString)
-> (ByteString -> IO Value) -> FilePath -> IO Value
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> IO Value
forall a. FromJSON a => ByteString -> IO a
unsafeDecodeJson (FilePath -> IO Value) -> FilePath -> IO Value
forall a b. (a -> b) -> a -> b
$ FilePath
stateDirectory FilePath -> ShowS
</> CardanoNodeArgs -> FilePath
nodeShelleyGenesisFile CardanoNodeArgs
args
  let backend :: BlockfrostBackend
backend = BlockfrostOptions -> BlockfrostBackend
BlockfrostBackend (BlockfrostOptions -> BlockfrostBackend)
-> BlockfrostOptions -> BlockfrostBackend
forall a b. (a -> b) -> a -> b
$ BlockfrostOptions{$sel:projectPath:BlockfrostOptions :: FilePath
projectPath = FilePath
".." FilePath -> ShowS
</> FilePath
Backend.blockfrostProjectPath}
  NominalDiffTime -> BlockfrostBackend -> IO a
action (Value -> NominalDiffTime
getShelleyGenesisBlockTime Value
shelleyGenesis) BlockfrostBackend
backend

withBackend ::
  forall a.
  Tracer IO NodeLog ->
  FilePath ->
  (forall backend. ChainBackend backend => NominalDiffTime -> backend -> IO a) ->
  IO a
withBackend :: forall a.
Tracer IO NodeLog
-> FilePath
-> (forall backend.
    ChainBackend backend =>
    NominalDiffTime -> backend -> IO a)
-> IO a
withBackend Tracer IO NodeLog
tracer FilePath
stateDirectory forall backend.
ChainBackend backend =>
NominalDiffTime -> backend -> IO a
action = do
  Maybe FilePath
backend <- FilePath -> IO (Maybe FilePath)
forall (m :: * -> *). MonadIO m => FilePath -> m (Maybe FilePath)
lookupEnv FilePath
"HYDRA_BACKEND"
  case Maybe FilePath
backend of
    Just FilePath
"direct" -> Tracer IO NodeLog
-> FilePath -> (NominalDiffTime -> DirectBackend -> IO a) -> IO a
forall a.
Tracer IO NodeLog
-> FilePath -> (NominalDiffTime -> DirectBackend -> IO a) -> IO a
withCardanoNodeDevnet Tracer IO NodeLog
tracer FilePath
stateDirectory NominalDiffTime -> DirectBackend -> IO a
forall backend.
ChainBackend backend =>
NominalDiffTime -> backend -> IO a
action
    Just FilePath
"blockfrost" -> Tracer IO NodeLog
-> FilePath
-> (NominalDiffTime -> BlockfrostBackend -> IO a)
-> IO a
forall a.
Tracer IO NodeLog
-> FilePath
-> (NominalDiffTime -> BlockfrostBackend -> IO a)
-> IO a
withBlockfrostBackend Tracer IO NodeLog
tracer FilePath
stateDirectory NominalDiffTime -> BlockfrostBackend -> IO a
forall backend.
ChainBackend backend =>
NominalDiffTime -> backend -> IO a
action
    Maybe FilePath
_ -> Tracer IO NodeLog
-> FilePath -> (NominalDiffTime -> DirectBackend -> IO a) -> IO a
forall a.
Tracer IO NodeLog
-> FilePath -> (NominalDiffTime -> DirectBackend -> IO a) -> IO a
withCardanoNodeDevnet Tracer IO NodeLog
tracer FilePath
stateDirectory NominalDiffTime -> DirectBackend -> IO a
forall backend.
ChainBackend backend =>
NominalDiffTime -> backend -> IO a
action

-- | Run a cardano-node as normal network participant on a known network.
withCardanoNodeOnKnownNetwork ::
  Tracer IO NodeLog ->
  -- | State directory in which node db & logs are persisted.
  FilePath ->
  -- | A well-known Cardano network to connect to.
  KnownNetwork ->
  (NominalDiffTime -> DirectBackend -> IO a) ->
  IO a
withCardanoNodeOnKnownNetwork :: forall a.
Tracer IO NodeLog
-> FilePath
-> KnownNetwork
-> (NominalDiffTime -> DirectBackend -> IO a)
-> IO a
withCardanoNodeOnKnownNetwork Tracer IO NodeLog
tracer FilePath
stateDirectory KnownNetwork
knownNetwork NominalDiffTime -> DirectBackend -> IO a
action = do
  IO ()
copyKnownNetworkFiles
  Tracer IO NodeLog
-> FilePath
-> CardanoNodeArgs
-> (NominalDiffTime -> DirectBackend -> IO a)
-> IO a
forall a.
Tracer IO NodeLog
-> FilePath
-> CardanoNodeArgs
-> (NominalDiffTime -> DirectBackend -> IO a)
-> IO a
withCardanoNode Tracer IO NodeLog
tracer FilePath
stateDirectory CardanoNodeArgs
args NominalDiffTime -> DirectBackend -> IO a
action
 where
  args :: CardanoNodeArgs
args =
    CardanoNodeArgs
defaultCardanoNodeArgs
      { nodeConfigFile = "config.json"
      , nodeTopologyFile = "topology.json"
      , nodeByronGenesisFile = "byron-genesis.json"
      , nodeShelleyGenesisFile = "shelley-genesis.json"
      , nodeAlonzoGenesisFile = "alonzo-genesis.json"
      , nodeConwayGenesisFile = "conway-genesis.json"
      }

  -- Copy/download configuration files for a known network
  copyKnownNetworkFiles :: IO ()
copyKnownNetworkFiles =
    [FilePath] -> (FilePath -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
      [ FilePath
"config.json"
      , FilePath
"topology.json"
      , FilePath
"byron-genesis.json"
      , FilePath
"shelley-genesis.json"
      , FilePath
"alonzo-genesis.json"
      , FilePath
"conway-genesis.json"
      ]
      ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
fn -> do
        Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
stateDirectory FilePath -> ShowS
</> ShowS
takeDirectory FilePath
fn
        FilePath -> IO ByteString
forall {f :: * -> *}.
(MonadThrow f, MonadIO f) =>
FilePath -> f ByteString
fetchConfigFile (FilePath
knownNetworkPath FilePath -> ShowS
</> FilePath
fn)
          IO ByteString -> (ByteString -> 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
>>= FilePath -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> ByteString -> m ()
writeFileBS (FilePath
stateDirectory FilePath -> ShowS
</> FilePath
fn)

  knownNetworkPath :: FilePath
knownNetworkPath =
    FilePath
knownNetworkConfigBaseURL FilePath -> ShowS
</> FilePath
knownNetworkName

  -- Base path on remote
  knownNetworkConfigBaseURL :: FilePath
knownNetworkConfigBaseURL = FilePath
"https://book.world.dev.cardano.org/environments"

  -- Network name on remote
  knownNetworkName :: FilePath
knownNetworkName = case KnownNetwork
knownNetwork of
    KnownNetwork
Preview -> FilePath
"preview"
    KnownNetwork
Preproduction -> FilePath
"preprod"
    KnownNetwork
Mainnet -> FilePath
"mainnet"
    KnownNetwork
Sanchonet -> FilePath
"sanchonet"
    -- NOTE: Here we map blockfrost networks to cardano ones since we expect to find actor keys
    -- in known locations when running smoke-tests.
    KnownNetwork
BlockfrostPreview -> FilePath
"preview"
    KnownNetwork
BlockfrostPreprod -> FilePath
"preprod"
    KnownNetwork
BlockfrostMainnet -> FilePath
"mainnet"

  fetchConfigFile :: FilePath -> f ByteString
fetchConfigFile FilePath
path =
    FilePath -> f Request
forall (m :: * -> *). MonadThrow m => FilePath -> m Request
parseRequestThrow FilePath
path f Request
-> (Request -> f (Response ByteString)) -> f (Response ByteString)
forall a b. f a -> (a -> f b) -> f b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Request -> f (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
httpBS f (Response ByteString)
-> (Response ByteString -> ByteString) -> f ByteString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Response ByteString -> ByteString
forall a. Response a -> a
getResponseBody

-- | Setup the cardano-node to run a local devnet producing blocks. This copies
-- the appropriate files and prepares 'CardanoNodeArgs' for 'withCardanoNode'.
setupCardanoDevnet :: FilePath -> IO CardanoNodeArgs
setupCardanoDevnet :: FilePath -> IO CardanoNodeArgs
setupCardanoDevnet FilePath
stateDirectory = do
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
stateDirectory
  [FilePath
dlgCert, FilePath
signKey, FilePath
vrfKey, FilePath
kesKey, FilePath
opCert] <-
    (FilePath -> IO FilePath) -> [FilePath] -> IO [FilePath]
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
      FilePath -> IO FilePath
copyDevnetCredential
      [ FilePath
"byron-delegation.cert"
      , FilePath
"byron-delegate.key"
      , FilePath
"vrf.skey"
      , FilePath
"kes.skey"
      , FilePath
"opcert.cert"
      ]
  let args :: CardanoNodeArgs
args =
        CardanoNodeArgs
defaultCardanoNodeArgs
          { nodeDlgCertFile = Just dlgCert
          , nodeSignKeyFile = Just signKey
          , nodeVrfKeyFile = Just vrfKey
          , nodeKesKeyFile = Just kesKey
          , nodeOpCertFile = Just opCert
          }
  CardanoNodeArgs -> IO ()
copyDevnetFiles CardanoNodeArgs
args
  FilePath -> CardanoNodeArgs -> IO ()
refreshSystemStart FilePath
stateDirectory CardanoNodeArgs
args
  [Int] -> CardanoNodeArgs -> IO ()
writeTopology [] CardanoNodeArgs
args
  CardanoNodeArgs -> IO CardanoNodeArgs
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CardanoNodeArgs
args
 where
  copyDevnetCredential :: FilePath -> IO FilePath
copyDevnetCredential FilePath
file = do
    let destination :: FilePath
destination = FilePath
stateDirectory FilePath -> ShowS
</> FilePath
file
    IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (FilePath -> IO Bool
doesFileExist FilePath
destination) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      FilePath -> IO ByteString
readConfigFile (FilePath
"devnet" FilePath -> ShowS
</> FilePath
file)
        IO ByteString -> (ByteString -> 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
>>= FilePath -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> ByteString -> m ()
writeFileBS FilePath
destination
    FilePath -> FileMode -> IO ()
setFileMode FilePath
destination FileMode
ownerReadMode
    FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
file

  copyDevnetFiles :: CardanoNodeArgs -> IO ()
copyDevnetFiles CardanoNodeArgs
args = do
    FilePath -> IO ByteString
readConfigFile (FilePath
"devnet" FilePath -> ShowS
</> FilePath
"cardano-node.json")
      IO ByteString -> (ByteString -> 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
>>= FilePath -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> ByteString -> m ()
writeFileBS
        (FilePath
stateDirectory FilePath -> ShowS
</> CardanoNodeArgs -> FilePath
nodeConfigFile CardanoNodeArgs
args)
    FilePath -> IO ByteString
readConfigFile (FilePath
"devnet" FilePath -> ShowS
</> FilePath
"genesis-byron.json")
      IO ByteString -> (ByteString -> 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
>>= FilePath -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> ByteString -> m ()
writeFileBS
        (FilePath
stateDirectory FilePath -> ShowS
</> CardanoNodeArgs -> FilePath
nodeByronGenesisFile CardanoNodeArgs
args)
    FilePath -> IO ByteString
readConfigFile (FilePath
"devnet" FilePath -> ShowS
</> FilePath
"genesis-shelley.json")
      IO ByteString -> (ByteString -> 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
>>= FilePath -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> ByteString -> m ()
writeFileBS
        (FilePath
stateDirectory FilePath -> ShowS
</> CardanoNodeArgs -> FilePath
nodeShelleyGenesisFile CardanoNodeArgs
args)
    FilePath -> IO ByteString
readConfigFile (FilePath
"devnet" FilePath -> ShowS
</> FilePath
"genesis-alonzo.json")
      IO ByteString -> (ByteString -> 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
>>= FilePath -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> ByteString -> m ()
writeFileBS
        (FilePath
stateDirectory FilePath -> ShowS
</> CardanoNodeArgs -> FilePath
nodeAlonzoGenesisFile CardanoNodeArgs
args)
    FilePath -> IO ByteString
readConfigFile (FilePath
"devnet" FilePath -> ShowS
</> FilePath
"genesis-conway.json")
      IO ByteString -> (ByteString -> 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
>>= FilePath -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> ByteString -> m ()
writeFileBS
        (FilePath
stateDirectory FilePath -> ShowS
</> CardanoNodeArgs -> FilePath
nodeConwayGenesisFile CardanoNodeArgs
args)

  writeTopology :: [Int] -> CardanoNodeArgs -> IO ()
writeTopology [Int]
peers CardanoNodeArgs
args =
    FilePath -> Value -> IO ()
forall a. ToJSON a => FilePath -> a -> IO ()
Aeson.encodeFile (FilePath
stateDirectory FilePath -> ShowS
</> CardanoNodeArgs -> FilePath
nodeTopologyFile CardanoNodeArgs
args) (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
      [Int] -> Value
mkTopology [Int]
peers

withCardanoNode ::
  Tracer IO NodeLog ->
  FilePath ->
  CardanoNodeArgs ->
  (NominalDiffTime -> DirectBackend -> IO a) ->
  IO a
withCardanoNode :: forall a.
Tracer IO NodeLog
-> FilePath
-> CardanoNodeArgs
-> (NominalDiffTime -> DirectBackend -> IO a)
-> IO a
withCardanoNode Tracer IO NodeLog
tr FilePath
stateDirectory CardanoNodeArgs
args NominalDiffTime -> DirectBackend -> IO a
action = do
  Tracer IO NodeLog -> NodeLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO NodeLog
tr (NodeLog -> IO ()) -> NodeLog -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> NodeLog
MsgNodeCmdSpec (CmdSpec -> Text
forall b a. (Show a, IsString b) => a -> b
show (CmdSpec -> Text) -> CmdSpec -> Text
forall a b. (a -> b) -> a -> b
$ CreateProcess -> CmdSpec
cmdspec CreateProcess
process)
  FilePath -> (Handle -> IO a) -> IO a
forall a. FilePath -> (Handle -> IO a) -> IO a
withLogFile FilePath
logFilePath ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Handle
out -> do
    Handle -> BufferMode -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> BufferMode -> m ()
hSetBuffering Handle
out BufferMode
NoBuffering
    CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess CreateProcess
process{std_out = UseHandle out, std_err = CreatePipe} ((Maybe Handle
  -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
 -> IO a)
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
forall a b. (a -> b) -> a -> b
$
      \Maybe Handle
_stdin Maybe Handle
_stdout Maybe Handle
mError ProcessHandle
processHandle ->
        (IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` IO ()
cleanupSocketFile) (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$
          IO Void -> IO a -> IO (Either Void a)
forall a b. IO a -> IO b -> IO (Either a b)
forall (m :: * -> *) a b.
MonadAsync m =>
m a -> m b -> m (Either a b)
race (Text -> ProcessHandle -> Maybe Handle -> IO Void
checkProcessHasNotDied Text
"cardano-node" ProcessHandle
processHandle Maybe Handle
mError) IO a
waitForNode
            IO (Either Void a) -> (Either Void a -> a) -> IO a
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Void -> a) -> (a -> a) -> Either Void a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Void -> a
forall a. Void -> a
absurd a -> a
forall a. a -> a
id
 where
  CardanoNodeArgs{FilePath
$sel:nodeSocket:CardanoNodeArgs :: CardanoNodeArgs -> FilePath
nodeSocket :: FilePath
nodeSocket} = CardanoNodeArgs
args

  process :: CreateProcess
process = Maybe FilePath -> CardanoNodeArgs -> CreateProcess
cardanoNodeProcess (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
stateDirectory) CardanoNodeArgs
args

  logFilePath :: FilePath
logFilePath = FilePath
stateDirectory FilePath -> ShowS
</> FilePath
"logs" FilePath -> ShowS
</> FilePath
"cardano-node.log"

  socketPath :: FilePath
socketPath = FilePath
stateDirectory FilePath -> ShowS
</> FilePath
nodeSocket

  waitForNode :: IO a
waitForNode = do
    let nodeSocketPath :: SocketPath
nodeSocketPath = FilePath -> SocketPath
forall content (direction :: FileDirection).
FilePath -> File content direction
File FilePath
socketPath
    Tracer IO NodeLog -> NodeLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO NodeLog
tr (NodeLog -> IO ()) -> NodeLog -> IO ()
forall a b. (a -> b) -> a -> b
$ MsgNodeStarting{FilePath
$sel:stateDirectory:MsgNodeCmdSpec :: FilePath
stateDirectory :: FilePath
stateDirectory}
    SocketPath -> IO ()
waitForSocket SocketPath
nodeSocketPath
    Tracer IO NodeLog -> NodeLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO NodeLog
tr (NodeLog -> IO ()) -> NodeLog -> IO ()
forall a b. (a -> b) -> a -> b
$ SocketPath -> NodeLog
MsgSocketIsReady SocketPath
nodeSocketPath
    Value
shelleyGenesis <- FilePath -> IO Value
readShelleyGenesisJSON (FilePath -> IO Value) -> FilePath -> IO Value
forall a b. (a -> b) -> a -> b
$ FilePath
stateDirectory FilePath -> ShowS
</> CardanoNodeArgs -> FilePath
nodeShelleyGenesisFile CardanoNodeArgs
args
    NominalDiffTime -> DirectBackend -> IO a
action (Value -> NominalDiffTime
getShelleyGenesisBlockTime Value
shelleyGenesis) (DirectOptions -> DirectBackend
DirectBackend (DirectOptions -> DirectBackend) -> DirectOptions -> DirectBackend
forall a b. (a -> b) -> a -> b
$ DirectOptions{$sel:networkId:DirectOptions :: NetworkId
networkId = Value -> NetworkId
getShelleyGenesisNetworkId Value
shelleyGenesis, $sel:nodeSocket:DirectOptions :: SocketPath
nodeSocket = FilePath -> SocketPath
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath
stateDirectory FilePath -> ShowS
</> FilePath
nodeSocket)})

  cleanupSocketFile :: IO ()
cleanupSocketFile =
    IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (FilePath -> IO Bool
doesFileExist FilePath
socketPath) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      FilePath -> IO ()
removeFile FilePath
socketPath

  readShelleyGenesisJSON :: FilePath -> IO Value
readShelleyGenesisJSON = FilePath -> IO ByteString
forall (m :: * -> *). MonadIO m => FilePath -> m ByteString
readFileBS (FilePath -> IO ByteString)
-> (ByteString -> IO Value) -> FilePath -> IO Value
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> IO Value
forall a. FromJSON a => ByteString -> IO a
unsafeDecodeJson

  -- Read 'NetworkId' from shelley genesis JSON file
  getShelleyGenesisNetworkId :: Value -> NetworkId
  getShelleyGenesisNetworkId :: Value -> NetworkId
getShelleyGenesisNetworkId Value
json = do
    if Value
json Value -> Getting (Endo Value) Value Value -> Value
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"networkId" Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
"Mainnet"
      then NetworkId
Api.Mainnet
      else do
        let magic :: Scientific
magic = Value
json Value -> Getting (Endo Scientific) Value Scientific -> Scientific
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"networkMagic" ((Value -> Const (Endo Scientific) Value)
 -> Value -> Const (Endo Scientific) Value)
-> Getting (Endo Scientific) Value Scientific
-> Getting (Endo Scientific) Value Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Scientific) Value Scientific
forall t. AsNumber t => Prism' t Scientific
Prism' Value Scientific
_Number
        NetworkMagic -> NetworkId
Api.Testnet (Word32 -> NetworkMagic
Api.NetworkMagic (Word32 -> NetworkMagic) -> Word32 -> NetworkMagic
forall a b. (a -> b) -> a -> b
$ Scientific -> Word32
forall b. Integral b => Scientific -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate Scientific
magic)

-- Read expected time between blocks from shelley genesis
getShelleyGenesisBlockTime :: Value -> NominalDiffTime
getShelleyGenesisBlockTime :: Value -> NominalDiffTime
getShelleyGenesisBlockTime Value
json = do
  let slotLength :: Scientific
slotLength = Value
json Value -> Getting (Endo Scientific) Value Scientific -> Scientific
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"slotLength" ((Value -> Const (Endo Scientific) Value)
 -> Value -> Const (Endo Scientific) Value)
-> Getting (Endo Scientific) Value Scientific
-> Getting (Endo Scientific) Value Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Scientific) Value Scientific
forall t. AsNumber t => Prism' t Scientific
Prism' Value Scientific
_Number
  let activeSlotsCoeff :: Scientific
activeSlotsCoeff = Value
json Value -> Getting (Endo Scientific) Value Scientific -> Scientific
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"activeSlotsCoeff" ((Value -> Const (Endo Scientific) Value)
 -> Value -> Const (Endo Scientific) Value)
-> Getting (Endo Scientific) Value Scientific
-> Getting (Endo Scientific) Value Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Scientific) Value Scientific
forall t. AsNumber t => Prism' t Scientific
Prism' Value Scientific
_Number
  NominalDiffTime -> Rational -> NominalDiffTime
computeBlockTime (Scientific -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Scientific
slotLength) (Scientific -> Rational
forall a. Real a => a -> Rational
toRational Scientific
activeSlotsCoeff)

-- | Compute the block time (expected time between blocks) given a slot length
-- as diff time and active slot coefficient.
computeBlockTime :: NominalDiffTime -> Rational -> NominalDiffTime
computeBlockTime :: NominalDiffTime -> Rational -> NominalDiffTime
computeBlockTime NominalDiffTime
slotLength Rational
activeSlotsCoeff =
  NominalDiffTime
slotLength NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Fractional a => a -> a -> a
/ Rational -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Rational
activeSlotsCoeff

-- | Wait until the node is fully caught up with the network. This can take a
-- while!
waitForFullySynchronized ::
  ChainBackend backend =>
  Tracer IO NodeLog ->
  backend ->
  IO ()
waitForFullySynchronized :: forall backend.
ChainBackend backend =>
Tracer IO NodeLog -> backend -> IO ()
waitForFullySynchronized Tracer IO NodeLog
tracer backend
backend = do
  SystemStart
systemStart <- backend -> QueryPoint -> IO SystemStart
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> QueryPoint -> m SystemStart
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> QueryPoint -> m SystemStart
Backend.querySystemStart backend
backend QueryPoint
QueryTip
  SystemStart -> IO ()
check SystemStart
systemStart
 where
  check :: SystemStart -> IO ()
check SystemStart
systemStart = do
    RelativeTime
targetTime <- SystemStart -> UTCTime -> RelativeTime
toRelativeTime SystemStart
systemStart (UTCTime -> RelativeTime) -> IO UTCTime -> IO RelativeTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
    EraHistory
eraHistory <- backend -> QueryPoint -> IO EraHistory
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> QueryPoint -> m EraHistory
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> QueryPoint -> m EraHistory
Backend.queryEraHistory backend
backend QueryPoint
QueryTip
    SlotNo
tipSlotNo <- SlotNo -> Maybe SlotNo -> SlotNo
forall a. a -> Maybe a -> a
fromMaybe SlotNo
0 (Maybe SlotNo -> SlotNo)
-> (ChainPoint -> Maybe SlotNo) -> ChainPoint -> SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainPoint -> Maybe SlotNo
Api.chainPointToSlotNo (ChainPoint -> SlotNo) -> IO ChainPoint -> IO SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> backend -> IO ChainPoint
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> m ChainPoint
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> m ChainPoint
Backend.queryTip backend
backend
    (RelativeTime
tipTime, SlotLength
_slotLength) <- (PastHorizonException -> IO (RelativeTime, SlotLength))
-> ((RelativeTime, SlotLength) -> IO (RelativeTime, SlotLength))
-> Either PastHorizonException (RelativeTime, SlotLength)
-> IO (RelativeTime, SlotLength)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PastHorizonException -> IO (RelativeTime, SlotLength)
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (RelativeTime, SlotLength) -> IO (RelativeTime, SlotLength)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either PastHorizonException (RelativeTime, SlotLength)
 -> IO (RelativeTime, SlotLength))
-> Either PastHorizonException (RelativeTime, SlotLength)
-> IO (RelativeTime, SlotLength)
forall a b. (a -> b) -> a -> b
$ SlotNo
-> EraHistory
-> Either PastHorizonException (RelativeTime, SlotLength)
getProgress SlotNo
tipSlotNo EraHistory
eraHistory
    let timeDifference :: NominalDiffTime
timeDifference = RelativeTime -> RelativeTime -> NominalDiffTime
diffRelativeTime RelativeTime
targetTime RelativeTime
tipTime
    let percentDone :: Centi
percentDone = NominalDiffTime -> Centi
forall a b. (Real a, Fractional b) => a -> b
realToFrac (NominalDiffTime
100.0 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* RelativeTime -> NominalDiffTime
getRelativeTime RelativeTime
tipTime NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Fractional a => a -> a -> a
/ RelativeTime -> NominalDiffTime
getRelativeTime RelativeTime
targetTime)
    NominalDiffTime
blockTime <- backend -> (MonadIO IO, MonadThrow IO) => IO NominalDiffTime
forall a (m :: * -> *).
ChainBackend a =>
a -> (MonadIO m, MonadThrow m) => m NominalDiffTime
forall (m :: * -> *).
backend -> (MonadIO m, MonadThrow m) => m NominalDiffTime
Backend.getBlockTime backend
backend
    Tracer IO NodeLog -> NodeLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO NodeLog
tracer (NodeLog -> IO ()) -> NodeLog -> IO ()
forall a b. (a -> b) -> a -> b
$ MsgSynchronizing{Centi
$sel:percentDone:MsgNodeCmdSpec :: Centi
percentDone :: Centi
percentDone}
    if NominalDiffTime
timeDifference NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
< NominalDiffTime
blockTime
      then () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      else DiffTime -> IO ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
3 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SystemStart -> IO ()
check SystemStart
systemStart

-- | Wait for the node socket file to become available.
waitForSocket :: SocketPath -> IO ()
waitForSocket :: SocketPath -> IO ()
waitForSocket SocketPath
socketPath =
  IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ SocketPath -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile SocketPath
socketPath) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    DiffTime -> IO ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
0.1
    SocketPath -> IO ()
waitForSocket SocketPath
socketPath

-- | Generate command-line arguments for launching @cardano-node@.
cardanoNodeProcess :: Maybe FilePath -> CardanoNodeArgs -> CreateProcess
cardanoNodeProcess :: Maybe FilePath -> CardanoNodeArgs -> CreateProcess
cardanoNodeProcess Maybe FilePath
cwd CardanoNodeArgs
args =
  (FilePath -> [FilePath] -> CreateProcess
proc FilePath
"cardano-node" [FilePath]
strArgs){cwd}
 where
  CardanoNodeArgs
    { FilePath
$sel:nodeConfigFile:CardanoNodeArgs :: CardanoNodeArgs -> FilePath
nodeConfigFile :: FilePath
nodeConfigFile
    , FilePath
$sel:nodeTopologyFile:CardanoNodeArgs :: CardanoNodeArgs -> FilePath
nodeTopologyFile :: FilePath
nodeTopologyFile
    , FilePath
$sel:nodeDatabaseDir:CardanoNodeArgs :: CardanoNodeArgs -> FilePath
nodeDatabaseDir :: FilePath
nodeDatabaseDir
    , FilePath
$sel:nodeSocket:CardanoNodeArgs :: CardanoNodeArgs -> FilePath
nodeSocket :: FilePath
nodeSocket
    , Maybe Int
$sel:nodePort:CardanoNodeArgs :: CardanoNodeArgs -> Maybe Int
nodePort :: Maybe Int
nodePort
    , Maybe FilePath
$sel:nodeSignKeyFile:CardanoNodeArgs :: CardanoNodeArgs -> Maybe FilePath
nodeSignKeyFile :: Maybe FilePath
nodeSignKeyFile
    , Maybe FilePath
$sel:nodeDlgCertFile:CardanoNodeArgs :: CardanoNodeArgs -> Maybe FilePath
nodeDlgCertFile :: Maybe FilePath
nodeDlgCertFile
    , Maybe FilePath
$sel:nodeOpCertFile:CardanoNodeArgs :: CardanoNodeArgs -> Maybe FilePath
nodeOpCertFile :: Maybe FilePath
nodeOpCertFile
    , Maybe FilePath
$sel:nodeKesKeyFile:CardanoNodeArgs :: CardanoNodeArgs -> Maybe FilePath
nodeKesKeyFile :: Maybe FilePath
nodeKesKeyFile
    , Maybe FilePath
$sel:nodeVrfKeyFile:CardanoNodeArgs :: CardanoNodeArgs -> Maybe FilePath
nodeVrfKeyFile :: Maybe FilePath
nodeVrfKeyFile
    } = CardanoNodeArgs
args

  strArgs :: [FilePath]
strArgs =
    FilePath
"run"
      FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [[FilePath]] -> [FilePath]
forall a. Monoid a => [a] -> a
mconcat
        [ [FilePath
"--config", FilePath
nodeConfigFile]
        , [FilePath
"--topology", FilePath
nodeTopologyFile]
        , [FilePath
"--database-path", FilePath
nodeDatabaseDir]
        , [FilePath
"--socket-path", FilePath
nodeSocket]
        , FilePath -> Maybe FilePath -> [FilePath]
forall a. a -> Maybe a -> [a]
opt FilePath
"--port" (Int -> FilePath
forall b a. (Show a, IsString b) => a -> b
show (Int -> FilePath) -> Maybe Int -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
nodePort)
        , FilePath -> Maybe FilePath -> [FilePath]
forall a. a -> Maybe a -> [a]
opt FilePath
"--byron-signing-key" Maybe FilePath
nodeSignKeyFile
        , FilePath -> Maybe FilePath -> [FilePath]
forall a. a -> Maybe a -> [a]
opt FilePath
"--byron-delegation-certificate" Maybe FilePath
nodeDlgCertFile
        , FilePath -> Maybe FilePath -> [FilePath]
forall a. a -> Maybe a -> [a]
opt FilePath
"--shelley-operational-certificate" Maybe FilePath
nodeOpCertFile
        , FilePath -> Maybe FilePath -> [FilePath]
forall a. a -> Maybe a -> [a]
opt FilePath
"--shelley-kes-key" Maybe FilePath
nodeKesKeyFile
        , FilePath -> Maybe FilePath -> [FilePath]
forall a. a -> Maybe a -> [a]
opt FilePath
"--shelley-vrf-key" Maybe FilePath
nodeVrfKeyFile
        ]

  opt :: a -> Maybe a -> [a]
  opt :: forall a. a -> Maybe a -> [a]
opt a
arg = \case
    Maybe a
Nothing -> []
    Just a
val -> [a
arg, a
val]

-- | Initialize the system start time to now (modulo a small offset needed to
-- give time to the system to bootstrap correctly).
initSystemStart :: IO UTCTime
initSystemStart :: IO UTCTime
initSystemStart =
  NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
1 (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime

-- | Re-generate configuration and genesis files with fresh system start times.
refreshSystemStart ::
  -- | Working directory in which paths of 'CardanoNodeArgs' are resolved.
  FilePath ->
  CardanoNodeArgs ->
  IO ()
refreshSystemStart :: FilePath -> CardanoNodeArgs -> IO ()
refreshSystemStart FilePath
stateDirectory CardanoNodeArgs
args = do
  UTCTime
systemStart <- IO UTCTime
initSystemStart
  let startTime :: Int
startTime = forall a b. (RealFrac a, Integral b) => a -> b
round @_ @Int (NominalDiffTime -> Int) -> NominalDiffTime -> Int
forall a b. (a -> b) -> a -> b
$ UTCTime -> NominalDiffTime
utcTimeToPOSIXSeconds UTCTime
systemStart
  Value
byronGenesis <-
    forall a. FromJSON a => FilePath -> IO a
unsafeDecodeJsonFile @Aeson.Value (FilePath
stateDirectory FilePath -> ShowS
</> CardanoNodeArgs -> FilePath
nodeByronGenesisFile CardanoNodeArgs
args)
      IO Value -> (Value -> Value) -> IO Value
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Key -> Traversal' Value (Maybe Value)
forall t. AsValue t => Key -> Traversal' t (Maybe Value)
atKey Key
"startTime" ((Maybe Value -> Identity (Maybe Value))
 -> Value -> Identity Value)
-> Value -> Value -> Value
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
startTime

  let systemStartUTC :: UTCTime
systemStartUTC =
        NominalDiffTime -> UTCTime
posixSecondsToUTCTime (NominalDiffTime -> UTCTime)
-> (Int -> NominalDiffTime) -> Int -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> NominalDiffTime
forall a. Fractional a => Rational -> a
fromRational (Rational -> NominalDiffTime)
-> (Int -> Rational) -> Int -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Rational
forall a. Real a => a -> Rational
toRational (Int -> UTCTime) -> Int -> UTCTime
forall a b. (a -> b) -> a -> b
$ Int
startTime
  Value
shelleyGenesis <-
    forall a. FromJSON a => FilePath -> IO a
unsafeDecodeJsonFile @Aeson.Value (FilePath
stateDirectory FilePath -> ShowS
</> CardanoNodeArgs -> FilePath
nodeShelleyGenesisFile CardanoNodeArgs
args)
      IO Value -> (Value -> Value) -> IO Value
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Key -> Traversal' Value (Maybe Value)
forall t. AsValue t => Key -> Traversal' t (Maybe Value)
atKey Key
"systemStart" ((Maybe Value -> Identity (Maybe Value))
 -> Value -> Identity Value)
-> Value -> Value -> Value
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ UTCTime -> Value
forall a. ToJSON a => a -> Value
toJSON UTCTime
systemStartUTC

  Value
config <-
    forall a. FromJSON a => FilePath -> IO a
unsafeDecodeJsonFile @Aeson.Value (FilePath
stateDirectory FilePath -> ShowS
</> CardanoNodeArgs -> FilePath
nodeConfigFile CardanoNodeArgs
args)
      IO Value -> (Value -> Value) -> IO Value
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Key -> Traversal' Value (Maybe Value)
forall t. AsValue t => Key -> Traversal' t (Maybe Value)
atKey Key
"ByronGenesisFile" ((Maybe Value -> Identity (Maybe Value))
 -> Value -> Identity Value)
-> Value -> Value -> Value
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
forall a. ToJSON a => a -> Value
toJSON (FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ CardanoNodeArgs -> FilePath
nodeByronGenesisFile CardanoNodeArgs
args))
        (Value -> Value) -> (Value -> Value) -> Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key -> Traversal' Value (Maybe Value)
forall t. AsValue t => Key -> Traversal' t (Maybe Value)
atKey Key
"ShelleyGenesisFile" ((Maybe Value -> Identity (Maybe Value))
 -> Value -> Identity Value)
-> Value -> Value -> Value
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
String (FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ CardanoNodeArgs -> FilePath
nodeShelleyGenesisFile CardanoNodeArgs
args))

  FilePath -> Value -> IO ()
forall a. ToJSON a => FilePath -> a -> IO ()
Aeson.encodeFile
    (FilePath
stateDirectory FilePath -> ShowS
</> CardanoNodeArgs -> FilePath
nodeByronGenesisFile CardanoNodeArgs
args)
    Value
byronGenesis
  FilePath -> Value -> IO ()
forall a. ToJSON a => FilePath -> a -> IO ()
Aeson.encodeFile
    (FilePath
stateDirectory FilePath -> ShowS
</> CardanoNodeArgs -> FilePath
nodeShelleyGenesisFile CardanoNodeArgs
args)
    Value
shelleyGenesis
  FilePath -> Value -> IO ()
forall a. ToJSON a => FilePath -> a -> IO ()
Aeson.encodeFile (FilePath
stateDirectory FilePath -> ShowS
</> CardanoNodeArgs -> FilePath
nodeConfigFile CardanoNodeArgs
args) Value
config

-- | Generate a topology file from a list of peers.
mkTopology :: [Port] -> Aeson.Value
mkTopology :: [Int] -> Value
mkTopology [Int]
peers =
  [Pair] -> Value
Aeson.object [Key
"Producers" Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Int -> Value) -> [Int] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Value
encodePeer [Int]
peers]
 where
  encodePeer :: Int -> Aeson.Value
  encodePeer :: Int -> Value
encodePeer Int
port =
    [Pair] -> Value
Aeson.object
      [Key
"addr" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"127.0.0.1" :: Text), Key
"port" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
port, Key
"valency" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Int
1 :: Int)]

data ProcessHasExited = ProcessHasExited Text ExitCode
  deriving stock (Int -> ProcessHasExited -> ShowS
[ProcessHasExited] -> ShowS
ProcessHasExited -> FilePath
(Int -> ProcessHasExited -> ShowS)
-> (ProcessHasExited -> FilePath)
-> ([ProcessHasExited] -> ShowS)
-> Show ProcessHasExited
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProcessHasExited -> ShowS
showsPrec :: Int -> ProcessHasExited -> ShowS
$cshow :: ProcessHasExited -> FilePath
show :: ProcessHasExited -> FilePath
$cshowList :: [ProcessHasExited] -> ShowS
showList :: [ProcessHasExited] -> ShowS
Show)

-- | Cardano-cli wrapper to query protocol parameters. While we have also client
-- functions in Hydra.Chain.CardanoClient and Hydra.Cluster.CardanoClient,
-- sometimes we deliberately want to use the cardano-cli to ensure
-- compatibility.
cliQueryProtocolParameters :: SocketPath -> NetworkId -> IO Value
cliQueryProtocolParameters :: SocketPath -> NetworkId -> IO Value
cliQueryProtocolParameters SocketPath
nodeSocket NetworkId
networkId = do
  FilePath
out <- FilePath -> [FilePath] -> FilePath -> IO FilePath
readProcess FilePath
cmd [FilePath]
args FilePath
""
  ByteString -> IO Value
forall a. FromJSON a => ByteString -> IO a
unsafeDecodeJson (ByteString -> IO Value) -> ByteString -> IO Value
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
forall a. IsString a => FilePath -> a
fromString FilePath
out
 where
  cmd :: FilePath
cmd = FilePath
"cardano-cli"

  args :: [FilePath]
args =
    [ FilePath
"conway"
    , FilePath
"query"
    , FilePath
"protocol-parameters"
    , FilePath
"--socket-path"
    , SocketPath -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile SocketPath
nodeSocket
    ]
      [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> case NetworkId
networkId of
        NetworkId
Api.Mainnet -> [FilePath
"--mainnet"]
        Api.Testnet (NetworkMagic Word32
magic) -> [FilePath
"--testnet-magic", Word32 -> FilePath
forall b a. (Show a, IsString b) => a -> b
show Word32
magic]
      [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [ FilePath
"--out-file"
         , FilePath
"/dev/stdout"
         ]

--
-- Helpers
--

unsafeDecodeJson :: FromJSON a => ByteString -> IO a
unsafeDecodeJson :: forall a. FromJSON a => ByteString -> IO a
unsafeDecodeJson = (FilePath -> IO a) -> (a -> IO a) -> Either FilePath a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> IO a
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath a -> IO a)
-> (ByteString -> Either FilePath a) -> ByteString -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either FilePath a
forall a. FromJSON a => ByteString -> Either FilePath a
Aeson.eitherDecodeStrict

unsafeDecodeJsonFile :: FromJSON a => FilePath -> IO a
unsafeDecodeJsonFile :: forall a. FromJSON a => FilePath -> IO a
unsafeDecodeJsonFile = FilePath -> IO (Either FilePath a)
forall a. FromJSON a => FilePath -> IO (Either FilePath a)
Aeson.eitherDecodeFileStrict (FilePath -> IO (Either FilePath a))
-> (Either FilePath a -> IO a) -> FilePath -> IO a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (FilePath -> IO a) -> (a -> IO a) -> Either FilePath a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> IO a
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure