{-# LANGUAGE DuplicateRecordFields #-}

-- | Utilities used across hydra-cluster
module Hydra.Cluster.Util where

import Hydra.Prelude

import Control.Exception (SomeAsyncException (..))
import Crypto.Random (getRandomBytes)
import Data.Aeson qualified as Aeson
import Data.ByteString qualified as BS
import Data.Secret (Secret, mkSecret, withSecret)
import Hydra.Cardano.Api (
  AsType (AsPaymentKey),
  File (..),
  FileError,
  HasTextEnvelope,
  Key (VerificationKey, verificationKeyHash),
  NetworkId,
  PaymentKey,
  SigningKey,
  TextEnvelopeError (TextEnvelopeAesonDecodeError),
  TxId,
  deserialiseFromTextEnvelope,
  generateSigningKey,
  serialiseToRawBytesHexText,
  textEnvelopeToJSON,
  writeLazyByteStringFileWithOwnerPermissions,
 )
import Hydra.Cluster.Fixture (Actor, actorName, fundsOf)
import Hydra.Node.UnsyncedPeriod (defaultUnsyncedPeriodFor)
import Hydra.Options (
  CardanoChainConfig (..),
  ChainBackendOptions (..),
  ChainConfig (..),
  DirectOptions (..),
  defaultCardanoChainConfig,
 )
import Hydra.Tx (Party, deriveParty)
import Hydra.Tx.ContestationPeriod (ContestationPeriod)
import Hydra.Tx.Crypto (HydraKey, getVerificationKey)
import Hydra.Tx.Crypto qualified as Crypto
import Hydra.Tx.DepositPeriod (DepositPeriod)
import Hydra.Tx.DepositPeriod qualified as DP
import Paths_hydra_cluster qualified as Pkg
import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, listDirectory, removeFile, renameDirectory, renameFile)
import System.FilePath (takeFileName, (<.>), (</>))
import Test.Hydra.Prelude (failure)
import Test.Hydra.Tx.Gen (genSigningKey)
import Test.QuickCheck (generate)

-- | Lookup a config file similar reading a file from disk.
-- If the env variable `HYDRA_CONFIG_DIR` is set, filenames will be
-- resolved relative to its value otherwise they will be looked up in the
-- package's data path.
readConfigFile :: FilePath -> IO ByteString
readConfigFile :: String -> IO ByteString
readConfigFile String
source = do
  String
filename <-
    String -> IO (Maybe String)
forall (m :: * -> *). MonadIO m => String -> m (Maybe String)
lookupEnv String
"HYDRA_CONFIG_DIR"
      IO (Maybe String) -> (Maybe String -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO String
Pkg.getDataFileName (String
"config" String -> String -> String
</> String
source)) (String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> (String -> String) -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
</> String
source))
  String -> IO ByteString
BS.readFile String
filename

-- | Get the "well-known" keys for given actor. The signing key is
-- 'Secret'-wrapped so callers cannot accidentally log or serialise it.
--
-- NOTE: These keys are committed to this repository and shipped as package
-- data-files, so they are public and must never hold real funds. See
-- 'Participant' for what a run against a public network uses instead.
keysFor :: Actor -> IO (VerificationKey PaymentKey, Secret (SigningKey PaymentKey))
keysFor :: Actor
-> IO (VerificationKey PaymentKey, Secret (SigningKey PaymentKey))
keysFor Actor
actor = do
  let path :: String
path = String
"credentials" String -> String -> String
</> Actor -> String
actorName Actor
actor String -> String -> String
<.> String
"sk"
  Secret (SigningKey PaymentKey)
sk <- String -> ByteString -> IO (Secret (SigningKey PaymentKey))
decodeSigningKey String
path (ByteString -> IO (Secret (SigningKey PaymentKey)))
-> IO ByteString -> IO (Secret (SigningKey PaymentKey))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO ByteString
readConfigFile String
path
  (VerificationKey PaymentKey, Secret (SigningKey PaymentKey))
-> IO (VerificationKey PaymentKey, Secret (SigningKey PaymentKey))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Secret (SigningKey PaymentKey) -> VerificationKey PaymentKey
forall s k. HasVerificationKey s k => s -> VerificationKey k
getVerificationKey Secret (SigningKey PaymentKey)
sk, Secret (SigningKey PaymentKey)
sk)

-- | Decode a 'TextEnvelope'-encoded payment signing key, 'Secret'-wrapped.
--
-- NOTE: The failure names the file but never quotes it. A partly written key
-- still holds key material, and this error reaches the logs.
decodeSigningKey :: FilePath -> ByteString -> IO (Secret (SigningKey PaymentKey))
decodeSigningKey :: String -> ByteString -> IO (Secret (SigningKey PaymentKey))
decodeSigningKey String
path ByteString
bs =
  case (String -> TextEnvelopeError)
-> Either String TextEnvelope
-> Either TextEnvelopeError TextEnvelope
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 String -> TextEnvelopeError
TextEnvelopeAesonDecodeError (ByteString -> Either String TextEnvelope
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict ByteString
bs) Either TextEnvelopeError TextEnvelope
-> (TextEnvelope
    -> Either TextEnvelopeError (SigningKey PaymentKey))
-> Either TextEnvelopeError (SigningKey PaymentKey)
forall a b.
Either TextEnvelopeError a
-> (a -> Either TextEnvelopeError b) -> Either TextEnvelopeError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TextEnvelope -> Either TextEnvelopeError (SigningKey PaymentKey)
forall a.
HasTextEnvelope a =>
TextEnvelope -> Either TextEnvelopeError a
deserialiseFromTextEnvelope of
    Left TextEnvelopeError
err -> String -> IO (Secret (SigningKey PaymentKey))
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO (Secret (SigningKey PaymentKey)))
-> String -> IO (Secret (SigningKey PaymentKey))
forall a b. (a -> b) -> a -> b
$ String
"cannot decode text envelope at " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
path String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TextEnvelopeError -> String
forall b a. (Show a, IsString b) => a -> b
show TextEnvelopeError
err
    Right SigningKey PaymentKey
sk -> Secret (SigningKey PaymentKey)
-> IO (Secret (SigningKey PaymentKey))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SigningKey PaymentKey -> Secret (SigningKey PaymentKey)
forall a. a -> Secret a
mkSecret SigningKey PaymentKey
sk)

-- | Create and save new signing key at the provided path, returning the
-- key 'Secret'-wrapped.
-- NOTE: Uses 'TextEnvelope' format.
createAndSaveSigningKey :: FilePath -> IO (Secret (SigningKey PaymentKey))
createAndSaveSigningKey :: String -> IO (Secret (SigningKey PaymentKey))
createAndSaveSigningKey String
path = do
  SigningKey PaymentKey
sk <- Gen (SigningKey PaymentKey) -> IO (SigningKey PaymentKey)
forall a. Gen a -> IO a
generate Gen (SigningKey PaymentKey)
genSigningKey
  String -> LByteString -> IO ()
forall (m :: * -> *). MonadIO m => String -> LByteString -> m ()
writeFileLBS String
path (LByteString -> IO ()) -> LByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr -> SigningKey PaymentKey -> LByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> LByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
"Key used to commit funds into a Head") SigningKey PaymentKey
sk
  Secret (SigningKey PaymentKey)
-> IO (Secret (SigningKey PaymentKey))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SigningKey PaymentKey -> Secret (SigningKey PaymentKey)
forall a. a -> Secret a
mkSecret SigningKey PaymentKey
sk)

-- | Catch synchronous failures while allowing cancellation to propagate.
trySync :: IO a -> IO (Either SomeException a)
trySync :: forall a. IO a -> IO (Either SomeException a)
trySync IO a
action =
  IO a -> IO (Either SomeException a)
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 IO a
action IO (Either SomeException a)
-> (Either SomeException a -> IO (Either SomeException a))
-> IO (Either SomeException a)
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 | Just (SomeAsyncException e
_) <- SomeException -> Maybe SomeAsyncException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e -> SomeException -> IO (Either SomeException a)
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO SomeException
e
    Either SomeException a
result -> Either SomeException a -> IO (Either SomeException a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
result

-- * Ephemeral run credentials

-- | Fresh Cardano and Hydra credentials for the participant and its commit
-- wallet, persisted in 'keyDir' before funding.
data Participant = Participant
  { Participant -> VerificationKey PaymentKey
cardanoVk :: VerificationKey PaymentKey
  , Participant -> Secret (SigningKey PaymentKey)
cardanoSk :: Secret (SigningKey PaymentKey)
  , Participant -> Secret (SigningKey HydraKey)
hydraSk :: Secret (SigningKey HydraKey)
  , Participant -> VerificationKey PaymentKey
walletVk :: VerificationKey PaymentKey
  , Participant -> Secret (SigningKey PaymentKey)
walletSk :: Secret (SigningKey PaymentKey)
  , Participant -> String
keyDir :: FilePath
  -- ^ Directory holding this run's key files.
  }

-- | The 'Party' a 'Participant' appears as in a head.
participantParty :: Participant -> Party
participantParty :: Participant -> Party
participantParty Participant{Secret (SigningKey HydraKey)
$sel:hydraSk:Participant :: Participant -> Secret (SigningKey HydraKey)
hydraSk :: Secret (SigningKey HydraKey)
hydraSk} = Secret (SigningKey HydraKey) -> Party
deriveParty Secret (SigningKey HydraKey)
hydraSk

-- | Directory holding the keys of runs against this working directory.
--
-- Deliberately not named @state-@ anything: the runner wipes @state-*@ before
-- every run, and these keys have to outlive that.
participantKeysDir :: FilePath -> FilePath
participantKeysDir :: String -> String
participantKeysDir String
workDir = String
workDir String -> String -> String
</> String
"participant-keys"

-- | Where 'archiveParticipantKeys' moves the keys of a run whose funds are back.
sweptParticipantKeysDir :: FilePath -> FilePath
sweptParticipantKeysDir :: String -> String
sweptParticipantKeysDir String
workDir = String
workDir String -> String -> String
</> String
"participant-keys-swept"

-- | Path a hydra-node is pointed at with @--cardano-signing-key@.
participantCardanoKeyFile :: FilePath -> FilePath
participantCardanoKeyFile :: String -> String
participantCardanoKeyFile String
keyDir = String
keyDir String -> String -> String
</> String
"cardano.sk"

participantHydraKeyFile :: FilePath -> FilePath
participantHydraKeyFile :: String -> String
participantHydraKeyFile String
keyDir = String
keyDir String -> String -> String
</> String
"hydra.sk"

participantWalletKeyFile :: FilePath -> FilePath
participantWalletKeyFile :: String -> String
participantWalletKeyFile String
keyDir = String
keyDir String -> String -> String
</> String
"wallet.sk"

-- | Marker a run leaves while it has a head open on chain.
--
-- The address cannot tell: the node returns its own init change there, so a
-- sweep of it succeeds whether or not a head was left behind.
participantHeadOpenFile :: FilePath -> FilePath
participantHeadOpenFile :: String -> String
participantHeadOpenFile String
keyDir = String
keyDir String -> String -> String
</> String
"head-open"

markHeadOpen :: FilePath -> IO ()
markHeadOpen :: String -> IO ()
markHeadOpen String
keyDir = String -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => String -> ByteString -> m ()
writeFileBS (String -> String
participantHeadOpenFile String
keyDir) ByteString
""

clearHeadOpen :: FilePath -> IO ()
clearHeadOpen :: String -> IO ()
clearHeadOpen String
keyDir = String -> IO ()
removeFile (String -> String
participantHeadOpenFile String
keyDir)

headMayBeOpen :: FilePath -> IO Bool
headMayBeOpen :: String -> IO Bool
headMayBeOpen = String -> IO Bool
doesFileExist (String -> IO Bool) -> (String -> String) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
participantHeadOpenFile

-- | Every key of a run that can hold funds, and so has to be swept.
participantPaymentKeyFiles :: [FilePath -> FilePath]
participantPaymentKeyFiles :: [String -> String]
participantPaymentKeyFiles = [String -> String
participantCardanoKeyFile, String -> String
participantWalletKeyFile]

-- | Generate a fresh 'Participant' under 'participantKeysDir', in a directory
-- named after the Cardano key's hash so runs cannot clobber each other.
--
-- Uses system entropy rather than seedable test generators.
generateParticipant :: FilePath -> IO Participant
generateParticipant :: String -> IO Participant
generateParticipant String
workDir = do
  SigningKey PaymentKey
rawCardanoSk <- AsType PaymentKey -> IO (SigningKey PaymentKey)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole) =>
AsType keyrole -> m (SigningKey keyrole)
generateSigningKey AsType PaymentKey
AsPaymentKey
  SigningKey PaymentKey
rawWalletSk <- AsType PaymentKey -> IO (SigningKey PaymentKey)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole) =>
AsType keyrole -> m (SigningKey keyrole)
generateSigningKey AsType PaymentKey
AsPaymentKey
  Secret (SigningKey HydraKey)
hydraSk <- ByteString -> Secret (SigningKey HydraKey)
Crypto.generateSigningKey (ByteString -> Secret (SigningKey HydraKey))
-> IO ByteString -> IO (Secret (SigningKey HydraKey))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO ByteString
forall byteArray. ByteArray byteArray => Int -> IO byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
  let cardanoVk :: VerificationKey PaymentKey
cardanoVk = SigningKey PaymentKey -> VerificationKey PaymentKey
forall s k. HasVerificationKey s k => s -> VerificationKey k
getVerificationKey SigningKey PaymentKey
rawCardanoSk
      keyDir :: String
keyDir =
        String -> String
participantKeysDir String
workDir
          String -> String -> String
</> Text -> String
forall a. ToString a => a -> String
toString (Hash PaymentKey -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText (Hash PaymentKey -> Text) -> Hash PaymentKey -> Text
forall a b. (a -> b) -> a -> b
$ VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey PaymentKey
cardanoVk)
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
keyDir
  String -> SigningKey PaymentKey -> IO ()
forall k.
HasTextEnvelope (SigningKey k) =>
String -> SigningKey k -> IO ()
writeSigningKey (String -> String
participantCardanoKeyFile String
keyDir) SigningKey PaymentKey
rawCardanoSk
  String -> SigningKey PaymentKey -> IO ()
forall k.
HasTextEnvelope (SigningKey k) =>
String -> SigningKey k -> IO ()
writeSigningKey (String -> String
participantWalletKeyFile String
keyDir) SigningKey PaymentKey
rawWalletSk
  Secret (SigningKey HydraKey)
-> (SigningKey HydraKey -> IO ()) -> IO ()
forall a r. Secret a -> (a -> r) -> r
withSecret Secret (SigningKey HydraKey)
hydraSk ((SigningKey HydraKey -> IO ()) -> IO ())
-> (SigningKey HydraKey -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> SigningKey HydraKey -> IO ()
forall k.
HasTextEnvelope (SigningKey k) =>
String -> SigningKey k -> IO ()
writeSigningKey (String -> String
participantHydraKeyFile String
keyDir)
  Participant -> IO Participant
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Participant
      { VerificationKey PaymentKey
$sel:cardanoVk:Participant :: VerificationKey PaymentKey
cardanoVk :: VerificationKey PaymentKey
cardanoVk
      , $sel:cardanoSk:Participant :: Secret (SigningKey PaymentKey)
cardanoSk = SigningKey PaymentKey -> Secret (SigningKey PaymentKey)
forall a. a -> Secret a
mkSecret SigningKey PaymentKey
rawCardanoSk
      , Secret (SigningKey HydraKey)
$sel:hydraSk:Participant :: Secret (SigningKey HydraKey)
hydraSk :: Secret (SigningKey HydraKey)
hydraSk
      , $sel:walletVk:Participant :: VerificationKey PaymentKey
walletVk = SigningKey PaymentKey -> VerificationKey PaymentKey
forall s k. HasVerificationKey s k => s -> VerificationKey k
getVerificationKey SigningKey PaymentKey
rawWalletSk
      , $sel:walletSk:Participant :: Secret (SigningKey PaymentKey)
walletSk = SigningKey PaymentKey -> Secret (SigningKey PaymentKey)
forall a. a -> Secret a
mkSecret SigningKey PaymentKey
rawWalletSk
      , String
keyDir :: String
keyDir :: String
keyDir
      }

-- | Write an owner-only 'TextEnvelope', then rename it atomically into place
-- so interruption cannot leave a truncated key at the destination.
writeSigningKey :: HasTextEnvelope (SigningKey k) => FilePath -> SigningKey k -> IO ()
writeSigningKey :: forall k.
HasTextEnvelope (SigningKey k) =>
String -> SigningKey k -> IO ()
writeSigningKey String
path SigningKey k
sk = do
  let staging :: String
staging = String
path String -> String -> String
<.> String
"tmp"
  Either (FileError ()) ()
written <- File Any 'Out -> LByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> LByteString -> m (Either (FileError e) ())
writeLazyByteStringFileWithOwnerPermissions (String -> File Any 'Out
forall content (direction :: FileDirection).
String -> File content direction
File String
staging) (Maybe TextEnvelopeDescr -> SigningKey k -> LByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> LByteString
textEnvelopeToJSON Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing SigningKey k
sk)
  (FileError () -> IO ())
-> (() -> IO ()) -> Either (FileError ()) () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ())
-> (FileError () -> String) -> FileError () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError () -> String
forall b a. (Show a, IsString b) => a -> b
show) () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (FileError ()) ()
written :: Either (FileError ()) ())
  String -> String -> IO ()
renameFile String
staging String
path

-- | Read payment keys from each pending run directory, skipping missing files
-- and reporting decode failures per run. Non-directory entries are ignored.
leftoverParticipantKeys :: FilePath -> IO [(FilePath, Either Text [Secret (SigningKey PaymentKey)])]
leftoverParticipantKeys :: String
-> IO [(String, Either Text [Secret (SigningKey PaymentKey)])]
leftoverParticipantKeys String
workDir = do
  let dir :: String
dir = String -> String
participantKeysDir String
workDir
  Bool
exists <- String -> IO Bool
doesDirectoryExist String
dir
  if Bool -> Bool
not Bool
exists
    then [(String, Either Text [Secret (SigningKey PaymentKey)])]
-> IO [(String, Either Text [Secret (SigningKey PaymentKey)])]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    else do
      [String]
names <- String -> IO [String]
listDirectory String
dir
      [String]
keyDirs <- (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesDirectoryExist ((String
dir </>) (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> [String]
forall a. Ord a => [a] -> [a]
sort [String]
names)
      [String]
-> (String
    -> IO (String, Either Text [Secret (SigningKey PaymentKey)]))
-> IO [(String, Either Text [Secret (SigningKey PaymentKey)])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
keyDirs ((String
  -> IO (String, Either Text [Secret (SigningKey PaymentKey)]))
 -> IO [(String, Either Text [Secret (SigningKey PaymentKey)])])
-> (String
    -> IO (String, Either Text [Secret (SigningKey PaymentKey)]))
-> IO [(String, Either Text [Secret (SigningKey PaymentKey)])]
forall a b. (a -> b) -> a -> b
$ \String
keyDir -> (String
keyDir,) (Either Text [Secret (SigningKey PaymentKey)]
 -> (String, Either Text [Secret (SigningKey PaymentKey)]))
-> IO (Either Text [Secret (SigningKey PaymentKey)])
-> IO (String, Either Text [Secret (SigningKey PaymentKey)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Either Text [Secret (SigningKey PaymentKey)])
readPaymentKeys String
keyDir
 where
  readPaymentKeys :: FilePath -> IO (Either Text [Secret (SigningKey PaymentKey)])
  readPaymentKeys :: String -> IO (Either Text [Secret (SigningKey PaymentKey)])
readPaymentKeys String
keyDir =
    (SomeException -> Text)
-> Either SomeException [Secret (SigningKey PaymentKey)]
-> Either Text [Secret (SigningKey PaymentKey)]
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 (forall b a. (Show a, IsString b) => a -> b
show @Text @SomeException) (Either SomeException [Secret (SigningKey PaymentKey)]
 -> Either Text [Secret (SigningKey PaymentKey)])
-> IO (Either SomeException [Secret (SigningKey PaymentKey)])
-> IO (Either Text [Secret (SigningKey PaymentKey)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Secret (SigningKey PaymentKey)]
-> IO (Either SomeException [Secret (SigningKey PaymentKey)])
forall a. IO a -> IO (Either SomeException a)
trySync (([Maybe (Secret (SigningKey PaymentKey))]
 -> [Secret (SigningKey PaymentKey)])
-> IO [Maybe (Secret (SigningKey PaymentKey))]
-> IO [Secret (SigningKey PaymentKey)]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (Secret (SigningKey PaymentKey))]
-> [Secret (SigningKey PaymentKey)]
forall a. [Maybe a] -> [a]
catMaybes (IO [Maybe (Secret (SigningKey PaymentKey))]
 -> IO [Secret (SigningKey PaymentKey)])
-> (((String -> String)
     -> IO (Maybe (Secret (SigningKey PaymentKey))))
    -> IO [Maybe (Secret (SigningKey PaymentKey))])
-> ((String -> String)
    -> IO (Maybe (Secret (SigningKey PaymentKey))))
-> IO [Secret (SigningKey PaymentKey)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String -> String]
-> ((String -> String)
    -> IO (Maybe (Secret (SigningKey PaymentKey))))
-> IO [Maybe (Secret (SigningKey PaymentKey))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String -> String]
participantPaymentKeyFiles (((String -> String)
  -> IO (Maybe (Secret (SigningKey PaymentKey))))
 -> IO [Secret (SigningKey PaymentKey)])
-> ((String -> String)
    -> IO (Maybe (Secret (SigningKey PaymentKey))))
-> IO [Secret (SigningKey PaymentKey)]
forall a b. (a -> b) -> a -> b
$ String
-> (String -> String)
-> IO (Maybe (Secret (SigningKey PaymentKey)))
readKey String
keyDir)

  readKey :: FilePath -> (FilePath -> FilePath) -> IO (Maybe (Secret (SigningKey PaymentKey)))
  readKey :: String
-> (String -> String)
-> IO (Maybe (Secret (SigningKey PaymentKey)))
readKey String
keyDir String -> String
keyFile = do
    let path :: String
path = String -> String
keyFile String
keyDir
    Bool
present <- String -> IO Bool
doesFileExist String
path
    if Bool
present
      then Secret (SigningKey PaymentKey)
-> Maybe (Secret (SigningKey PaymentKey))
forall a. a -> Maybe a
Just (Secret (SigningKey PaymentKey)
 -> Maybe (Secret (SigningKey PaymentKey)))
-> IO (Secret (SigningKey PaymentKey))
-> IO (Maybe (Secret (SigningKey PaymentKey)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ByteString -> IO (Secret (SigningKey PaymentKey))
decodeSigningKey String
path (ByteString -> IO (Secret (SigningKey PaymentKey)))
-> IO ByteString -> IO (Secret (SigningKey PaymentKey))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO ByteString
BS.readFile String
path)
      else Maybe (Secret (SigningKey PaymentKey))
-> IO (Maybe (Secret (SigningKey PaymentKey)))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Secret (SigningKey PaymentKey))
forall a. Maybe a
Nothing

-- | Move keys to 'sweptParticipantKeysDir' without overwriting an existing
-- archive, returning any failure.
archiveParticipantKeys :: FilePath -> FilePath -> IO (Either Text ())
archiveParticipantKeys :: String -> String -> IO (Either Text ())
archiveParticipantKeys String
workDir String
keyDir =
  (SomeException -> Text)
-> Either SomeException () -> Either Text ()
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 (forall b a. (Show a, IsString b) => a -> b
show @Text @SomeException) (Either SomeException () -> Either Text ())
-> IO (Either SomeException ()) -> IO (Either Text ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO () -> IO (Either SomeException ())
forall a. IO a -> IO (Either SomeException a)
trySync IO ()
go
 where
  go :: IO ()
go = do
    let swept :: String
swept = String -> String
sweptParticipantKeysDir String
workDir
        dest :: String
dest = String
swept String -> String -> String
</> String -> String
takeFileName String
keyDir
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
swept
    Bool
alreadyThere <- String -> IO Bool
doesDirectoryExist String
dest
    if Bool
alreadyThere
      then String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"refusing to overwrite already archived keys at " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
dest
      else String -> String -> IO ()
renameDirectory String
keyDir String
dest

-- | Expected time between blocks (on average)
type BlockTime = NominalDiffTime

-- | Timing parameters that determine the behavior of a (cluster of) hydra-node.
data Timing = Timing
  { Timing -> NominalDiffTime
blockTime :: BlockTime
  , Timing -> ContestationPeriod
contestationPeriod :: ContestationPeriod
  , Timing -> DepositPeriod
depositPeriod :: DepositPeriod
  , Timing -> DepositPeriod
depositActivation :: DepositPeriod
  -- ^ Time a deposit must mature before it becomes active. Configured
  -- independently from 'depositPeriod'; the smart constructors default it to the
  -- same value so deposits activate as fast as they expire, but tests can set it
  -- separately to exercise decoupled activation.
  }
  deriving stock (Int -> Timing -> String -> String
[Timing] -> String -> String
Timing -> String
(Int -> Timing -> String -> String)
-> (Timing -> String)
-> ([Timing] -> String -> String)
-> Show Timing
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Timing -> String -> String
showsPrec :: Int -> Timing -> String -> String
$cshow :: Timing -> String
show :: Timing -> String
$cshowList :: [Timing] -> String -> String
showList :: [Timing] -> String -> String
Show)

-- | Truncate a duration to a whole-second 'DepositPeriod'.
truncatedDepositPeriod :: NominalDiffTime -> DepositPeriod
truncatedDepositPeriod :: NominalDiffTime -> DepositPeriod
truncatedDepositPeriod = NominalDiffTime -> DepositPeriod
DP.DepositPeriod (NominalDiffTime -> DepositPeriod)
-> (NominalDiffTime -> NominalDiffTime)
-> NominalDiffTime
-> DepositPeriod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> NominalDiffTime
forall a. Num a => Integer -> a
fromInteger (Integer -> NominalDiffTime)
-> (NominalDiffTime -> Integer)
-> NominalDiffTime
-> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> Integer
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate

-- | Set up reasonable timing parameters for testing given a 'BlockTime'.
mkTestTiming :: BlockTime -> Timing
mkTestTiming :: NominalDiffTime -> Timing
mkTestTiming = Int -> NominalDiffTime -> Timing
mkTestTiming' Int
1

-- | Like 'mkTestTiming' but scales 'depositPeriod' by the number of concurrent
-- deposits expected. Each increment tx must be processed sequentially on-chain,
-- so N concurrent deposits require N times the base deposit period.
mkTestTiming' :: Int -> BlockTime -> Timing
mkTestTiming' :: Int -> NominalDiffTime -> Timing
mkTestTiming' Int
numDeposits NominalDiffTime
blockTime =
  Timing
    { NominalDiffTime
$sel:blockTime:Timing :: NominalDiffTime
blockTime :: NominalDiffTime
blockTime
    , $sel:contestationPeriod:Timing :: ContestationPeriod
contestationPeriod = NominalDiffTime -> ContestationPeriod
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (NominalDiffTime -> ContestationPeriod)
-> NominalDiffTime -> ContestationPeriod
forall a b. (a -> b) -> a -> b
$ NominalDiffTime
20 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime
    , DepositPeriod
$sel:depositPeriod:Timing :: DepositPeriod
depositPeriod :: DepositPeriod
depositPeriod
    , $sel:depositActivation:Timing :: DepositPeriod
depositActivation = DepositPeriod
depositPeriod
    }
 where
  depositPeriod :: DepositPeriod
depositPeriod = NominalDiffTime -> DepositPeriod
truncatedDepositPeriod (NominalDiffTime -> DepositPeriod)
-> NominalDiffTime -> DepositPeriod
forall a b. (a -> b) -> a -> b
$ Int -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numDeposits NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
20 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime

-- | Timing for the smoke test run by the @hydra-cluster@ executable against a
-- public network, where a block takes ~20s and the run is dominated by waiting
-- out 'depositActivation' rather than by anything the scenario asserts.
--
-- A deposit becomes active at @created + depositActivation@, where @created@ is
-- the deposit tx's upper validity bound, set a grace time ahead of the chain
-- tip by 'Hydra.Chain.Direct.Handlers.draftDepositTx'. That grace time caps at
-- @min maxGraceTime (depositPeriod / 2)@, 200s here, so the wait is
-- @200 + depositActivation@ and only the second term is ours: at one block
-- time it drops from 200 + 400 to 200 + 20.
--
-- 'contestationPeriod' is cut to the point where the close transaction's
-- validity window stops changing, and no further. The contestation deadline is
-- @closeTxUpperBound + contestationPeriod@ with the close tx bounded at
-- @now + min contestationPeriod maxGraceTime@, so at @10 * blockTime@ = 200s
-- the wait halves from 600s to 400s while that @min@ still yields 200s, exactly
-- as it does at 'mkTestTiming'\'s 400s. Going below 200s would start shortening
-- the window every close, contest and increment has to be included in, with no
-- resubmit on expiry, and would drag two things with it: the derived
-- @unsyncedPeriod@ (half the contestation period, against a Blockfrost follower
-- that only observes blocks with a successor and so lags a block gap by
-- construction) and 'Hydra.Chain.Blockfrost.Client.submissionRetryPolicy',
-- whose ~180s worst case is documented against a 200s window.
--
-- 'depositPeriod' keeps its 'mkTestTiming' value. It is not on the critical
-- path -- it sets how long a deposit stays active, not how long anything waits
-- -- and shortening it only shrinks windows: the grace time is capped at half
-- of it, so both the deposit tx's validity and the active window
-- @depositPeriod - graceTime@ fall with it. 'Test.Hydra.Cluster.UtilSpec'
-- guards the value used here.
mkSmokeTiming :: BlockTime -> Timing
mkSmokeTiming :: NominalDiffTime -> Timing
mkSmokeTiming NominalDiffTime
blockTime =
  Timing
    { NominalDiffTime
$sel:blockTime:Timing :: NominalDiffTime
blockTime :: NominalDiffTime
blockTime
    , $sel:contestationPeriod:Timing :: ContestationPeriod
contestationPeriod = NominalDiffTime -> ContestationPeriod
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (NominalDiffTime -> ContestationPeriod)
-> NominalDiffTime -> ContestationPeriod
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Ord a => a -> a -> a
max NominalDiffTime
1 (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime)
    , $sel:depositPeriod:Timing :: DepositPeriod
depositPeriod = NominalDiffTime -> DepositPeriod
truncatedDepositPeriod (NominalDiffTime -> DepositPeriod)
-> NominalDiffTime -> DepositPeriod
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Ord a => a -> a -> a
max NominalDiffTime
1 (NominalDiffTime
20 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime)
    , $sel:depositActivation:Timing :: DepositPeriod
depositActivation = NominalDiffTime -> DepositPeriod
truncatedDepositPeriod (NominalDiffTime -> DepositPeriod)
-> NominalDiffTime -> DepositPeriod
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Ord a => a -> a -> a
max NominalDiffTime
1 NominalDiffTime
blockTime
    }

-- | Get a timeout until a deposit should have happened given a 'Timing'. A
-- deposit becomes active after 'depositActivation' and then needs about one
-- 'depositPeriod' to be picked up and incremented, so both are accounted for
-- (with the defaults where they are equal this is @2 * depositPeriod@).
--
-- The slack term covers the two on-chain round trips (deposit and increment:
-- submit, include, observe) plus multi-node processing. Those costs are
-- dominated by fixed latencies, not by block time, so the slack has a
-- constant floor; with the devnet's 0.1s blocks a pure @5 * blockTime@ came
-- to 0.5s and timed out regularly on loaded CI runners.
depositTimeout :: Timing -> NominalDiffTime
depositTimeout :: Timing -> NominalDiffTime
depositTimeout Timing{NominalDiffTime
$sel:blockTime:Timing :: Timing -> NominalDiffTime
blockTime :: NominalDiffTime
blockTime, DepositPeriod
$sel:depositPeriod:Timing :: Timing -> DepositPeriod
depositPeriod :: DepositPeriod
depositPeriod, DepositPeriod
$sel:depositActivation:Timing :: Timing -> DepositPeriod
depositActivation :: DepositPeriod
depositActivation} =
  DepositPeriod -> NominalDiffTime
DP.toNominalDiffTime DepositPeriod
depositActivation NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ DepositPeriod -> NominalDiffTime
DP.toNominalDiffTime DepositPeriod
depositPeriod NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Ord a => a -> a -> a
max NominalDiffTime
5 (NominalDiffTime
20 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime)

-- | Budget for observing the effect of one L1 transaction on the API:
-- submission, block inclusion, chain-follower observation and node
-- processing. The constant floor covers the fixed latencies, which dominate
-- at devnet block times; a pure blockTime multiple (e.g. a literal 3s) fired
-- regularly on loaded CI runners.
onChainObservationBudget :: NominalDiffTime -> NominalDiffTime
onChainObservationBudget :: NominalDiffTime -> NominalDiffTime
onChainObservationBudget NominalDiffTime
blockTime = NominalDiffTime
5 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime

-- | Budget for a hydra-node (re)start up to its Greetings. Process spawn,
-- etcd bootstrap and websocket connect are fixed costs, unrelated to block
-- time, so this is a constant.
nodeStartupBudget :: NominalDiffTime
nodeStartupBudget :: NominalDiffTime
nodeStartupBudget = NominalDiffTime
20

-- | Create a (test) chain config for a given actor.
chainConfigFor ::
  HasCallStack =>
  Actor ->
  FilePath ->
  ChainBackendOptions ->
  -- | Transaction ids at which Hydra scripts should have been published.
  [TxId] ->
  [Actor] ->
  Timing ->
  IO ChainConfig
chainConfigFor :: HasCallStack =>
Actor
-> String
-> ChainBackendOptions
-> [TxId]
-> [Actor]
-> Timing
-> IO ChainConfig
chainConfigFor Actor
me String
targetDir ChainBackendOptions
opts [TxId]
txids [Actor]
actors Timing
timing =
  HasCallStack =>
Actor
-> String
-> ChainBackendOptions
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> DepositPeriod
-> DepositPeriod
-> IO ChainConfig
Actor
-> String
-> ChainBackendOptions
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> DepositPeriod
-> DepositPeriod
-> IO ChainConfig
chainConfigFor' Actor
me String
targetDir ChainBackendOptions
opts [TxId]
txids [Actor]
actors ContestationPeriod
contestationPeriod DepositPeriod
depositPeriod DepositPeriod
depositActivation
 where
  Timing{ContestationPeriod
$sel:contestationPeriod:Timing :: Timing -> ContestationPeriod
contestationPeriod :: ContestationPeriod
contestationPeriod, DepositPeriod
$sel:depositPeriod:Timing :: Timing -> DepositPeriod
depositPeriod :: DepositPeriod
depositPeriod, DepositPeriod
$sel:depositActivation:Timing :: Timing -> DepositPeriod
depositActivation :: DepositPeriod
depositActivation} = Timing
timing

chainConfigFor' ::
  HasCallStack =>
  Actor ->
  FilePath ->
  ChainBackendOptions ->
  -- | Transaction ids at which Hydra scripts should have been published.
  [TxId] ->
  [Actor] ->
  ContestationPeriod ->
  DepositPeriod ->
  -- | Deposit activation, independent from the deposit period.
  DepositPeriod ->
  IO ChainConfig
chainConfigFor' :: HasCallStack =>
Actor
-> String
-> ChainBackendOptions
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> DepositPeriod
-> DepositPeriod
-> IO ChainConfig
chainConfigFor' Actor
me String
targetDir ChainBackendOptions
opts [TxId]
hydraScriptsTxId [Actor]
them ContestationPeriod
contestationPeriod DepositPeriod
depositPeriod DepositPeriod
depositActivation = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor
me Actor -> [Actor] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Actor]
them) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    String -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
      Actor -> String
forall b a. (Show a, IsString b) => a -> b
show Actor
me String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" must not be in " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Actor] -> String
forall b a. (Show a, IsString b) => a -> b
show [Actor]
them

  Actor -> String -> IO ()
copyFile Actor
me String
"vk"
  Actor -> String -> IO ()
copyFile Actor
me String
"sk"
  Actor -> String -> IO ()
copyFile (Actor -> Actor
fundsOf Actor
me) String
"vk"
  Actor -> String -> IO ()
copyFile (Actor -> Actor
fundsOf Actor
me) String
"sk"

  [Actor] -> (Actor -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Actor]
them ((Actor -> IO ()) -> IO ()) -> (Actor -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Actor
actor ->
    Actor -> String -> IO ()
copyFile Actor
actor String
"vk"
  ChainConfig -> IO ChainConfig
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChainConfig -> IO ChainConfig) -> ChainConfig -> IO ChainConfig
forall a b. (a -> b) -> a -> b
$
    ChainBackendOptions
-> [TxId]
-> String
-> [String]
-> ContestationPeriod
-> DepositPeriod
-> DepositPeriod
-> ChainConfig
cardanoChainConfig
      ChainBackendOptions
opts
      [TxId]
hydraScriptsTxId
      (Actor -> String -> String
actorFilePath Actor
me String
"sk")
      [Actor -> String -> String
actorFilePath Actor
himOrHer String
"vk" | Actor
himOrHer <- [Actor]
them]
      ContestationPeriod
contestationPeriod
      DepositPeriod
depositPeriod
      DepositPeriod
depositActivation
 where
  actorFilePath :: Actor -> String -> String
actorFilePath Actor
actor String
fileType = String
targetDir String -> String -> String
</> Actor -> String -> String
actorFileName Actor
actor String
fileType
  actorFileName :: Actor -> String -> String
actorFileName Actor
actor String
fileType = Actor -> String
actorName Actor
actor String -> String -> String
<.> String
fileType

  copyFile :: Actor -> String -> IO ()
copyFile Actor
actor String
fileType = do
    let fileName :: String
fileName = Actor -> String -> String
actorFileName Actor
actor String
fileType
        filePath :: String
filePath = Actor -> String -> String
actorFilePath Actor
actor String
fileType
    String -> IO ByteString
readConfigFile (String
"credentials" String -> String -> String
</> String
fileName) 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
>>= String -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => String -> ByteString -> m ()
writeFileBS String
filePath

-- | Chain config for a head run by a generated 'Participant', as the solo
-- scenarios that move real funds on public networks do.
--
-- Unlike 'chainConfigFor' this copies nothing out of @config/credentials@: the
-- node is pointed at the participant's own key, so no public fixture signing
-- key is written into the state directory at all.
chainConfigForParticipant ::
  Participant ->
  ChainBackendOptions ->
  -- | Transaction ids at which Hydra scripts should have been published.
  [TxId] ->
  Timing ->
  ChainConfig
chainConfigForParticipant :: Participant
-> ChainBackendOptions -> [TxId] -> Timing -> ChainConfig
chainConfigForParticipant Participant{String
keyDir :: Participant -> String
keyDir :: String
keyDir} ChainBackendOptions
opts [TxId]
hydraScriptsTxId Timing
timing =
  ChainBackendOptions
-> [TxId]
-> String
-> [String]
-> ContestationPeriod
-> DepositPeriod
-> DepositPeriod
-> ChainConfig
cardanoChainConfig
    ChainBackendOptions
opts
    [TxId]
hydraScriptsTxId
    (String -> String
participantCardanoKeyFile String
keyDir)
    []
    ContestationPeriod
contestationPeriod
    DepositPeriod
depositPeriod
    DepositPeriod
depositActivation
 where
  Timing{ContestationPeriod
$sel:contestationPeriod:Timing :: Timing -> ContestationPeriod
contestationPeriod :: ContestationPeriod
contestationPeriod, DepositPeriod
$sel:depositPeriod:Timing :: Timing -> DepositPeriod
depositPeriod :: DepositPeriod
depositPeriod, DepositPeriod
$sel:depositActivation:Timing :: Timing -> DepositPeriod
depositActivation :: DepositPeriod
depositActivation} = Timing
timing

-- | Assemble a chain config from key files that are already on disk.
cardanoChainConfig ::
  ChainBackendOptions ->
  -- | Transaction ids at which Hydra scripts should have been published.
  [TxId] ->
  -- | Path of the node's own Cardano signing key.
  FilePath ->
  -- | Paths of the other participants' Cardano verification keys.
  [FilePath] ->
  ContestationPeriod ->
  DepositPeriod ->
  -- | Deposit activation, independent from the deposit period.
  DepositPeriod ->
  ChainConfig
cardanoChainConfig :: ChainBackendOptions
-> [TxId]
-> String
-> [String]
-> ContestationPeriod
-> DepositPeriod
-> DepositPeriod
-> ChainConfig
cardanoChainConfig ChainBackendOptions
opts [TxId]
hydraScriptsTxId String
cardanoSigningKey [String]
cardanoVerificationKeys ContestationPeriod
contestationPeriod DepositPeriod
depositPeriod DepositPeriod
depositActivation =
  CardanoChainConfig -> ChainConfig
Cardano
    CardanoChainConfig
defaultCardanoChainConfig
      { hydraScriptsTxId
      , cardanoSigningKey
      , cardanoVerificationKeys
      , contestationPeriod
      , depositPeriod
      , depositActivation
      , unsyncedPeriod = defaultUnsyncedPeriodFor contestationPeriod
      , chainBackendOptions = opts
      }

modifyConfig :: (CardanoChainConfig -> CardanoChainConfig) -> ChainConfig -> ChainConfig
modifyConfig :: (CardanoChainConfig -> CardanoChainConfig)
-> ChainConfig -> ChainConfig
modifyConfig CardanoChainConfig -> CardanoChainConfig
fn = \case
  Cardano CardanoChainConfig
config -> CardanoChainConfig -> ChainConfig
Cardano (CardanoChainConfig -> ChainConfig)
-> CardanoChainConfig -> ChainConfig
forall a b. (a -> b) -> a -> b
$ CardanoChainConfig -> CardanoChainConfig
fn CardanoChainConfig
config
  ChainConfig
x -> ChainConfig
x

setNetworkId :: NetworkId -> ChainConfig -> ChainConfig
setNetworkId :: NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId = \case
  Cardano config :: CardanoChainConfig
config@CardanoChainConfig{ChainBackendOptions
$sel:chainBackendOptions:CardanoChainConfig :: CardanoChainConfig -> ChainBackendOptions
chainBackendOptions :: ChainBackendOptions
chainBackendOptions} ->
    case ChainBackendOptions
chainBackendOptions of
      Direct direct :: DirectOptions
direct@DirectOptions{} -> CardanoChainConfig -> ChainConfig
Cardano CardanoChainConfig
config{chainBackendOptions = Direct direct{networkId = networkId}}
      ChainBackendOptions
_ -> CardanoChainConfig -> ChainConfig
Cardano CardanoChainConfig
config
  ChainConfig
x -> ChainConfig
x