{-# LANGUAGE DuplicateRecordFields #-}
{-# OPTIONS_GHC -Wno-ambiguous-fields #-}
module Hydra.Cluster.Scenarios where
import Hydra.Prelude
import Test.Hydra.Prelude
import Cardano.Api.UTxO qualified as UTxO
import Cardano.Ledger.Alonzo.Tx (hashScriptIntegrity)
import Cardano.Ledger.Api (RewardAccount (..), Withdrawals (..), collateralInputsTxBodyL, hashScript, scriptTxWitsL, totalCollateralTxBodyL, withdrawalsTxBodyL)
import Cardano.Ledger.Api.PParams (AlonzoEraPParams, PParams, getLanguageView)
import Cardano.Ledger.Api.Tx (AsIx (..), EraTx, Redeemers (..), bodyTxL, datsTxWitsL, rdmrsTxWitsL, witsTxL)
import Cardano.Ledger.Api.Tx qualified as Ledger
import Cardano.Ledger.Api.Tx.Body (AlonzoEraTxBody, scriptIntegrityHashTxBodyL)
import Cardano.Ledger.Api.Tx.Wits (AlonzoEraTxWits, ConwayPlutusPurpose (ConwayRewarding))
import Cardano.Ledger.BaseTypes (Network (Testnet), StrictMaybe (..))
import Cardano.Ledger.Credential (Credential (ScriptHashObj))
import Cardano.Ledger.Plutus.Language (Language (PlutusV3))
import CardanoClient (
QueryPoint (QueryTip),
waitForUTxO,
)
import CardanoNode (NodeLog)
import Control.Concurrent.Async (mapConcurrently_)
import Control.Lens ((.~), (?~), (^.), (^..), (^?))
import Data.Aeson (Value, object, (.=))
import Data.Aeson qualified as Aeson
import Data.Aeson.Lens (atKey, key, values, _JSON, _String)
import Data.Aeson.Types (parseMaybe)
import Data.ByteString (isInfixOf)
import Data.ByteString qualified as B
import Data.ByteString.Char8 qualified as BSC
import Data.List qualified as List
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as T
import Hydra.API.HTTPServer (
DraftCommitTxResponse (..),
TransactionSubmitted (..),
)
import Hydra.API.ServerOutput (HeadStatus (Idle))
import Hydra.Cardano.Api (
Coin (..),
Era,
File (File),
Key (SigningKey),
KeyWitnessInCtx (..),
LedgerProtocolParameters (..),
PaymentKey,
Tx,
TxId (..),
UTxO,
addTxIns,
addTxInsCollateral,
addTxOuts,
createAndValidateTransactionBody,
defaultTxBodyContent,
fromLedgerTx,
getTxBody,
getTxId,
getVerificationKey,
lovelaceToValue,
makeSignedTransaction,
mkScriptAddress,
mkScriptDatum,
mkScriptWitness,
mkTxIn,
mkTxOutAutoBalance,
mkTxOutDatumHash,
mkVkAddress,
scriptWitnessInCtx,
selectLovelace,
setTxProtocolParams,
signTx,
toLedgerData,
toLedgerExUnits,
toLedgerScript,
toLedgerTx,
toLedgerTxIn,
toScriptData,
txOutValue,
txOuts',
utxoFromTx,
writeFileTextEnvelope,
pattern BuildTxWith,
pattern KeyWitness,
pattern PlutusScriptWitness,
pattern ReferenceScriptNone,
pattern ScriptWitness,
pattern TxOut,
pattern TxOutDatumNone,
)
import Hydra.Chain.Backend (ChainBackend, buildTransaction, buildTransactionWithPParams, buildTransactionWithPParams')
import Hydra.Chain.Backend qualified as Backend
import Hydra.Cluster.Faucet (FaucetLog, createOutputAtAddress, seedFromFaucet, seedFromFaucet_)
import Hydra.Cluster.Faucet qualified as Faucet
import Hydra.Cluster.Fixture (Actor (..), actorName, alice, aliceSk, aliceVk, bob, bobSk, bobVk, carol, carolSk, carolVk)
import Hydra.Cluster.Mithril (MithrilLog)
import Hydra.Cluster.Options (Options)
import Hydra.Cluster.Util (chainConfigFor, chainConfigFor', keysFor, modifyConfig, setNetworkId)
import Hydra.Contract.Dummy (dummyRewardingScript)
import Hydra.Ledger.Cardano (mkSimpleTx, mkTransferTx, unsafeBuildTransaction)
import Hydra.Ledger.Cardano.Evaluate (maxTxExecutionUnits)
import Hydra.Logging (Tracer, traceWith)
import Hydra.Node.DepositPeriod (DepositPeriod (..))
import Hydra.Options (CardanoChainConfig (..), ChainBackendOptions (..), DirectOptions (..), startChainFrom)
import Hydra.Tx (HeadId, IsTx (balance), Party, txId)
import Hydra.Tx.ContestationPeriod qualified as CP
import Hydra.Tx.Utils (dummyValidatorScript, verificationKeyToOnChainId)
import HydraNode (
HydraClient (..),
HydraNodeLog,
getProtocolParameters,
getSnapshotConfirmed,
getSnapshotLastSeen,
getSnapshotUTxO,
input,
output,
postDecommit,
prepareHydraNode,
requestCommitTx,
send,
waitFor,
waitForAllMatch,
waitForNodesConnected,
waitForNodesDisconnected,
waitMatch,
withHydraCluster,
withHydraNode,
withPreparedHydraNode,
)
import Network.HTTP.Conduit (parseUrlThrow)
import Network.HTTP.Conduit qualified as L
import Network.HTTP.Req (
HttpException (VanillaHttpException),
JsonResponse,
POST (POST),
ReqBodyJson (ReqBodyJson),
defaultHttpConfig,
http,
port,
req,
responseBody,
runReq,
(/:),
)
import Network.HTTP.Simple (getResponseBody, httpJSON, setRequestBodyJSON)
import Network.HTTP.Types (urlEncode)
import System.FilePath ((</>))
import System.Process (callProcess)
import Test.Hydra.Tx.Fixture (testNetworkId)
import Test.Hydra.Tx.Gen (genKeyPair)
import Test.QuickCheck (choose, elements, generate)
data EndToEndLog
= ClusterOptions {EndToEndLog -> Options
options :: Options}
| FromCardanoNode NodeLog
| FromFaucet FaucetLog
| FromHydraNode HydraNodeLog
| FromMithril MithrilLog
| StartingFunds {EndToEndLog -> String
actor :: String, EndToEndLog -> UTxO' (TxOut CtxUTxO Era)
utxo :: UTxO}
| RefueledFunds {actor :: String, EndToEndLog -> Coin
refuelingAmount :: Coin, utxo :: UTxO}
| RemainingFunds {actor :: String, utxo :: UTxO}
| PublishedHydraScriptsAt {EndToEndLog -> [TxId]
hydraScriptsTxId :: [TxId]}
| UsingHydraScriptsAt {hydraScriptsTxId :: [TxId]}
| CreatedKey {EndToEndLog -> String
keyPath :: FilePath}
deriving stock (EndToEndLog -> EndToEndLog -> Bool
(EndToEndLog -> EndToEndLog -> Bool)
-> (EndToEndLog -> EndToEndLog -> Bool) -> Eq EndToEndLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EndToEndLog -> EndToEndLog -> Bool
== :: EndToEndLog -> EndToEndLog -> Bool
$c/= :: EndToEndLog -> EndToEndLog -> Bool
/= :: EndToEndLog -> EndToEndLog -> Bool
Eq, Int -> EndToEndLog -> ShowS
[EndToEndLog] -> ShowS
EndToEndLog -> String
(Int -> EndToEndLog -> ShowS)
-> (EndToEndLog -> String)
-> ([EndToEndLog] -> ShowS)
-> Show EndToEndLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EndToEndLog -> ShowS
showsPrec :: Int -> EndToEndLog -> ShowS
$cshow :: EndToEndLog -> String
show :: EndToEndLog -> String
$cshowList :: [EndToEndLog] -> ShowS
showList :: [EndToEndLog] -> ShowS
Show, (forall x. EndToEndLog -> Rep EndToEndLog x)
-> (forall x. Rep EndToEndLog x -> EndToEndLog)
-> Generic EndToEndLog
forall x. Rep EndToEndLog x -> EndToEndLog
forall x. EndToEndLog -> Rep EndToEndLog x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EndToEndLog -> Rep EndToEndLog x
from :: forall x. EndToEndLog -> Rep EndToEndLog x
$cto :: forall x. Rep EndToEndLog x -> EndToEndLog
to :: forall x. Rep EndToEndLog x -> EndToEndLog
Generic)
deriving anyclass ([EndToEndLog] -> Value
[EndToEndLog] -> Encoding
EndToEndLog -> Bool
EndToEndLog -> Value
EndToEndLog -> Encoding
(EndToEndLog -> Value)
-> (EndToEndLog -> Encoding)
-> ([EndToEndLog] -> Value)
-> ([EndToEndLog] -> Encoding)
-> (EndToEndLog -> Bool)
-> ToJSON EndToEndLog
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: EndToEndLog -> Value
toJSON :: EndToEndLog -> Value
$ctoEncoding :: EndToEndLog -> Encoding
toEncoding :: EndToEndLog -> Encoding
$ctoJSONList :: [EndToEndLog] -> Value
toJSONList :: [EndToEndLog] -> Value
$ctoEncodingList :: [EndToEndLog] -> Encoding
toEncodingList :: [EndToEndLog] -> Encoding
$comitField :: EndToEndLog -> Bool
omitField :: EndToEndLog -> Bool
ToJSON)
oneOfThreeNodesStopsForAWhile :: ChainBackend backend => Tracer IO EndToEndLog -> FilePath -> backend -> [TxId] -> IO ()
oneOfThreeNodesStopsForAWhile :: forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> String -> backend -> [TxId] -> IO ()
oneOfThreeNodesStopsForAWhile Tracer IO EndToEndLog
tracer String
workDir backend
backend [TxId]
hydraScriptsTxId = do
let clients :: [Actor]
clients = [Actor
Alice, Actor
Bob, Actor
Carol]
[(VerificationKey PaymentKey
aliceCardanoVk, SigningKey PaymentKey
aliceCardanoSk), (VerificationKey PaymentKey
bobCardanoVk, SigningKey PaymentKey
_), (VerificationKey PaymentKey
carolCardanoVk, SigningKey PaymentKey
_)] <- [Actor]
-> (Actor
-> IO (VerificationKey PaymentKey, SigningKey PaymentKey))
-> IO [(VerificationKey PaymentKey, SigningKey PaymentKey)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Actor]
clients Actor -> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
keysFor
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
seedFromFaucet_ backend
backend VerificationKey PaymentKey
aliceCardanoVk Coin
100_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
seedFromFaucet_ backend
backend VerificationKey PaymentKey
bobCardanoVk Coin
100_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
seedFromFaucet_ backend
backend VerificationKey PaymentKey
carolCardanoVk Coin
100_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
NetworkId
networkId <- backend -> IO NetworkId
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> m NetworkId
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> m NetworkId
Backend.queryNetworkId backend
backend
let contestationPeriod :: ContestationPeriod
contestationPeriod = ContestationPeriod
1
ChainConfig
aliceChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Alice String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Bob, Actor
Carol] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId
ChainConfig
bobChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Bob String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Alice, Actor
Carol] ContestationPeriod
contestationPeriod IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId
ChainConfig
carolChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Carol String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Alice, Actor
Bob] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId
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 HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
1 SigningKey HydraKey
aliceSk [VerificationKey HydraKey
bobVk, VerificationKey HydraKey
carolVk] [Int
1, Int
2, Int
3] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
UTxO' (TxOut CtxUTxO Era)
aliceUTxO <- backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
seedFromFaucet backend
backend VerificationKey PaymentKey
aliceCardanoVk Coin
1_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
bobChainConfig String
workDir Int
2 SigningKey HydraKey
bobSk [VerificationKey HydraKey
aliceVk, VerificationKey HydraKey
carolVk] [Int
1, Int
2, Int
3] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n2 -> do
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
carolChainConfig String
workDir Int
3 SigningKey HydraKey
carolSk [VerificationKey HydraKey
aliceVk, VerificationKey HydraKey
bobVk] [Int
1, Int
2, Int
3] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n3 -> do
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Init" []
HeadId
headId <- NominalDiffTime
-> [HydraClient] -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1, HydraClient
n2, HydraClient
n3] ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice, Party
bob, Party
carol])
HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n1 UTxO' (TxOut CtxUTxO Era)
aliceUTxO IO (Tx Era) -> (Tx Era -> 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
>>= backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend
(HydraClient -> IO ()) -> [HydraClient] -> IO ()
forall (f :: * -> *) a b. Foldable f => (a -> IO b) -> f a -> IO ()
mapConcurrently_ (\HydraClient
n -> HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n UTxO' (TxOut CtxUTxO Era)
forall a. Monoid a => a
mempty IO (Tx Era) -> (Tx Era -> 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
>>= backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend) [HydraClient
n2, HydraClient
n3]
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
20 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1, HydraClient
n2, HydraClient
n3] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"HeadIsOpen" [Key
"utxo" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxO' (TxOut CtxUTxO Era) -> Value
forall a. ToJSON a => a -> Value
toJSON UTxO' (TxOut CtxUTxO Era)
aliceUTxO, Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId]
UTxO' (TxOut CtxUTxO Era)
utxo <- HydraClient -> IO (UTxO' (TxOut CtxUTxO Era))
getSnapshotUTxO HydraClient
n1
Tx Era
tx <- NetworkId
-> UTxO' (TxOut CtxUTxO Era)
-> SigningKey PaymentKey
-> VerificationKey PaymentKey
-> IO (Tx Era)
forall (m :: * -> *).
MonadFail m =>
NetworkId
-> UTxO' (TxOut CtxUTxO Era)
-> SigningKey PaymentKey
-> VerificationKey PaymentKey
-> m (Tx Era)
mkTransferTx NetworkId
networkId UTxO' (TxOut CtxUTxO Era)
utxo SigningKey PaymentKey
aliceCardanoSk VerificationKey PaymentKey
aliceCardanoVk
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"NewTx" [Key
"transaction" Key -> Tx Era -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tx Era
tx]
NominalDiffTime -> [HydraClient] -> (Value -> Maybe ()) -> IO ()
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch (NominalDiffTime
200 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1, HydraClient
n2, HydraClient
n3] ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"SnapshotConfirmed"
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"snapshot" Getting (First Value) Value Value
-> Getting (First Value) Value Value
-> Getting (First Value) Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"number" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer
1 :: Integer))
UTxO' (TxOut CtxUTxO Era)
utxo <- HydraClient -> IO (UTxO' (TxOut CtxUTxO Era))
getSnapshotUTxO HydraClient
n1
Tx Era
tx <- NetworkId
-> UTxO' (TxOut CtxUTxO Era)
-> SigningKey PaymentKey
-> VerificationKey PaymentKey
-> IO (Tx Era)
forall (m :: * -> *).
MonadFail m =>
NetworkId
-> UTxO' (TxOut CtxUTxO Era)
-> SigningKey PaymentKey
-> VerificationKey PaymentKey
-> m (Tx Era)
mkTransferTx NetworkId
networkId UTxO' (TxOut CtxUTxO Era)
utxo SigningKey PaymentKey
aliceCardanoSk VerificationKey PaymentKey
aliceCardanoVk
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"NewTx" [Key
"transaction" Key -> Tx Era -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tx Era
tx]
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
carolChainConfig String
workDir Int
3 SigningKey HydraKey
carolSk [VerificationKey HydraKey
aliceVk, VerificationKey HydraKey
bobVk] [Int
1, Int
2, Int
3] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n3 -> do
((HydraClient -> IO ()) -> [HydraClient] -> IO ())
-> [HydraClient] -> (HydraClient -> IO ()) -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (HydraClient -> IO ()) -> [HydraClient] -> IO ()
forall (f :: * -> *) a b. Foldable f => (a -> IO b) -> f a -> IO ()
mapConcurrently_ [HydraClient
n1, HydraClient
n2, HydraClient
n3] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n ->
NominalDiffTime -> HydraClient -> (Value -> Maybe ()) -> IO ()
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
200 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"SnapshotConfirmed"
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"snapshot" Getting (First Value) Value Value
-> Getting (First Value) Value Value
-> Getting (First Value) Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"number" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer
2 :: Integer))
let sigs :: [Value]
sigs = Value
v Value -> Getting (Endo [Value]) Value Value -> [Value]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"signatures" Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"multiSignature" Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Value]) Value Value
forall t. AsValue t => IndexedTraversal' Int t Value
IndexedTraversal' Int Value Value
values
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
sigs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3
where
hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
restartedNodeCanObserveCommitTx :: ChainBackend backend => Tracer IO EndToEndLog -> FilePath -> backend -> [TxId] -> IO ()
restartedNodeCanObserveCommitTx :: forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> String -> backend -> [TxId] -> IO ()
restartedNodeCanObserveCommitTx Tracer IO EndToEndLog
tracer String
workDir backend
backend [TxId]
hydraScriptsTxId = do
let clients :: [Actor]
clients = [Actor
Alice, Actor
Bob]
[(VerificationKey PaymentKey
aliceCardanoVk, SigningKey PaymentKey
_), (VerificationKey PaymentKey
bobCardanoVk, SigningKey PaymentKey
_)] <- [Actor]
-> (Actor
-> IO (VerificationKey PaymentKey, SigningKey PaymentKey))
-> IO [(VerificationKey PaymentKey, SigningKey PaymentKey)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Actor]
clients Actor -> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
keysFor
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
seedFromFaucet_ backend
backend VerificationKey PaymentKey
aliceCardanoVk Coin
100_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
seedFromFaucet_ backend
backend VerificationKey PaymentKey
bobCardanoVk Coin
100_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
let contestationPeriod :: ContestationPeriod
contestationPeriod = ContestationPeriod
1
NetworkId
networkId <- backend -> IO NetworkId
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> m NetworkId
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> m NetworkId
Backend.queryNetworkId backend
backend
ChainConfig
aliceChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Alice String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Bob] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId
ChainConfig
bobChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Bob String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Alice] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId
let hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
bobChainConfig String
workDir Int
1 SigningKey HydraKey
bobSk [VerificationKey HydraKey
aliceVk] [Int
1, Int
2] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
HeadId
headId <- Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO HeadId)
-> IO HeadId
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
2 SigningKey HydraKey
aliceSk [VerificationKey HydraKey
bobVk] [Int
1, Int
2] ((HydraClient -> IO HeadId) -> IO HeadId)
-> (HydraClient -> IO HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ \HydraClient
n2 -> do
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Init" []
NominalDiffTime
-> [HydraClient] -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch NominalDiffTime
10 [HydraClient
n1, HydraClient
n2] ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice, Party
bob])
HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n1 UTxO' (TxOut CtxUTxO Era)
forall a. Monoid a => a
mempty IO (Tx Era) -> (Tx Era -> 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
>>= backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer NominalDiffTime
10 [HydraClient
n1] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"Committed" [Key
"party" Key -> Party -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Party
bob, Key
"utxo" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Pair]
forall a. Monoid a => a
mempty, Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId]
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
2 SigningKey HydraKey
aliceSk [VerificationKey HydraKey
bobVk] [Int
1, Int
2] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n2 -> do
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer NominalDiffTime
10 [HydraClient
n2] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"Committed" [Key
"party" Key -> Party -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Party
bob, Key
"utxo" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Pair]
forall a. Monoid a => a
mempty, Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId]
restartedNodeCanAbort :: ChainBackend backend => Tracer IO EndToEndLog -> FilePath -> backend -> [TxId] -> IO ()
restartedNodeCanAbort :: forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> String -> backend -> [TxId] -> IO ()
restartedNodeCanAbort Tracer IO EndToEndLog
tracer String
workDir backend
backend [TxId]
hydraScriptsTxId = do
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
refuelIfNeeded Tracer IO EndToEndLog
tracer backend
backend Actor
Alice Coin
100_000_000
ChainConfig
aliceChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Alice String
workDir backend
backend [TxId]
hydraScriptsTxId [] ContestationPeriod
2
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (CardanoChainConfig -> CardanoChainConfig)
-> ChainConfig -> ChainConfig
modifyConfig (\CardanoChainConfig
config -> CardanoChainConfig
config{startChainFrom = Nothing})
let hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
HeadId
headId1 <- Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO HeadId)
-> IO HeadId
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
1 SigningKey HydraKey
aliceSk [] [Int
1] ((HydraClient -> IO HeadId) -> IO HeadId)
-> (HydraClient -> IO HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Init" []
NominalDiffTime
-> HydraClient -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch NominalDiffTime
10 HydraClient
n1 ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice])
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
1 SigningKey HydraKey
aliceSk [] [Int
1] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
HeadId
headId2 <- NominalDiffTime
-> HydraClient -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch NominalDiffTime
20 HydraClient
n1 ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice])
HeadId
headId1 HeadId -> HeadId -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` HeadId
headId2
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Abort" []
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer NominalDiffTime
20 [HydraClient
n1] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"HeadIsAborted" [Key
"utxo" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Pair]
forall a. Monoid a => a
mempty, Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId2]
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
1 SigningKey HydraKey
aliceSk [] [Int
1] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
NominalDiffTime -> HydraClient -> (Value -> Maybe ()) -> IO ()
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch NominalDiffTime
20 HydraClient
n1 ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"Greetings"
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"headStatus" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (HeadStatus -> Value
forall a. ToJSON a => a -> Value
toJSON HeadStatus
Idle)
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"me" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (Party -> Value
forall a. ToJSON a => a -> Value
toJSON Party
alice)
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"hydraNodeVersion")
nodeReObservesOnChainTxs :: ChainBackend backend => Tracer IO EndToEndLog -> FilePath -> backend -> [TxId] -> IO ()
nodeReObservesOnChainTxs :: forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> String -> backend -> [TxId] -> IO ()
nodeReObservesOnChainTxs Tracer IO EndToEndLog
tracer String
workDir backend
backend [TxId]
hydraScriptsTxId = do
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
refuelIfNeeded Tracer IO EndToEndLog
tracer backend
backend Actor
Alice Coin
100_000_000
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
refuelIfNeeded Tracer IO EndToEndLog
tracer backend
backend Actor
Bob Coin
100_000_000
NetworkId
networkId <- backend -> IO NetworkId
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> m NetworkId
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> m NetworkId
Backend.queryNetworkId backend
backend
ChainPoint
tip <- 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
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
let contestationPeriod :: 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
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime
depositPeriod :: DepositPeriod
depositPeriod = NominalDiffTime -> DepositPeriod
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (NominalDiffTime -> DepositPeriod)
-> NominalDiffTime -> DepositPeriod
forall a b. (a -> b) -> a -> b
$ NominalDiffTime
50 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime
ChainConfig
aliceChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Alice String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Bob] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (CardanoChainConfig -> CardanoChainConfig)
-> ChainConfig -> ChainConfig
modifyConfig (\CardanoChainConfig
config -> CardanoChainConfig
config{startChainFrom = Nothing, depositPeriod})
ChainConfig
bobChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Bob String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Alice] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (CardanoChainConfig -> CardanoChainConfig)
-> ChainConfig -> ChainConfig
modifyConfig (\CardanoChainConfig
config -> CardanoChainConfig
config{startChainFrom = Nothing, depositPeriod})
(VerificationKey PaymentKey
aliceCardanoVk, SigningKey PaymentKey
aliceCardanoSk) <- Actor -> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
keysFor Actor
Alice
UTxO' (TxOut CtxUTxO Era)
commitUTxO <- backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
seedFromFaucet backend
backend VerificationKey PaymentKey
aliceCardanoVk Coin
5_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
let hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
1 SigningKey HydraKey
aliceSk [VerificationKey HydraKey
bobVk] [Int
2] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
(HeadId
headId', UTxO' (TxOut CtxUTxO Era)
decrementOuts) <- Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO (HeadId, UTxO' (TxOut CtxUTxO Era)))
-> IO (HeadId, UTxO' (TxOut CtxUTxO Era))
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
bobChainConfig String
workDir Int
2 SigningKey HydraKey
bobSk [VerificationKey HydraKey
aliceVk] [Int
1] ((HydraClient -> IO (HeadId, UTxO' (TxOut CtxUTxO Era)))
-> IO (HeadId, UTxO' (TxOut CtxUTxO Era)))
-> (HydraClient -> IO (HeadId, UTxO' (TxOut CtxUTxO Era)))
-> IO (HeadId, UTxO' (TxOut CtxUTxO Era))
forall a b. (a -> b) -> a -> b
$ \HydraClient
n2 -> do
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Init" []
HeadId
headId <- NominalDiffTime
-> HydraClient -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
20 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n1 ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice, Party
bob])
HeadId
_ <- NominalDiffTime
-> HydraClient -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
20 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n2 ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice, Party
bob])
HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n1 UTxO' (TxOut CtxUTxO Era)
forall a. Monoid a => a
mempty IO (Tx Era) -> (Tx Era -> 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
>>= backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend
HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n2 UTxO' (TxOut CtxUTxO Era)
forall a. Monoid a => a
mempty IO (Tx Era) -> (Tx Era -> 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
>>= backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
20 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1, HydraClient
n2] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"HeadIsOpen" [Key
"utxo" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Pair]
forall a. Monoid a => a
mempty, Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId]
Response (Tx Era)
resp <-
String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow (String
"POST " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> HydraClient -> String
forall {a}. (Semigroup a, IsString a) => HydraClient -> a
hydraNodeBaseUrl HydraClient
n1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/commit")
IO Request -> (Request -> Request) -> IO Request
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> UTxO' (TxOut CtxUTxO Era) -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
setRequestBodyJSON UTxO' (TxOut CtxUTxO Era)
commitUTxO
IO Request
-> (Request -> IO (Response (Tx Era))) -> IO (Response (Tx Era))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Request -> IO (Response (Tx Era))
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response a)
httpJSON
let depositTransaction :: Tx Era
depositTransaction = Response (Tx Era) -> Tx Era
forall a. Response a -> a
getResponseBody Response (Tx Era)
resp :: Tx
let tx :: Tx Era
tx = SigningKey PaymentKey -> Tx Era -> Tx Era
forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
signTx SigningKey PaymentKey
aliceCardanoSk Tx Era
depositTransaction
backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend Tx Era
tx
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
2 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* DepositPeriod -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac DepositPeriod
depositPeriod) [HydraClient
n1, HydraClient
n2] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"CommitApproved" [Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId, Key
"utxoToCommit" Key -> UTxO' (TxOut CtxUTxO Era) -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxO' (TxOut CtxUTxO Era)
commitUTxO]
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
20 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1, HydraClient
n2] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"CommitFinalized" [Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId, Key
"depositTxId" Key -> TxId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TxBody Era -> TxId
forall era. TxBody era -> TxId
getTxId (Tx Era -> TxBody Era
forall era. Tx era -> TxBody era
getTxBody Tx Era
tx)]
HydraClient -> IO (UTxO' (TxOut CtxUTxO Era))
getSnapshotUTxO HydraClient
n1 IO (UTxO' (TxOut CtxUTxO Era))
-> UTxO' (TxOut CtxUTxO Era) -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` UTxO' (TxOut CtxUTxO Era)
commitUTxO
let aliceAddress :: AddressInEra Era
aliceAddress = NetworkId -> VerificationKey PaymentKey -> AddressInEra Era
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
aliceCardanoVk
Tx Era
decommitTx <- do
let (TxIn
i, TxOut CtxUTxO Era
o) = [(TxIn, TxOut CtxUTxO Era)] -> (TxIn, TxOut CtxUTxO Era)
forall a. HasCallStack => [a] -> a
List.head ([(TxIn, TxOut CtxUTxO Era)] -> (TxIn, TxOut CtxUTxO Era))
-> [(TxIn, TxOut CtxUTxO Era)] -> (TxIn, TxOut CtxUTxO Era)
forall a b. (a -> b) -> a -> b
$ UTxO' (TxOut CtxUTxO Era) -> [(TxIn, TxOut CtxUTxO Era)]
forall out. UTxO' out -> [(TxIn, out)]
UTxO.toList UTxO' (TxOut CtxUTxO Era)
commitUTxO
(TxBodyError -> IO (Tx Era))
-> (Tx Era -> IO (Tx Era))
-> Either TxBodyError (Tx Era)
-> IO (Tx Era)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> IO (Tx Era)
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure (String -> IO (Tx Era))
-> (TxBodyError -> String) -> TxBodyError -> IO (Tx Era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBodyError -> String
forall b a. (Show a, IsString b) => a -> b
show) Tx Era -> IO (Tx Era)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TxBodyError (Tx Era) -> IO (Tx Era))
-> Either TxBodyError (Tx Era) -> IO (Tx Era)
forall a b. (a -> b) -> a -> b
$
(TxIn, TxOut CtxUTxO Era)
-> (AddressInEra Era, Value)
-> SigningKey PaymentKey
-> Either TxBodyError (Tx Era)
mkSimpleTx (TxIn
i, TxOut CtxUTxO Era
o) (AddressInEra Era
aliceAddress, TxOut CtxUTxO Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue TxOut CtxUTxO Era
o) SigningKey PaymentKey
aliceCardanoSk
let decommitUTxO :: UTxO' (TxOut CtxUTxO Era)
decommitUTxO = Tx Era -> UTxO' (TxOut CtxUTxO Era)
utxoFromTx Tx Era
decommitTx
decommitTxId :: TxIdType (Tx Era)
decommitTxId = Tx Era -> TxIdType (Tx Era)
forall tx. IsTx tx => tx -> TxIdType tx
txId Tx Era
decommitTx
IO (IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO ()) -> IO ())
-> (Gen (IO ()) -> IO (IO ())) -> Gen (IO ()) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen (IO ()) -> IO (IO ())
forall a. Gen a -> IO a
generate (Gen (IO ()) -> IO ()) -> Gen (IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
[IO ()] -> Gen (IO ())
forall a. HasCallStack => [a] -> Gen a
elements
[ HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Decommit" [Key
"decommitTx" Key -> Tx Era -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tx Era
decommitTx]
, HydraClient -> Tx Era -> IO ()
postDecommit HydraClient
n1 Tx Era
decommitTx
]
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer NominalDiffTime
10 [HydraClient
n1, HydraClient
n2] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"DecommitRequested" [Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId, Key
"decommitTx" Key -> Tx Era -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tx Era
decommitTx, Key
"utxoToDecommit" Key -> UTxO' (TxOut CtxUTxO Era) -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxO' (TxOut CtxUTxO Era)
decommitUTxO]
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer NominalDiffTime
10 [HydraClient
n1, HydraClient
n2] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"DecommitApproved" [Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId, Key
"decommitTxId" Key -> TxId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TxId
TxIdType (Tx Era)
decommitTxId, Key
"utxoToDecommit" Key -> UTxO' (TxOut CtxUTxO Era) -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxO' (TxOut CtxUTxO Era)
decommitUTxO]
NominalDiffTime -> IO () -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTimer m, MonadThrow m) =>
NominalDiffTime -> m a -> m a
failAfter NominalDiffTime
10 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ backend -> UTxO' (TxOut CtxUTxO Era) -> IO ()
forall backend.
ChainBackend backend =>
backend -> UTxO' (TxOut CtxUTxO Era) -> IO ()
waitForUTxO backend
backend UTxO' (TxOut CtxUTxO Era)
decommitUTxO
UTxO' (TxOut CtxUTxO Era)
distributedUTxO <- NominalDiffTime
-> [HydraClient]
-> (Value -> Maybe (UTxO' (TxOut CtxUTxO Era)))
-> IO (UTxO' (TxOut CtxUTxO Era))
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch NominalDiffTime
10 [HydraClient
n1, HydraClient
n2] ((Value -> Maybe (UTxO' (TxOut CtxUTxO Era)))
-> IO (UTxO' (TxOut CtxUTxO Era)))
-> (Value -> Maybe (UTxO' (TxOut CtxUTxO Era)))
-> IO (UTxO' (TxOut CtxUTxO Era))
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"DecommitFinalized"
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"headId" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (HeadId -> Value
forall a. ToJSON a => a -> Value
toJSON HeadId
headId)
Value
v Value
-> Getting
(First (UTxO' (TxOut CtxUTxO Era)))
Value
(UTxO' (TxOut CtxUTxO Era))
-> Maybe (UTxO' (TxOut CtxUTxO Era))
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"distributedUTxO" ((Value -> Const (First (UTxO' (TxOut CtxUTxO Era))) Value)
-> Value -> Const (First (UTxO' (TxOut CtxUTxO Era))) Value)
-> Getting
(First (UTxO' (TxOut CtxUTxO Era)))
Value
(UTxO' (TxOut CtxUTxO Era))
-> Getting
(First (UTxO' (TxOut CtxUTxO Era)))
Value
(UTxO' (TxOut CtxUTxO Era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
(First (UTxO' (TxOut CtxUTxO Era)))
Value
(UTxO' (TxOut CtxUTxO Era))
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
forall a b. (FromJSON a, ToJSON b) => Prism Value Value a b
Prism
Value Value (UTxO' (TxOut CtxUTxO Era)) (UTxO' (TxOut CtxUTxO Era))
_JSON
Bool -> IO ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ UTxO' (TxOut CtxUTxO Era)
distributedUTxO UTxO' (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era) -> Bool
forall out. Eq out => UTxO' out -> UTxO' out -> Bool
`UTxO.containsOutputs` Tx Era -> UTxO' (TxOut CtxUTxO Era)
utxoFromTx Tx Era
decommitTx
(HeadId, UTxO' (TxOut CtxUTxO Era))
-> IO (HeadId, UTxO' (TxOut CtxUTxO Era))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HeadId
headId, UTxO' (TxOut CtxUTxO Era)
decommitUTxO)
ChainConfig
bobChainConfigFromTip <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Bob String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Alice] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (CardanoChainConfig -> CardanoChainConfig)
-> ChainConfig -> ChainConfig
modifyConfig (\CardanoChainConfig
config -> CardanoChainConfig
config{startChainFrom = Just tip})
String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) r.
MonadIO m =>
String -> (String -> m r) -> m r
withTempDir String
"blank-state" ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
tmpDir -> do
String -> [String] -> IO ()
callProcess String
"cp" [String
"-r", String
workDir String -> ShowS
</> String
"state-2", String
tmpDir]
String -> [String] -> IO ()
callProcess String
"rm" [String
"-rf", String
tmpDir String -> ShowS
</> String
"state-2" String -> ShowS
</> String
"state*"]
String -> [String] -> IO ()
callProcess String
"rm" [String
"-rf", String
tmpDir String -> ShowS
</> String
"state-2" String -> ShowS
</> String
"last-known-revision"]
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
bobChainConfigFromTip String
tmpDir Int
2 SigningKey HydraKey
bobSk [VerificationKey HydraKey
aliceVk] [Int
1] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n2 -> do
HeadId
headId2 <- NominalDiffTime
-> HydraClient -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch NominalDiffTime
5 HydraClient
n2 ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice, Party
bob])
HeadId
headId2 HeadId -> HeadId -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` HeadId
headId'
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer NominalDiffTime
5 [HydraClient
n2] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"HeadIsOpen" [Key
"utxo" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Pair]
forall a. Monoid a => a
mempty, Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId2]
UTxO' (TxOut CtxUTxO Era)
distributedUTxO <- NominalDiffTime
-> [HydraClient]
-> (Value -> Maybe (UTxO' (TxOut CtxUTxO Era)))
-> IO (UTxO' (TxOut CtxUTxO Era))
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch NominalDiffTime
5 [HydraClient
n2] ((Value -> Maybe (UTxO' (TxOut CtxUTxO Era)))
-> IO (UTxO' (TxOut CtxUTxO Era)))
-> (Value -> Maybe (UTxO' (TxOut CtxUTxO Era)))
-> IO (UTxO' (TxOut CtxUTxO Era))
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"DecommitFinalized"
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"headId" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (HeadId -> Value
forall a. ToJSON a => a -> Value
toJSON HeadId
headId2)
Value
v Value
-> Getting
(First (UTxO' (TxOut CtxUTxO Era)))
Value
(UTxO' (TxOut CtxUTxO Era))
-> Maybe (UTxO' (TxOut CtxUTxO Era))
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"distributedUTxO" ((Value -> Const (First (UTxO' (TxOut CtxUTxO Era))) Value)
-> Value -> Const (First (UTxO' (TxOut CtxUTxO Era))) Value)
-> Getting
(First (UTxO' (TxOut CtxUTxO Era)))
Value
(UTxO' (TxOut CtxUTxO Era))
-> Getting
(First (UTxO' (TxOut CtxUTxO Era)))
Value
(UTxO' (TxOut CtxUTxO Era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
(First (UTxO' (TxOut CtxUTxO Era)))
Value
(UTxO' (TxOut CtxUTxO Era))
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
forall a b. (FromJSON a, ToJSON b) => Prism Value Value a b
Prism
Value Value (UTxO' (TxOut CtxUTxO Era)) (UTxO' (TxOut CtxUTxO Era))
_JSON
Bool -> IO ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ UTxO' (TxOut CtxUTxO Era)
distributedUTxO UTxO' (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era) -> Bool
forall out. Eq out => UTxO' out -> UTxO' out -> Bool
`UTxO.containsOutputs` UTxO' (TxOut CtxUTxO Era)
decrementOuts
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Close" []
UTCTime
deadline' <- NominalDiffTime
-> HydraClient -> (Value -> Maybe UTCTime) -> IO UTCTime
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
20 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n2 ((Value -> Maybe UTCTime) -> IO UTCTime)
-> (Value -> Maybe UTCTime) -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"HeadIsClosed"
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"headId" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (HeadId -> Value
forall a. ToJSON a => a -> Value
toJSON HeadId
headId')
Value
v Value -> Getting (First UTCTime) Value UTCTime -> Maybe UTCTime
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"contestationDeadline" ((Value -> Const (First UTCTime) Value)
-> Value -> Const (First UTCTime) Value)
-> Getting (First UTCTime) Value UTCTime
-> Getting (First UTCTime) Value UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First UTCTime) Value UTCTime
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
forall a b. (FromJSON a, ToJSON b) => Prism Value Value a b
Prism Value Value UTCTime UTCTime
_JSON
NominalDiffTime
remainingTime <- UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
deadline' (UTCTime -> NominalDiffTime) -> IO UTCTime -> IO NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
remainingTime NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime
3 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1, HydraClient
n2] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"ReadyToFanout" [Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId']
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Fanout" []
NominalDiffTime -> [HydraClient] -> (Value -> Maybe ()) -> IO ()
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1, HydraClient
n2] ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ HeadId -> UTxO' (TxOut CtxUTxO Era) -> Value -> Maybe ()
checkFanout HeadId
headId' UTxO' (TxOut CtxUTxO Era)
forall a. Monoid a => a
mempty
where
hydraNodeBaseUrl :: HydraClient -> a
hydraNodeBaseUrl HydraClient{Int
hydraNodeId :: Int
$sel:hydraNodeId:HydraClient :: HydraClient -> Int
hydraNodeId} = a
"http://127.0.0.1:" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Int -> a
forall b a. (Show a, IsString b) => a -> b
show (Int
4000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hydraNodeId)
singlePartyHeadFullLifeCycle ::
ChainBackend backend =>
Tracer IO EndToEndLog ->
FilePath ->
backend ->
[TxId] ->
IO ()
singlePartyHeadFullLifeCycle :: forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> String -> backend -> [TxId] -> IO ()
singlePartyHeadFullLifeCycle Tracer IO EndToEndLog
tracer String
workDir backend
backend [TxId]
hydraScriptsTxId =
( IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally`
do
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
returnFundsToFaucet Tracer IO EndToEndLog
tracer backend
backend Actor
Alice
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
returnFundsToFaucet Tracer IO EndToEndLog
tracer backend
backend Actor
AliceFunds
)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
refuelIfNeeded Tracer IO EndToEndLog
tracer backend
backend Actor
Alice Coin
55_000_000
ChainPoint
tip <- 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
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
NetworkId
networkId <- backend -> IO NetworkId
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> m NetworkId
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> m NetworkId
Backend.queryNetworkId backend
backend
ContestationPeriod
contestationPeriod <- NominalDiffTime -> IO ContestationPeriod
forall (m :: * -> *).
MonadFail m =>
NominalDiffTime -> m ContestationPeriod
CP.fromNominalDiffTime (NominalDiffTime -> IO ContestationPeriod)
-> NominalDiffTime -> IO ContestationPeriod
forall a b. (a -> b) -> a -> b
$ NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime
ChainConfig
aliceChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> DepositPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> DepositPeriod
-> IO ChainConfig
chainConfigFor' Actor
Alice String
workDir backend
backend [TxId]
hydraScriptsTxId [] ContestationPeriod
contestationPeriod (NominalDiffTime -> DepositPeriod
DepositPeriod NominalDiffTime
100)
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (CardanoChainConfig -> CardanoChainConfig)
-> ChainConfig -> ChainConfig
modifyConfig (\CardanoChainConfig
config -> CardanoChainConfig
config{startChainFrom = Just tip})
(ChainConfig -> ChainConfig)
-> (ChainConfig -> ChainConfig) -> ChainConfig -> ChainConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
1 SigningKey HydraKey
aliceSk [] [Int
1] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Init" []
HeadId
headId <- NominalDiffTime
-> HydraClient -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n1 ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice])
(VerificationKey PaymentKey
walletVk, SigningKey PaymentKey
walletSk) <- Actor -> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
keysFor Actor
AliceFunds
Coin
amount <- Integer -> Coin
Coin (Integer -> Coin) -> IO Integer -> IO Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer -> IO Integer
forall a. Gen a -> IO a
generate ((Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
10_000_000, Integer
50_000_000))
UTxO' (TxOut CtxUTxO Era)
utxoToCommit <- backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
seedFromFaucet backend
backend VerificationKey PaymentKey
walletVk Coin
amount ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n1 UTxO' (TxOut CtxUTxO Era)
utxoToCommit IO (Tx Era) -> (Tx Era -> Tx Era) -> IO (Tx Era)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> SigningKey PaymentKey -> Tx Era -> Tx Era
forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
signTx SigningKey PaymentKey
walletSk IO (Tx Era) -> (Tx Era -> 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
>>= backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"HeadIsOpen" [Key
"utxo" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxO' (TxOut CtxUTxO Era) -> Value
forall a. ToJSON a => a -> Value
toJSON UTxO' (TxOut CtxUTxO Era)
utxoToCommit, Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId]
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Close" []
UTCTime
deadline <- NominalDiffTime
-> HydraClient -> (Value -> Maybe UTCTime) -> IO UTCTime
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n1 ((Value -> Maybe UTCTime) -> IO UTCTime)
-> (Value -> Maybe UTCTime) -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"HeadIsClosed"
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"headId" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (HeadId -> Value
forall a. ToJSON a => a -> Value
toJSON HeadId
headId)
Value
v Value -> Getting (First UTCTime) Value UTCTime -> Maybe UTCTime
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"contestationDeadline" ((Value -> Const (First UTCTime) Value)
-> Value -> Const (First UTCTime) Value)
-> Getting (First UTCTime) Value UTCTime
-> Getting (First UTCTime) Value UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First UTCTime) Value UTCTime
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
forall a b. (FromJSON a, ToJSON b) => Prism Value Value a b
Prism Value Value UTCTime UTCTime
_JSON
NominalDiffTime
remainingTime <- UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
deadline (UTCTime -> NominalDiffTime) -> IO UTCTime -> IO NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
remainingTime NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime
3 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"ReadyToFanout" [Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId]
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Fanout" []
NominalDiffTime -> [HydraClient] -> (Value -> Maybe ()) -> IO ()
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1] ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ HeadId -> UTxO' (TxOut CtxUTxO Era) -> Value -> Maybe ()
checkFanout HeadId
headId UTxO' (TxOut CtxUTxO Era)
utxoToCommit
Actor -> IO ()
traceRemainingFunds Actor
Alice
Actor -> IO ()
traceRemainingFunds Actor
AliceFunds
where
hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
traceRemainingFunds :: Actor -> IO ()
traceRemainingFunds Actor
actor = do
(VerificationKey PaymentKey
actorVk, SigningKey PaymentKey
_) <- Actor -> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
keysFor Actor
actor
UTxO' (TxOut CtxUTxO Era)
utxo <- backend
-> QueryPoint
-> VerificationKey PaymentKey
-> IO (UTxO' (TxOut CtxUTxO Era))
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a
-> QueryPoint
-> VerificationKey PaymentKey
-> m (UTxO' (TxOut CtxUTxO Era))
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend
-> QueryPoint
-> VerificationKey PaymentKey
-> m (UTxO' (TxOut CtxUTxO Era))
Backend.queryUTxOFor backend
backend QueryPoint
QueryTip VerificationKey PaymentKey
actorVk
Tracer IO EndToEndLog -> EndToEndLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO EndToEndLog
tracer RemainingFunds{$sel:actor:ClusterOptions :: String
actor = Actor -> String
actorName Actor
actor, UTxO' (TxOut CtxUTxO Era)
$sel:utxo:ClusterOptions :: UTxO' (TxOut CtxUTxO Era)
utxo :: UTxO' (TxOut CtxUTxO Era)
utxo}
singlePartyOpenAHead ::
ChainBackend backend =>
Tracer IO EndToEndLog ->
FilePath ->
backend ->
[TxId] ->
(HydraClient -> SigningKey PaymentKey -> HeadId -> IO a) ->
IO a
singlePartyOpenAHead :: forall backend a.
ChainBackend backend =>
Tracer IO EndToEndLog
-> String
-> backend
-> [TxId]
-> (HydraClient -> SigningKey PaymentKey -> HeadId -> IO a)
-> IO a
singlePartyOpenAHead Tracer IO EndToEndLog
tracer String
workDir backend
backend [TxId]
hydraScriptsTxId HydraClient -> SigningKey PaymentKey -> HeadId -> IO a
callback =
(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` Tracer IO EndToEndLog -> backend -> Actor -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
returnFundsToFaucet Tracer IO EndToEndLog
tracer backend
backend Actor
Alice) (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
refuelIfNeeded Tracer IO EndToEndLog
tracer backend
backend Actor
Alice Coin
25_000_000
ChainPoint
tip <- 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
let contestationPeriod :: ContestationPeriod
contestationPeriod = ContestationPeriod
100
ChainConfig
aliceChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Alice String
workDir backend
backend [TxId]
hydraScriptsTxId [] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (CardanoChainConfig -> CardanoChainConfig)
-> ChainConfig -> ChainConfig
modifyConfig (\CardanoChainConfig
config -> CardanoChainConfig
config{startChainFrom = Just tip})
(VerificationKey PaymentKey
walletVk, SigningKey PaymentKey
walletSk) <- Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
-> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
forall a. Gen a -> IO a
generate Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
genKeyPair
let keyPath :: String
keyPath = String
workDir String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/wallet.sk"
Either (FileError ()) ()
_ <- File Any 'Out
-> Maybe TextEnvelopeDescr
-> SigningKey PaymentKey
-> IO (Either (FileError ()) ())
forall a content.
HasTextEnvelope a =>
File content 'Out
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope (String -> File Any 'Out
forall content (direction :: FileDirection).
String -> File content direction
File String
keyPath) Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing SigningKey PaymentKey
walletSk
Tracer IO EndToEndLog -> EndToEndLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO EndToEndLog
tracer CreatedKey{String
$sel:keyPath:ClusterOptions :: String
keyPath :: String
keyPath}
UTxO' (TxOut CtxUTxO Era)
utxoToCommit <- backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
seedFromFaucet backend
backend VerificationKey PaymentKey
walletVk Coin
100_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
let hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
1 SigningKey HydraKey
aliceSk [] [Int
1] ((HydraClient -> IO a) -> IO a) -> (HydraClient -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Init" []
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
HeadId
headId <- NominalDiffTime
-> HydraClient -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n1 ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice])
HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n1 UTxO' (TxOut CtxUTxO Era)
utxoToCommit IO (Tx Era) -> (Tx Era -> Tx Era) -> IO (Tx Era)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> SigningKey PaymentKey -> Tx Era -> Tx Era
forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
signTx SigningKey PaymentKey
walletSk IO (Tx Era) -> (Tx Era -> 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
>>= backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"HeadIsOpen" [Key
"utxo" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxO' (TxOut CtxUTxO Era) -> Value
forall a. ToJSON a => a -> Value
toJSON UTxO' (TxOut CtxUTxO Era)
utxoToCommit, Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId]
HydraClient -> SigningKey PaymentKey -> HeadId -> IO a
callback HydraClient
n1 SigningKey PaymentKey
walletSk HeadId
headId
singlePartyCommitsFromExternal ::
ChainBackend backend =>
Tracer IO EndToEndLog ->
FilePath ->
backend ->
[TxId] ->
IO ()
singlePartyCommitsFromExternal :: forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> String -> backend -> [TxId] -> IO ()
singlePartyCommitsFromExternal Tracer IO EndToEndLog
tracer String
workDir backend
backend [TxId]
hydraScriptsTxId =
( IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally`
do
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
returnFundsToFaucet Tracer IO EndToEndLog
tracer backend
backend Actor
Alice
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
returnFundsToFaucet Tracer IO EndToEndLog
tracer backend
backend Actor
AliceFunds
)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
refuelIfNeeded Tracer IO EndToEndLog
tracer backend
backend Actor
Alice Coin
25_000_000
let contestationPeriod :: ContestationPeriod
contestationPeriod = ContestationPeriod
100
ChainConfig
aliceChainConfig <- Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Alice String
workDir backend
backend [TxId]
hydraScriptsTxId [] ContestationPeriod
contestationPeriod
let hydraNodeId :: Int
hydraNodeId = Int
1
let hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
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 HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
hydraNodeId SigningKey HydraKey
aliceSk [] [Int
1] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Init" []
HeadId
headId <- NominalDiffTime
-> HydraClient -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n1 ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice])
(VerificationKey PaymentKey
walletVk, SigningKey PaymentKey
walletSk) <- Actor -> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
keysFor Actor
AliceFunds
UTxO' (TxOut CtxUTxO Era)
utxoToCommit <- backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
seedFromFaucet backend
backend VerificationKey PaymentKey
walletVk Coin
5_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
JsonResponse (DraftCommitTxResponse (Tx Era))
res <-
HttpConfig
-> Req (JsonResponse (DraftCommitTxResponse (Tx Era)))
-> IO (JsonResponse (DraftCommitTxResponse (Tx Era)))
forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
runReq HttpConfig
defaultHttpConfig (Req (JsonResponse (DraftCommitTxResponse (Tx Era)))
-> IO (JsonResponse (DraftCommitTxResponse (Tx Era))))
-> Req (JsonResponse (DraftCommitTxResponse (Tx Era)))
-> IO (JsonResponse (DraftCommitTxResponse (Tx Era)))
forall a b. (a -> b) -> a -> b
$
POST
-> Url 'Http
-> ReqBodyJson (UTxO' (TxOut CtxUTxO Era))
-> Proxy (JsonResponse (DraftCommitTxResponse (Tx Era)))
-> Option 'Http
-> Req (JsonResponse (DraftCommitTxResponse (Tx Era)))
forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
HttpResponse response,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req
POST
POST
(Text -> Url 'Http
http Text
"127.0.0.1" Url 'Http -> Text -> Url 'Http
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"commit")
(UTxO' (TxOut CtxUTxO Era)
-> ReqBodyJson (UTxO' (TxOut CtxUTxO Era))
forall a. a -> ReqBodyJson a
ReqBodyJson UTxO' (TxOut CtxUTxO Era)
utxoToCommit)
(Proxy (JsonResponse (DraftCommitTxResponse (Tx Era)))
forall {k} (t :: k). Proxy t
Proxy :: Proxy (JsonResponse (DraftCommitTxResponse Tx)))
(Int -> Option 'Http
forall (scheme :: Scheme). Int -> Option scheme
port (Int -> Option 'Http) -> Int -> Option 'Http
forall a b. (a -> b) -> a -> b
$ Int
4000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hydraNodeId)
let DraftCommitTxResponse{Tx Era
commitTx :: Tx Era
$sel:commitTx:DraftCommitTxResponse :: forall tx. DraftCommitTxResponse tx -> tx
commitTx} = JsonResponse (DraftCommitTxResponse (Tx Era))
-> HttpResponseBody (JsonResponse (DraftCommitTxResponse (Tx Era)))
forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody JsonResponse (DraftCommitTxResponse (Tx Era))
res
backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend (Tx Era -> IO ()) -> Tx Era -> IO ()
forall a b. (a -> b) -> a -> b
$ SigningKey PaymentKey -> Tx Era -> Tx Era
forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
signTx SigningKey PaymentKey
walletSk Tx Era
commitTx
Maybe Value
lockedUTxO <- NominalDiffTime
-> HydraClient
-> (Value -> Maybe (Maybe Value))
-> IO (Maybe Value)
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n1 ((Value -> Maybe (Maybe Value)) -> IO (Maybe Value))
-> (Value -> Maybe (Maybe Value)) -> IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"headId" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (HeadId -> Value
forall a. ToJSON a => a -> Value
toJSON HeadId
headId)
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"HeadIsOpen"
Maybe Value -> Maybe (Maybe Value)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> Maybe (Maybe Value))
-> Maybe Value -> Maybe (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"utxo"
Maybe Value
lockedUTxO Maybe Value -> Maybe Value -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Value -> Maybe Value
forall a. a -> Maybe a
Just (UTxO' (TxOut CtxUTxO Era) -> Value
forall a. ToJSON a => a -> Value
toJSON UTxO' (TxOut CtxUTxO Era)
utxoToCommit)
singlePartyUsesScriptOnL2 ::
ChainBackend backend =>
Tracer IO EndToEndLog ->
FilePath ->
backend ->
[TxId] ->
IO ()
singlePartyUsesScriptOnL2 :: forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> String -> backend -> [TxId] -> IO ()
singlePartyUsesScriptOnL2 Tracer IO EndToEndLog
tracer String
workDir backend
backend [TxId]
hydraScriptsTxId =
( IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally`
do
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
returnFundsToFaucet Tracer IO EndToEndLog
tracer backend
backend Actor
Alice
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
returnFundsToFaucet Tracer IO EndToEndLog
tracer backend
backend Actor
AliceFunds
)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
refuelIfNeeded Tracer IO EndToEndLog
tracer backend
backend Actor
Alice Coin
250_000_000
let contestationPeriod :: ContestationPeriod
contestationPeriod = ContestationPeriod
1
ChainConfig
aliceChainConfig <- Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Alice String
workDir backend
backend [TxId]
hydraScriptsTxId [] ContestationPeriod
contestationPeriod
let hydraNodeId :: Int
hydraNodeId = Int
1
let hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
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 HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
hydraNodeId SigningKey HydraKey
aliceSk [] [Int
1] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Init" []
HeadId
headId <- NominalDiffTime
-> HydraClient -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n1 ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice])
(VerificationKey PaymentKey
walletVk, SigningKey PaymentKey
walletSk) <- Actor -> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
keysFor Actor
AliceFunds
let commitAmount :: Coin
commitAmount = Coin
100_000_000
UTxO' (TxOut CtxUTxO Era)
utxoToCommit <- backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
seedFromFaucet backend
backend VerificationKey PaymentKey
walletVk Coin
commitAmount ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n1 UTxO' (TxOut CtxUTxO Era)
utxoToCommit
IO (Tx Era) -> (Tx Era -> Tx Era) -> IO (Tx Era)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> SigningKey PaymentKey -> Tx Era -> Tx Era
forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
signTx SigningKey PaymentKey
walletSk IO (Tx Era) -> (Tx Era -> 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
>>= \Tx Era
tx -> do
backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend Tx Era
tx
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"HeadIsOpen" [Key
"utxo" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxO' (TxOut CtxUTxO Era) -> Value
forall a. ToJSON a => a -> Value
toJSON UTxO' (TxOut CtxUTxO Era)
utxoToCommit, Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId]
PParams ConwayEra
pparams <- HydraClient -> IO (PParams (ShelleyLedgerEra Era))
getProtocolParameters HydraClient
n1
NetworkId
networkId <- backend -> IO NetworkId
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> m NetworkId
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> m NetworkId
Backend.queryNetworkId backend
backend
let serializedScript :: PlutusScript
serializedScript = PlutusScript
dummyValidatorScript
let scriptAddress :: AddressInEra Era
scriptAddress = NetworkId -> PlutusScript -> AddressInEra Era
forall lang era.
(IsShelleyBasedEra era, IsPlutusScriptLanguage lang) =>
NetworkId -> PlutusScript lang -> AddressInEra era
mkScriptAddress NetworkId
networkId PlutusScript
serializedScript
let scriptOutput :: TxOut CtxTx Era
scriptOutput =
PParams (ShelleyLedgerEra Era)
-> AddressInEra Era
-> Value
-> TxOutDatum CtxTx Era
-> ReferenceScript Era
-> TxOut CtxTx Era
mkTxOutAutoBalance
PParams (ShelleyLedgerEra Era)
PParams ConwayEra
pparams
AddressInEra Era
scriptAddress
(Coin -> Value
lovelaceToValue Coin
0)
(() -> TxOutDatum CtxTx Era
forall era a ctx.
(ToScriptData a, IsAlonzoBasedEra era) =>
a -> TxOutDatum ctx era
mkTxOutDatumHash ())
ReferenceScript Era
ReferenceScriptNone
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
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
Set PoolId
stakePools <- backend -> QueryPoint -> IO (Set PoolId)
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> QueryPoint -> m (Set PoolId)
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> QueryPoint -> m (Set PoolId)
Backend.queryStakePools backend
backend QueryPoint
QueryTip
case PParams (ShelleyLedgerEra Era)
-> SystemStart
-> EraHistory
-> Set PoolId
-> AddressInEra Era
-> UTxO' (TxOut CtxUTxO Era)
-> [TxIn]
-> [TxOut CtxTx Era]
-> Either (TxBodyErrorAutoBalance Era) (Tx Era)
buildTransactionWithPParams' PParams (ShelleyLedgerEra Era)
PParams ConwayEra
pparams SystemStart
systemStart EraHistory
eraHistory Set PoolId
stakePools (NetworkId -> VerificationKey PaymentKey -> AddressInEra Era
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
walletVk) UTxO' (TxOut CtxUTxO Era)
utxoToCommit [] [TxOut CtxTx Era
scriptOutput] of
Left TxBodyErrorAutoBalance Era
e -> Text -> IO ()
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ TxBodyErrorAutoBalance Era -> Text
forall b a. (Show a, IsString b) => a -> b
show TxBodyErrorAutoBalance Era
e
Right Tx Era
tx -> do
let signedL2tx :: Tx Era
signedL2tx = SigningKey PaymentKey -> Tx Era -> Tx Era
forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
signTx SigningKey PaymentKey
walletSk Tx Era
tx
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"NewTx" [Key
"transaction" Key -> Tx Era -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tx Era
signedL2tx]
NominalDiffTime -> HydraClient -> (Value -> Maybe ()) -> IO ()
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch NominalDiffTime
10 HydraClient
n1 ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"SnapshotConfirmed"
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$
Tx Era -> Value
forall a. ToJSON a => a -> Value
toJSON Tx Era
signedL2tx
Value -> [Value] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` (Value
v Value -> Getting (Endo [Value]) Value Value -> [Value]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"snapshot" Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"confirmed" Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Value]) Value Value
forall t. AsValue t => IndexedTraversal' Int t Value
IndexedTraversal' Int Value Value
values)
let scriptWitness :: BuildTxWith BuildTx (Witness WitCtxTxIn)
scriptWitness =
Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn))
-> Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn)
forall a b. (a -> b) -> a -> b
$
ScriptWitnessInCtx WitCtxTxIn
-> ScriptWitness WitCtxTxIn -> Witness WitCtxTxIn
forall ctx.
ScriptWitnessInCtx ctx -> ScriptWitness ctx -> Witness ctx
ScriptWitness ScriptWitnessInCtx WitCtxTxIn
forall ctx. IsScriptWitnessInCtx ctx => ScriptWitnessInCtx ctx
scriptWitnessInCtx (ScriptWitness WitCtxTxIn -> Witness WitCtxTxIn)
-> ScriptWitness WitCtxTxIn -> Witness WitCtxTxIn
forall a b. (a -> b) -> a -> b
$
PlutusScript
-> ScriptDatum WitCtxTxIn
-> ScriptRedeemer
-> ExecutionUnits
-> ScriptWitness WitCtxTxIn
forall witctx.
PlutusScript
-> ScriptDatum witctx
-> ScriptRedeemer
-> ExecutionUnits
-> ScriptWitness witctx
PlutusScriptWitness
PlutusScript
serializedScript
(() -> ScriptDatum WitCtxTxIn
forall a. ToScriptData a => a -> ScriptDatum WitCtxTxIn
mkScriptDatum ())
(() -> ScriptRedeemer
forall a. ToScriptData a => a -> ScriptRedeemer
toScriptData ())
ExecutionUnits
maxTxExecutionUnits
let txIn :: TxIn
txIn = Tx Era -> Word -> TxIn
forall era. Tx era -> Word -> TxIn
mkTxIn Tx Era
signedL2tx Word
0
let remainder :: TxIn
remainder = Tx Era -> Word -> TxIn
forall era. Tx era -> Word -> TxIn
mkTxIn Tx Era
signedL2tx Word
1
let outAmt :: Value
outAmt = (TxOut CtxTx Era -> Value) -> [TxOut CtxTx Era] -> Value
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut CtxTx Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue (Tx Era -> [TxOut CtxTx Era]
forall era. Tx era -> [TxOut CtxTx era]
txOuts' Tx Era
tx)
let body :: TxBodyContent BuildTx Era
body =
TxBodyContent BuildTx Era
defaultTxBodyContent
TxBodyContent BuildTx Era
-> (TxBodyContent BuildTx Era -> TxBodyContent BuildTx Era)
-> TxBodyContent BuildTx Era
forall a b. a -> (a -> b) -> b
& TxIns BuildTx Era
-> TxBodyContent BuildTx Era -> TxBodyContent BuildTx Era
forall build era.
TxIns build era
-> TxBodyContent build era -> TxBodyContent build era
addTxIns [(TxIn
txIn, BuildTxWith BuildTx (Witness WitCtxTxIn)
scriptWitness), (TxIn
remainder, Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn))
-> Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn)
forall a b. (a -> b) -> a -> b
$ KeyWitnessInCtx WitCtxTxIn -> Witness WitCtxTxIn
forall ctx. KeyWitnessInCtx ctx -> Witness ctx
KeyWitness KeyWitnessInCtx WitCtxTxIn
KeyWitnessForSpending)]
TxBodyContent BuildTx Era
-> (TxBodyContent BuildTx Era -> TxBodyContent BuildTx Era)
-> TxBodyContent BuildTx Era
forall a b. a -> (a -> b) -> b
& [TxIn] -> TxBodyContent BuildTx Era -> TxBodyContent BuildTx Era
forall era build.
IsAlonzoBasedEra era =>
[TxIn] -> TxBodyContent build era -> TxBodyContent build era
addTxInsCollateral [TxIn
remainder]
TxBodyContent BuildTx Era
-> (TxBodyContent BuildTx Era -> TxBodyContent BuildTx Era)
-> TxBodyContent BuildTx Era
forall a b. a -> (a -> b) -> b
& [TxOut CtxTx Era]
-> TxBodyContent BuildTx Era -> TxBodyContent BuildTx Era
forall era build.
[TxOut CtxTx era]
-> TxBodyContent build era -> TxBodyContent build era
addTxOuts [AddressInEra Era
-> Value
-> TxOutDatum CtxTx Era
-> ReferenceScript Era
-> TxOut CtxTx Era
forall ctx.
AddressInEra Era
-> Value -> TxOutDatum ctx -> ReferenceScript Era -> TxOut ctx
TxOut (NetworkId -> VerificationKey PaymentKey -> AddressInEra Era
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
walletVk) Value
outAmt TxOutDatum CtxTx Era
forall ctx. TxOutDatum ctx
TxOutDatumNone ReferenceScript Era
ReferenceScriptNone]
TxBodyContent BuildTx Era
-> (TxBodyContent BuildTx Era -> TxBodyContent BuildTx Era)
-> TxBodyContent BuildTx Era
forall a b. a -> (a -> b) -> b
& BuildTxWith BuildTx (Maybe (LedgerProtocolParameters Era))
-> TxBodyContent BuildTx Era -> TxBodyContent BuildTx Era
forall build era.
BuildTxWith build (Maybe (LedgerProtocolParameters era))
-> TxBodyContent build era -> TxBodyContent build era
setTxProtocolParams (Maybe (LedgerProtocolParameters Era)
-> BuildTxWith BuildTx (Maybe (LedgerProtocolParameters Era))
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Maybe (LedgerProtocolParameters Era)
-> BuildTxWith BuildTx (Maybe (LedgerProtocolParameters Era)))
-> Maybe (LedgerProtocolParameters Era)
-> BuildTxWith BuildTx (Maybe (LedgerProtocolParameters Era))
forall a b. (a -> b) -> a -> b
$ LedgerProtocolParameters Era
-> Maybe (LedgerProtocolParameters Era)
forall a. a -> Maybe a
Just (LedgerProtocolParameters Era
-> Maybe (LedgerProtocolParameters Era))
-> LedgerProtocolParameters Era
-> Maybe (LedgerProtocolParameters Era)
forall a b. (a -> b) -> a -> b
$ PParams (ShelleyLedgerEra Era) -> LedgerProtocolParameters Era
forall era.
PParams (ShelleyLedgerEra era) -> LedgerProtocolParameters era
LedgerProtocolParameters PParams (ShelleyLedgerEra Era)
PParams ConwayEra
pparams)
TxBody Era
txBody <- (TxBodyError -> IO (TxBody Era))
-> (TxBody Era -> IO (TxBody Era))
-> Either TxBodyError (TxBody Era)
-> IO (TxBody Era)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> IO (TxBody Era)
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure (String -> IO (TxBody Era))
-> (TxBodyError -> String) -> TxBodyError -> IO (TxBody Era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBodyError -> String
forall b a. (Show a, IsString b) => a -> b
show) TxBody Era -> IO (TxBody Era)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxBodyContent BuildTx Era -> Either TxBodyError (TxBody Era)
createAndValidateTransactionBody TxBodyContent BuildTx Era
body)
let spendTx' :: Tx Era
spendTx' = [KeyWitness Era] -> TxBody Era -> Tx Era
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [] TxBody Era
txBody
spendTx :: Tx Era
spendTx = Tx (ShelleyLedgerEra Era) -> Tx Era
forall era.
IsShelleyBasedEra era =>
Tx (ShelleyLedgerEra era) -> Tx era
fromLedgerTx (Tx (ShelleyLedgerEra Era) -> Tx Era)
-> Tx (ShelleyLedgerEra Era) -> Tx Era
forall a b. (a -> b) -> a -> b
$ PParams ConwayEra
-> [Language]
-> Tx (ShelleyLedgerEra Era)
-> Tx (ShelleyLedgerEra Era)
forall ppera txera.
(AlonzoEraPParams ppera, AlonzoEraTxWits txera,
AlonzoEraTxBody txera, EraTx txera) =>
PParams ppera -> [Language] -> Tx txera -> Tx txera
recomputeIntegrityHash PParams ConwayEra
pparams [Language
PlutusV3] (Tx Era -> Tx (ShelleyLedgerEra Era)
forall era. Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx Tx Era
spendTx')
let signedTx :: Tx Era
signedTx = SigningKey PaymentKey -> Tx Era -> Tx Era
forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
signTx SigningKey PaymentKey
walletSk Tx Era
spendTx
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"NewTx" [Key
"transaction" Key -> Tx Era -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tx Era
signedTx]
NominalDiffTime -> HydraClient -> (Value -> Maybe ()) -> IO ()
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch NominalDiffTime
10 HydraClient
n1 ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"SnapshotConfirmed"
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$
Tx Era -> Value
forall a. ToJSON a => a -> Value
toJSON Tx Era
signedTx
Value -> [Value] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` (Value
v Value -> Getting (Endo [Value]) Value Value -> [Value]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"snapshot" Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"confirmed" Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Value]) Value Value
forall t. AsValue t => IndexedTraversal' Int t Value
IndexedTraversal' Int Value Value
values)
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Close" []
UTCTime
deadline <- NominalDiffTime
-> HydraClient -> (Value -> Maybe UTCTime) -> IO UTCTime
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n1 ((Value -> Maybe UTCTime) -> IO UTCTime)
-> (Value -> Maybe UTCTime) -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"HeadIsClosed"
Value
v Value -> Getting (First UTCTime) Value UTCTime -> Maybe UTCTime
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"contestationDeadline" ((Value -> Const (First UTCTime) Value)
-> Value -> Const (First UTCTime) Value)
-> Getting (First UTCTime) Value UTCTime
-> Getting (First UTCTime) Value UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First UTCTime) Value UTCTime
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
forall a b. (FromJSON a, ToJSON b) => Prism Value Value a b
Prism Value Value UTCTime UTCTime
_JSON
NominalDiffTime
remainingTime <- UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
deadline (UTCTime -> NominalDiffTime) -> IO UTCTime -> IO NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
remainingTime NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"ReadyToFanout" [Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId]
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Fanout" []
NominalDiffTime -> HydraClient -> (Value -> Maybe ()) -> IO ()
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n1 ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v ->
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"HeadIsFinalized"
(UTxO' (TxOut CtxUTxO Era) -> Value
UTxOType (Tx Era) -> ValueType (Tx Era)
forall tx. IsTx tx => UTxOType tx -> ValueType tx
balance (UTxO' (TxOut CtxUTxO Era) -> Value)
-> IO (UTxO' (TxOut CtxUTxO Era)) -> IO Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> backend
-> QueryPoint
-> VerificationKey PaymentKey
-> IO (UTxO' (TxOut CtxUTxO Era))
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a
-> QueryPoint
-> VerificationKey PaymentKey
-> m (UTxO' (TxOut CtxUTxO Era))
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend
-> QueryPoint
-> VerificationKey PaymentKey
-> m (UTxO' (TxOut CtxUTxO Era))
Backend.queryUTxOFor backend
backend QueryPoint
QueryTip VerificationKey PaymentKey
walletVk)
IO Value -> Value -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` Coin -> Value
lovelaceToValue Coin
commitAmount
singlePartyUsesWithdrawZeroTrick :: ChainBackend backend => Tracer IO EndToEndLog -> FilePath -> backend -> [TxId] -> IO ()
singlePartyUsesWithdrawZeroTrick :: forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> String -> backend -> [TxId] -> IO ()
singlePartyUsesWithdrawZeroTrick Tracer IO EndToEndLog
tracer String
workDir backend
backend [TxId]
hydraScriptsTxId =
IO () -> IO () -> IO () -> IO ()
forall a b c. IO a -> IO b -> IO c -> IO c
forall (m :: * -> *) a b c.
MonadThrow m =>
m a -> m b -> m c -> m c
bracket_ (Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
refuelIfNeeded Tracer IO EndToEndLog
tracer backend
backend Actor
Alice Coin
250_000_000) (Tracer IO EndToEndLog -> backend -> Actor -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
returnFundsToFaucet Tracer IO EndToEndLog
tracer backend
backend Actor
Alice) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
(VerificationKey PaymentKey
walletVk, SigningKey PaymentKey
walletSk) <- Actor -> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
keysFor Actor
AliceFunds
IO (UTxO' (TxOut CtxUTxO Era))
-> (UTxO' (TxOut CtxUTxO Era) -> IO ())
-> (UTxO' (TxOut CtxUTxO Era) -> IO ())
-> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
forall (m :: * -> *) a b c.
MonadThrow m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
(backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
seedFromFaucet backend
backend VerificationKey PaymentKey
walletVk Coin
100_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer))
(\UTxO' (TxOut CtxUTxO Era)
_ -> Tracer IO EndToEndLog -> backend -> Actor -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
returnFundsToFaucet Tracer IO EndToEndLog
tracer backend
backend Actor
AliceFunds)
((UTxO' (TxOut CtxUTxO Era) -> IO ()) -> IO ())
-> (UTxO' (TxOut CtxUTxO Era) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \UTxO' (TxOut CtxUTxO Era)
utxoToCommit -> do
let contestationPeriod :: ContestationPeriod
contestationPeriod = ContestationPeriod
1
ChainConfig
aliceChainConfig <- Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Alice String
workDir backend
backend [TxId]
hydraScriptsTxId [] ContestationPeriod
contestationPeriod
let hydraNodeId :: Int
hydraNodeId = Int
1
let hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
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
NetworkId
networkId <- backend -> IO NetworkId
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> m NetworkId
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> m NetworkId
Backend.queryNetworkId backend
backend
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
hydraNodeId SigningKey HydraKey
aliceSk [] [Int
1] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Init" []
HeadId
headId <- NominalDiffTime
-> HydraClient -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n1 ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice])
HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n1 UTxO' (TxOut CtxUTxO Era)
utxoToCommit IO (Tx Era) -> (Tx Era -> Tx Era) -> IO (Tx Era)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> SigningKey PaymentKey -> Tx Era -> Tx Era
forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
signTx SigningKey PaymentKey
walletSk IO (Tx Era) -> (Tx Era -> 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
>>= backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"HeadIsOpen" [Key
"utxo" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxO' (TxOut CtxUTxO Era) -> Value
forall a. ToJSON a => a -> Value
toJSON UTxO' (TxOut CtxUTxO Era)
utxoToCommit, Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId]
PParams ConwayEra
pparams <- HydraClient -> IO (PParams (ShelleyLedgerEra Era))
getProtocolParameters HydraClient
n1
let change :: AddressInEra Era
change = NetworkId -> VerificationKey PaymentKey -> AddressInEra Era
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
walletVk
Right Tx Era
tx <- PParams (ShelleyLedgerEra Era)
-> backend
-> AddressInEra Era
-> UTxO' (TxOut CtxUTxO Era)
-> [TxIn]
-> [TxOut CtxTx Era]
-> IO (Either (TxBodyErrorAutoBalance Era) (Tx Era))
forall backend.
ChainBackend backend =>
PParams (ShelleyLedgerEra Era)
-> backend
-> AddressInEra Era
-> UTxO' (TxOut CtxUTxO Era)
-> [TxIn]
-> [TxOut CtxTx Era]
-> IO (Either (TxBodyErrorAutoBalance Era) (Tx Era))
buildTransactionWithPParams PParams (ShelleyLedgerEra Era)
PParams ConwayEra
pparams backend
backend AddressInEra Era
change UTxO' (TxOut CtxUTxO Era)
utxoToCommit [] []
let redeemer :: Data ConwayEra
redeemer = ScriptRedeemer -> Data ConwayEra
forall era. Era era => ScriptRedeemer -> Data era
toLedgerData (ScriptRedeemer -> Data ConwayEra)
-> ScriptRedeemer -> Data ConwayEra
forall a b. (a -> b) -> a -> b
$ () -> ScriptRedeemer
forall a. ToScriptData a => a -> ScriptRedeemer
toScriptData ()
exUnits :: ExUnits
exUnits = ExecutionUnits -> ExUnits
toLedgerExUnits ExecutionUnits
maxTxExecutionUnits
rewardAccount :: RewardAccount
rewardAccount = Network -> Credential 'Staking -> RewardAccount
RewardAccount Network
Testnet (ScriptHash -> Credential 'Staking
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj ScriptHash
scriptHash)
scriptHash :: ScriptHash
scriptHash = Script ConwayEra -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript Script ConwayEra
AlonzoScript ConwayEra
script
script :: AlonzoScript (ShelleyLedgerEra Era)
script = forall lang era.
ToAlonzoScript lang era =>
PlutusScript lang -> AlonzoScript (ShelleyLedgerEra era)
toLedgerScript @_ @Era PlutusScript
dummyRewardingScript
let tx' :: Tx Era
tx' =
Tx (ShelleyLedgerEra Era) -> Tx Era
forall era.
IsShelleyBasedEra era =>
Tx (ShelleyLedgerEra era) -> Tx era
fromLedgerTx (Tx (ShelleyLedgerEra Era) -> Tx Era)
-> Tx (ShelleyLedgerEra Era) -> Tx Era
forall a b. (a -> b) -> a -> b
$
PParams ConwayEra
-> [Language]
-> Tx (ShelleyLedgerEra Era)
-> Tx (ShelleyLedgerEra Era)
forall ppera txera.
(AlonzoEraPParams ppera, AlonzoEraTxWits txera,
AlonzoEraTxBody txera, EraTx txera) =>
PParams ppera -> [Language] -> Tx txera -> Tx txera
recomputeIntegrityHash PParams ConwayEra
pparams [Language
PlutusV3] (Tx (ShelleyLedgerEra Era) -> Tx (ShelleyLedgerEra Era))
-> Tx (ShelleyLedgerEra Era) -> Tx (ShelleyLedgerEra Era)
forall a b. (a -> b) -> a -> b
$
Tx Era -> Tx (ShelleyLedgerEra Era)
forall era. Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx Tx Era
tx
AlonzoTx ConwayEra
-> (AlonzoTx ConwayEra -> AlonzoTx ConwayEra) -> AlonzoTx ConwayEra
forall a b. a -> (a -> b) -> b
& (TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> Tx ConwayEra -> Identity (Tx ConwayEra)
(TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx ConwayEra) (TxBody ConwayEra)
bodyTxL ((TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra))
-> ((Set TxIn -> Identity (Set TxIn))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> (Set TxIn -> Identity (Set TxIn))
-> AlonzoTx ConwayEra
-> Identity (AlonzoTx ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxIn -> Identity (Set TxIn))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody ConwayEra) (Set TxIn)
collateralInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
-> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra))
-> Set TxIn -> AlonzoTx ConwayEra -> AlonzoTx ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (TxIn -> TxIn) -> Set TxIn -> Set TxIn
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map TxIn -> TxIn
toLedgerTxIn (UTxO' (TxOut CtxUTxO Era) -> Set TxIn
forall out. UTxO' out -> Set TxIn
UTxO.inputSet UTxO' (TxOut CtxUTxO Era)
utxoToCommit)
AlonzoTx ConwayEra
-> (AlonzoTx ConwayEra -> AlonzoTx ConwayEra) -> AlonzoTx ConwayEra
forall a b. a -> (a -> b) -> b
& (TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> Tx ConwayEra -> Identity (Tx ConwayEra)
(TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx ConwayEra) (TxBody ConwayEra)
bodyTxL ((TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra))
-> ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> AlonzoTx ConwayEra
-> Identity (AlonzoTx ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictMaybe Coin)
Lens' (TxBody ConwayEra) (StrictMaybe Coin)
totalCollateralTxBodyL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra))
-> StrictMaybe Coin -> AlonzoTx ConwayEra -> AlonzoTx ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust ((TxOut CtxUTxO Era -> Coin) -> UTxO' (TxOut CtxUTxO Era) -> Coin
forall m a. Monoid m => (a -> m) -> UTxO' a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Value -> Coin
selectLovelace (Value -> Coin)
-> (TxOut CtxUTxO Era -> Value) -> TxOut CtxUTxO Era -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut CtxUTxO Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue) UTxO' (TxOut CtxUTxO Era)
utxoToCommit)
AlonzoTx ConwayEra
-> (AlonzoTx ConwayEra -> AlonzoTx ConwayEra) -> AlonzoTx ConwayEra
forall a b. a -> (a -> b) -> b
& (TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> Tx ConwayEra -> Identity (Tx ConwayEra)
(TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx ConwayEra) (TxBody ConwayEra)
bodyTxL ((TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra))
-> ((Withdrawals -> Identity Withdrawals)
-> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> (Withdrawals -> Identity Withdrawals)
-> AlonzoTx ConwayEra
-> Identity (AlonzoTx ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Withdrawals -> Identity Withdrawals)
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
Lens' (TxBody ConwayEra) Withdrawals
withdrawalsTxBodyL ((Withdrawals -> Identity Withdrawals)
-> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra))
-> Withdrawals -> AlonzoTx ConwayEra -> AlonzoTx ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map RewardAccount Coin -> Withdrawals
Withdrawals (RewardAccount -> Coin -> Map RewardAccount Coin
forall k a. k -> a -> Map k a
Map.singleton RewardAccount
rewardAccount Coin
0)
AlonzoTx ConwayEra
-> (AlonzoTx ConwayEra -> AlonzoTx ConwayEra) -> AlonzoTx ConwayEra
forall a b. a -> (a -> b) -> b
& (TxWits ConwayEra -> Identity (TxWits ConwayEra))
-> Tx ConwayEra -> Identity (Tx ConwayEra)
(TxWits ConwayEra -> Identity (TxWits ConwayEra))
-> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx ConwayEra) (TxWits ConwayEra)
witsTxL ((TxWits ConwayEra -> Identity (TxWits ConwayEra))
-> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra))
-> ((Redeemers ConwayEra -> Identity (Redeemers ConwayEra))
-> TxWits ConwayEra -> Identity (TxWits ConwayEra))
-> (Redeemers ConwayEra -> Identity (Redeemers ConwayEra))
-> AlonzoTx ConwayEra
-> Identity (AlonzoTx ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers ConwayEra -> Identity (Redeemers ConwayEra))
-> TxWits ConwayEra -> Identity (TxWits ConwayEra)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits ConwayEra) (Redeemers ConwayEra)
rdmrsTxWitsL ((Redeemers ConwayEra -> Identity (Redeemers ConwayEra))
-> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra))
-> Redeemers ConwayEra -> AlonzoTx ConwayEra -> AlonzoTx ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
-> Redeemers ConwayEra
forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers (ConwayPlutusPurpose AsIx ConwayEra
-> (Data ConwayEra, ExUnits)
-> Map
(ConwayPlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
forall k a. k -> a -> Map k a
Map.singleton (AsIx Word32 RewardAccount -> ConwayPlutusPurpose AsIx ConwayEra
forall (f :: * -> * -> *) era.
f Word32 RewardAccount -> ConwayPlutusPurpose f era
ConwayRewarding (AsIx Word32 RewardAccount -> ConwayPlutusPurpose AsIx ConwayEra)
-> AsIx Word32 RewardAccount -> ConwayPlutusPurpose AsIx ConwayEra
forall a b. (a -> b) -> a -> b
$ Word32 -> AsIx Word32 RewardAccount
forall ix it. ix -> AsIx ix it
AsIx Word32
0) (Data ConwayEra
redeemer, ExUnits
exUnits))
AlonzoTx ConwayEra
-> (AlonzoTx ConwayEra -> Tx (ShelleyLedgerEra Era))
-> Tx (ShelleyLedgerEra Era)
forall a b. a -> (a -> b) -> b
& (TxWits ConwayEra -> Identity (TxWits ConwayEra))
-> Tx ConwayEra -> Identity (Tx ConwayEra)
(TxWits ConwayEra -> Identity (TxWits ConwayEra))
-> AlonzoTx ConwayEra -> Identity (Tx (ShelleyLedgerEra Era))
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx ConwayEra) (TxWits ConwayEra)
witsTxL ((TxWits ConwayEra -> Identity (TxWits ConwayEra))
-> AlonzoTx ConwayEra -> Identity (Tx (ShelleyLedgerEra Era)))
-> ((Map ScriptHash (Script ConwayEra)
-> Identity (Map ScriptHash (AlonzoScript ConwayEra)))
-> TxWits ConwayEra -> Identity (TxWits ConwayEra))
-> (Map ScriptHash (Script ConwayEra)
-> Identity (Map ScriptHash (AlonzoScript ConwayEra)))
-> AlonzoTx ConwayEra
-> Identity (Tx (ShelleyLedgerEra Era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ScriptHash (Script ConwayEra)
-> Identity (Map ScriptHash (Script ConwayEra)))
-> TxWits ConwayEra -> Identity (TxWits ConwayEra)
(Map ScriptHash (Script ConwayEra)
-> Identity (Map ScriptHash (AlonzoScript ConwayEra)))
-> TxWits ConwayEra -> Identity (TxWits ConwayEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits ConwayEra) (Map ScriptHash (Script ConwayEra))
scriptTxWitsL ((Map ScriptHash (Script ConwayEra)
-> Identity (Map ScriptHash (AlonzoScript ConwayEra)))
-> AlonzoTx ConwayEra -> Identity (Tx (ShelleyLedgerEra Era)))
-> Map ScriptHash (AlonzoScript ConwayEra)
-> AlonzoTx ConwayEra
-> Tx (ShelleyLedgerEra Era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ScriptHash
-> AlonzoScript ConwayEra
-> Map ScriptHash (AlonzoScript ConwayEra)
forall k a. k -> a -> Map k a
Map.singleton ScriptHash
scriptHash AlonzoScript ConwayEra
script
let signedL2tx :: Tx Era
signedL2tx = SigningKey PaymentKey -> Tx Era -> Tx Era
forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
signTx SigningKey PaymentKey
walletSk Tx Era
tx'
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"NewTx" [Key
"transaction" Key -> Tx Era -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tx Era
signedL2tx]
NominalDiffTime -> HydraClient -> (Value -> Maybe ()) -> IO ()
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch NominalDiffTime
10 HydraClient
n1 ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"SnapshotConfirmed"
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$
Tx Era -> Value
forall a. ToJSON a => a -> Value
toJSON Tx Era
signedL2tx
Value -> [Value] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` (Value
v Value -> Getting (Endo [Value]) Value Value -> [Value]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"snapshot" Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"confirmed" Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Value]) Value Value
forall t. AsValue t => IndexedTraversal' Int t Value
IndexedTraversal' Int Value Value
values)
recomputeIntegrityHash ::
(AlonzoEraPParams ppera, AlonzoEraTxWits txera, AlonzoEraTxBody txera, EraTx txera) =>
PParams ppera ->
[Language] ->
Ledger.Tx txera ->
Ledger.Tx txera
recomputeIntegrityHash :: forall ppera txera.
(AlonzoEraPParams ppera, AlonzoEraTxWits txera,
AlonzoEraTxBody txera, EraTx txera) =>
PParams ppera -> [Language] -> Tx txera -> Tx txera
recomputeIntegrityHash PParams ppera
pp [Language]
languages Tx txera
tx = do
Tx txera
tx Tx txera -> (Tx txera -> Tx txera) -> Tx txera
forall a b. a -> (a -> b) -> b
& (TxBody txera -> Identity (TxBody txera))
-> Tx txera -> Identity (Tx txera)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx txera) (TxBody txera)
bodyTxL ((TxBody txera -> Identity (TxBody txera))
-> Tx txera -> Identity (Tx txera))
-> ((StrictMaybe ScriptIntegrityHash
-> Identity (StrictMaybe ScriptIntegrityHash))
-> TxBody txera -> Identity (TxBody txera))
-> (StrictMaybe ScriptIntegrityHash
-> Identity (StrictMaybe ScriptIntegrityHash))
-> Tx txera
-> Identity (Tx txera)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe ScriptIntegrityHash
-> Identity (StrictMaybe ScriptIntegrityHash))
-> TxBody txera -> Identity (TxBody txera)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
Lens' (TxBody txera) (StrictMaybe ScriptIntegrityHash)
scriptIntegrityHashTxBodyL ((StrictMaybe ScriptIntegrityHash
-> Identity (StrictMaybe ScriptIntegrityHash))
-> Tx txera -> Identity (Tx txera))
-> StrictMaybe ScriptIntegrityHash -> Tx txera -> Tx txera
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe ScriptIntegrityHash
integrityHash
where
integrityHash :: StrictMaybe ScriptIntegrityHash
integrityHash =
Set LangDepView
-> Redeemers txera
-> TxDats txera
-> StrictMaybe ScriptIntegrityHash
forall era.
AlonzoEraScript era =>
Set LangDepView
-> Redeemers era -> TxDats era -> StrictMaybe ScriptIntegrityHash
hashScriptIntegrity
([LangDepView] -> Set LangDepView
forall a. Ord a => [a] -> Set a
Set.fromList ([LangDepView] -> Set LangDepView)
-> [LangDepView] -> Set LangDepView
forall a b. (a -> b) -> a -> b
$ PParams ppera -> Language -> LangDepView
forall era.
AlonzoEraPParams era =>
PParams era -> Language -> LangDepView
getLanguageView PParams ppera
pp (Language -> LangDepView) -> [Language] -> [LangDepView]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Language]
languages)
(Tx txera
tx Tx txera
-> Getting (Redeemers txera) (Tx txera) (Redeemers txera)
-> Redeemers txera
forall s a. s -> Getting a s a -> a
^. (TxWits txera -> Const (Redeemers txera) (TxWits txera))
-> Tx txera -> Const (Redeemers txera) (Tx txera)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx txera) (TxWits txera)
witsTxL ((TxWits txera -> Const (Redeemers txera) (TxWits txera))
-> Tx txera -> Const (Redeemers txera) (Tx txera))
-> ((Redeemers txera -> Const (Redeemers txera) (Redeemers txera))
-> TxWits txera -> Const (Redeemers txera) (TxWits txera))
-> Getting (Redeemers txera) (Tx txera) (Redeemers txera)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers txera -> Const (Redeemers txera) (Redeemers txera))
-> TxWits txera -> Const (Redeemers txera) (TxWits txera)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits txera) (Redeemers txera)
rdmrsTxWitsL)
(Tx txera
tx Tx txera
-> Getting (TxDats txera) (Tx txera) (TxDats txera) -> TxDats txera
forall s a. s -> Getting a s a -> a
^. (TxWits txera -> Const (TxDats txera) (TxWits txera))
-> Tx txera -> Const (TxDats txera) (Tx txera)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx txera) (TxWits txera)
witsTxL ((TxWits txera -> Const (TxDats txera) (TxWits txera))
-> Tx txera -> Const (TxDats txera) (Tx txera))
-> ((TxDats txera -> Const (TxDats txera) (TxDats txera))
-> TxWits txera -> Const (TxDats txera) (TxWits txera))
-> Getting (TxDats txera) (Tx txera) (TxDats txera)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxDats txera -> Const (TxDats txera) (TxDats txera))
-> TxWits txera -> Const (TxDats txera) (TxWits txera)
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits txera) (TxDats txera)
datsTxWitsL)
singlePartyCommitsScriptBlueprint ::
ChainBackend backend =>
Tracer IO EndToEndLog ->
FilePath ->
backend ->
[TxId] ->
IO ()
singlePartyCommitsScriptBlueprint :: forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> String -> backend -> [TxId] -> IO ()
singlePartyCommitsScriptBlueprint Tracer IO EndToEndLog
tracer String
workDir backend
backend [TxId]
hydraScriptsTxId =
(IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` Tracer IO EndToEndLog -> backend -> Actor -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
returnFundsToFaucet Tracer IO EndToEndLog
tracer backend
backend Actor
Alice) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
refuelIfNeeded Tracer IO EndToEndLog
tracer backend
backend Actor
Alice Coin
20_000_000
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
let contestationPeriod :: 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
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime
depositPeriod :: DepositPeriod
depositPeriod = NominalDiffTime -> DepositPeriod
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (NominalDiffTime -> DepositPeriod)
-> NominalDiffTime -> DepositPeriod
forall a b. (a -> b) -> a -> b
$ NominalDiffTime
50 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime
ChainConfig
aliceChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Alice String
workDir backend
backend [TxId]
hydraScriptsTxId [] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (CardanoChainConfig -> CardanoChainConfig)
-> ChainConfig -> ChainConfig
modifyConfig (\CardanoChainConfig
c -> CardanoChainConfig
c{depositPeriod})
let hydraNodeId :: Int
hydraNodeId = Int
1
let hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
(VerificationKey PaymentKey
_, SigningKey PaymentKey
walletSk) <- Actor -> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
keysFor Actor
AliceFunds
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
hydraNodeId SigningKey HydraKey
aliceSk [] [Int
1] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Init" []
HeadId
headId <- NominalDiffTime
-> HydraClient -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n1 ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice])
(Value
clientPayload, UTxO' (TxOut CtxUTxO Era)
scriptUTxO) <- Coin -> IO (Value, UTxO' (TxOut CtxUTxO Era))
prepareScriptPayload Coin
3_000_000
JsonResponse (Tx Era)
res <-
HttpConfig
-> Req (JsonResponse (Tx Era)) -> IO (JsonResponse (Tx Era))
forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
runReq HttpConfig
defaultHttpConfig (Req (JsonResponse (Tx Era)) -> IO (JsonResponse (Tx Era)))
-> Req (JsonResponse (Tx Era)) -> IO (JsonResponse (Tx Era))
forall a b. (a -> b) -> a -> b
$
POST
-> Url 'Http
-> ReqBodyJson Value
-> Proxy (JsonResponse (Tx Era))
-> Option 'Http
-> Req (JsonResponse (Tx Era))
forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
HttpResponse response,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req
POST
POST
(Text -> Url 'Http
http Text
"127.0.0.1" Url 'Http -> Text -> Url 'Http
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"commit")
(Value -> ReqBodyJson Value
forall a. a -> ReqBodyJson a
ReqBodyJson Value
clientPayload)
(Proxy (JsonResponse (Tx Era))
forall {k} (t :: k). Proxy t
Proxy :: Proxy (JsonResponse Tx))
(Int -> Option 'Http
forall (scheme :: Scheme). Int -> Option scheme
port (Int -> Option 'Http) -> Int -> Option 'Http
forall a b. (a -> b) -> a -> b
$ Int
4000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hydraNodeId)
let commitTx :: HttpResponseBody (JsonResponse (Tx Era))
commitTx = JsonResponse (Tx Era) -> HttpResponseBody (JsonResponse (Tx Era))
forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody JsonResponse (Tx Era)
res
backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend Tx Era
HttpResponseBody (JsonResponse (Tx Era))
commitTx
Maybe Value
lockedUTxO <- NominalDiffTime
-> HydraClient
-> (Value -> Maybe (Maybe Value))
-> IO (Maybe Value)
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n1 ((Value -> Maybe (Maybe Value)) -> IO (Maybe Value))
-> (Value -> Maybe (Maybe Value)) -> IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"headId" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (HeadId -> Value
forall a. ToJSON a => a -> Value
toJSON HeadId
headId)
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"HeadIsOpen"
Maybe Value -> Maybe (Maybe Value)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> Maybe (Maybe Value))
-> Maybe Value -> Maybe (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"utxo"
Maybe Value
lockedUTxO Maybe Value -> Maybe Value -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Value -> Maybe Value
forall a. a -> Maybe a
Just (UTxO' (TxOut CtxUTxO Era) -> Value
forall a. ToJSON a => a -> Value
toJSON UTxO' (TxOut CtxUTxO Era)
scriptUTxO)
(Value
clientPayload', UTxO' (TxOut CtxUTxO Era)
scriptUTxO') <- Coin -> IO (Value, UTxO' (TxOut CtxUTxO Era))
prepareScriptPayload Coin
2_000_000
JsonResponse (Tx Era)
res' <-
HttpConfig
-> Req (JsonResponse (Tx Era)) -> IO (JsonResponse (Tx Era))
forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
runReq HttpConfig
defaultHttpConfig (Req (JsonResponse (Tx Era)) -> IO (JsonResponse (Tx Era)))
-> Req (JsonResponse (Tx Era)) -> IO (JsonResponse (Tx Era))
forall a b. (a -> b) -> a -> b
$
POST
-> Url 'Http
-> ReqBodyJson Value
-> Proxy (JsonResponse (Tx Era))
-> Option 'Http
-> Req (JsonResponse (Tx Era))
forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
HttpResponse response,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req
POST
POST
(Text -> Url 'Http
http Text
"127.0.0.1" Url 'Http -> Text -> Url 'Http
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"commit")
(Value -> ReqBodyJson Value
forall a. a -> ReqBodyJson a
ReqBodyJson Value
clientPayload')
(Proxy (JsonResponse (Tx Era))
forall {k} (t :: k). Proxy t
Proxy :: Proxy (JsonResponse Tx))
(Int -> Option 'Http
forall (scheme :: Scheme). Int -> Option scheme
port (Int -> Option 'Http) -> Int -> Option 'Http
forall a b. (a -> b) -> a -> b
$ Int
4000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hydraNodeId)
let depositTransaction :: HttpResponseBody (JsonResponse (Tx Era))
depositTransaction = JsonResponse (Tx Era) -> HttpResponseBody (JsonResponse (Tx Era))
forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody JsonResponse (Tx Era)
res'
let tx :: Tx Era
tx = SigningKey PaymentKey -> Tx Era -> Tx Era
forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
signTx SigningKey PaymentKey
walletSk Tx Era
HttpResponseBody (JsonResponse (Tx Era))
depositTransaction
backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend Tx Era
tx
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
2 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* DepositPeriod -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac DepositPeriod
depositPeriod) [HydraClient
n1] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"CommitApproved" [Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId, Key
"utxoToCommit" Key -> UTxO' (TxOut CtxUTxO Era) -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxO' (TxOut CtxUTxO Era)
scriptUTxO']
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
20 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"CommitFinalized" [Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId, Key
"depositTxId" Key -> TxId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TxBody Era -> TxId
forall era. TxBody era -> TxId
getTxId (Tx Era -> TxBody Era
forall era. Tx era -> TxBody era
getTxBody Tx Era
tx)]
HydraClient -> IO (UTxO' (TxOut CtxUTxO Era))
getSnapshotUTxO HydraClient
n1 IO (UTxO' (TxOut CtxUTxO Era))
-> UTxO' (TxOut CtxUTxO Era) -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` UTxO' (TxOut CtxUTxO Era)
scriptUTxO UTxO' (TxOut CtxUTxO Era)
-> UTxO' (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era)
forall a. Semigroup a => a -> a -> a
<> UTxO' (TxOut CtxUTxO Era)
scriptUTxO'
where
prepareScriptPayload :: Coin -> IO (Value, UTxO' (TxOut CtxUTxO Era))
prepareScriptPayload Coin
lovelaceAmt = do
NetworkId
networkId <- backend -> IO NetworkId
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> m NetworkId
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> m NetworkId
Backend.queryNetworkId backend
backend
let scriptAddress :: AddressInEra Era
scriptAddress = NetworkId -> PlutusScript -> AddressInEra Era
forall lang era.
(IsShelleyBasedEra era, IsPlutusScriptLanguage lang) =>
NetworkId -> PlutusScript lang -> AddressInEra era
mkScriptAddress NetworkId
networkId PlutusScript
dummyValidatorScript
let datumHash :: TxOutDatum ctx Era
datumHash = () -> TxOutDatum ctx Era
forall era a ctx.
(ToScriptData a, IsAlonzoBasedEra era) =>
a -> TxOutDatum ctx era
mkTxOutDatumHash ()
(TxIn
scriptIn, TxOut CtxUTxO Era
scriptOut) <- NetworkId
-> backend
-> AddressInEra Era
-> TxOutDatum CtxTx Era
-> Value
-> IO (TxIn, TxOut CtxUTxO Era)
forall backend.
ChainBackend backend =>
NetworkId
-> backend
-> AddressInEra Era
-> TxOutDatum CtxTx Era
-> Value
-> IO (TxIn, TxOut CtxUTxO Era)
createOutputAtAddress NetworkId
networkId backend
backend AddressInEra Era
scriptAddress TxOutDatum CtxTx Era
forall ctx. TxOutDatum ctx
datumHash (Coin -> Value
lovelaceToValue Coin
lovelaceAmt)
let scriptUTxO :: UTxO' (TxOut CtxUTxO Era)
scriptUTxO = TxIn -> TxOut CtxUTxO Era -> UTxO' (TxOut CtxUTxO Era)
forall out. TxIn -> out -> UTxO' out
UTxO.singleton TxIn
scriptIn TxOut CtxUTxO Era
scriptOut
let scriptWitness :: BuildTxWith BuildTx (Witness WitCtxTxIn)
scriptWitness =
Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn))
-> Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn)
forall a b. (a -> b) -> a -> b
$
ScriptWitnessInCtx WitCtxTxIn
-> ScriptWitness WitCtxTxIn -> Witness WitCtxTxIn
forall ctx.
ScriptWitnessInCtx ctx -> ScriptWitness ctx -> Witness ctx
ScriptWitness ScriptWitnessInCtx WitCtxTxIn
forall ctx. IsScriptWitnessInCtx ctx => ScriptWitnessInCtx ctx
scriptWitnessInCtx (ScriptWitness WitCtxTxIn -> Witness WitCtxTxIn)
-> ScriptWitness WitCtxTxIn -> Witness WitCtxTxIn
forall a b. (a -> b) -> a -> b
$
PlutusScript
-> ScriptDatum WitCtxTxIn
-> ScriptRedeemer
-> ScriptWitness WitCtxTxIn
forall ctx era lang.
(IsPlutusScriptLanguage lang, HasScriptLanguageInEra lang era) =>
PlutusScript lang
-> ScriptDatum ctx -> ScriptRedeemer -> ScriptWitness ctx era
mkScriptWitness PlutusScript
dummyValidatorScript (() -> ScriptDatum WitCtxTxIn
forall a. ToScriptData a => a -> ScriptDatum WitCtxTxIn
mkScriptDatum ()) (() -> ScriptRedeemer
forall a. ToScriptData a => a -> ScriptRedeemer
toScriptData ())
let spendingTx :: Tx Era
spendingTx =
HasCallStack => TxBodyContent BuildTx Era -> Tx Era
TxBodyContent BuildTx Era -> Tx Era
unsafeBuildTransaction (TxBodyContent BuildTx Era -> Tx Era)
-> TxBodyContent BuildTx Era -> Tx Era
forall a b. (a -> b) -> a -> b
$
TxBodyContent BuildTx Era
defaultTxBodyContent
TxBodyContent BuildTx Era
-> (TxBodyContent BuildTx Era -> TxBodyContent BuildTx Era)
-> TxBodyContent BuildTx Era
forall a b. a -> (a -> b) -> b
& TxIns BuildTx Era
-> TxBodyContent BuildTx Era -> TxBodyContent BuildTx Era
forall build era.
TxIns build era
-> TxBodyContent build era -> TxBodyContent build era
addTxIns [(TxIn
scriptIn, BuildTxWith BuildTx (Witness WitCtxTxIn)
scriptWitness)]
(Value, UTxO' (TxOut CtxUTxO Era))
-> IO (Value, UTxO' (TxOut CtxUTxO Era))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( [Pair] -> Value
Aeson.object
[ Key
"blueprintTx" Key -> Tx Era -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tx Era
spendingTx
, Key
"utxo" Key -> UTxO' (TxOut CtxUTxO Era) -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxO' (TxOut CtxUTxO Era)
scriptUTxO
]
, UTxO' (TxOut CtxUTxO Era)
scriptUTxO
)
persistenceCanLoadWithEmptyCommit ::
ChainBackend backend =>
Tracer IO EndToEndLog ->
FilePath ->
backend ->
[TxId] ->
IO ()
persistenceCanLoadWithEmptyCommit :: forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> String -> backend -> [TxId] -> IO ()
persistenceCanLoadWithEmptyCommit Tracer IO EndToEndLog
tracer String
workDir backend
backend [TxId]
hydraScriptsTxId =
(IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` Tracer IO EndToEndLog -> backend -> Actor -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
returnFundsToFaucet Tracer IO EndToEndLog
tracer backend
backend Actor
Alice) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
refuelIfNeeded Tracer IO EndToEndLog
tracer backend
backend Actor
Alice Coin
20_000_000
let contestationPeriod :: ContestationPeriod
contestationPeriod = ContestationPeriod
100
ChainConfig
aliceChainConfig <- Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Alice String
workDir backend
backend [TxId]
hydraScriptsTxId [] ContestationPeriod
contestationPeriod
let hydraNodeId :: Int
hydraNodeId = Int
1
let hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
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
HeadId
headId <- Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO HeadId)
-> IO HeadId
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
hydraNodeId SigningKey HydraKey
aliceSk [] [Int
1] ((HydraClient -> IO HeadId) -> IO HeadId)
-> (HydraClient -> IO HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Init" []
HeadId
headId <- NominalDiffTime
-> HydraClient -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n1 ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice])
HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n1 UTxO' (TxOut CtxUTxO Era)
forall a. Monoid a => a
mempty IO (Tx Era) -> (Tx Era -> 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
>>= backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"HeadIsOpen" [Key
"utxo" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Pair]
forall a. Monoid a => a
mempty, Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId]
HeadId -> IO HeadId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HeadId
headId
let persistenceState :: String
persistenceState = String
workDir String -> ShowS
</> String
"state-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall b a. (Show a, IsString b) => a -> b
show Int
hydraNodeId String -> ShowS
</> String
"state"
ByteString
stateContents <- String -> IO ByteString
forall (m :: * -> *). MonadIO m => String -> m ByteString
readFileBS String
persistenceState
let headOpened :: ByteString
headOpened = String -> ByteString
BSC.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. HasCallStack => [a] -> a
List.last (String -> [String]
List.lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BSC.unpack ByteString
stateContents)
case ByteString
headOpened ByteString -> Getting (First Text) ByteString Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' ByteString Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"stateChanged" ((Value -> Const (First Text) Value)
-> ByteString -> Const (First Text) ByteString)
-> ((Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value)
-> Getting (First Text) ByteString Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" ((Value -> Const (First Text) Value)
-> Value -> Const (First Text) Value)
-> ((Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value)
-> (Text -> Const (First Text) Text)
-> Value
-> Const (First Text) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value
forall t. AsValue t => Prism' t Text
Prism' Value Text
_String of
Maybe Text
Nothing -> Text -> IO ()
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Failed to find HeadIsOpened in the state file"
Just Text
headIsOpen -> do
Text
headIsOpen Text -> Text -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Text
"HeadOpened"
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
hydraNodeId SigningKey HydraKey
aliceSk [] [Int
1] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"HeadIsOpen" [Key
"utxo" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Pair]
forall a. Monoid a => a
mempty, Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId]
HydraClient -> IO (UTxO' (TxOut CtxUTxO Era))
getSnapshotUTxO HydraClient
n1 IO (UTxO' (TxOut CtxUTxO Era))
-> UTxO' (TxOut CtxUTxO Era) -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` UTxO' (TxOut CtxUTxO Era)
forall a. Monoid a => a
mempty
singlePartyCommitsFromExternalTxBlueprint ::
ChainBackend backend =>
Tracer IO EndToEndLog ->
FilePath ->
backend ->
[TxId] ->
IO ()
singlePartyCommitsFromExternalTxBlueprint :: forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> String -> backend -> [TxId] -> IO ()
singlePartyCommitsFromExternalTxBlueprint Tracer IO EndToEndLog
tracer String
workDir backend
backend [TxId]
hydraScriptsTxId =
(IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` Tracer IO EndToEndLog -> backend -> Actor -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
returnFundsToFaucet Tracer IO EndToEndLog
tracer backend
backend Actor
Alice) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
refuelIfNeeded Tracer IO EndToEndLog
tracer backend
backend Actor
Alice Coin
20_000_000
let contestationPeriod :: ContestationPeriod
contestationPeriod = ContestationPeriod
100
ChainConfig
aliceChainConfig <- Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Alice String
workDir backend
backend [TxId]
hydraScriptsTxId [] ContestationPeriod
contestationPeriod
let hydraNodeId :: Int
hydraNodeId = Int
1
let hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
(VerificationKey PaymentKey
someExternalVk, SigningKey PaymentKey
someExternalSk) <- Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
-> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
forall a. Gen a -> IO a
generate Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
genKeyPair
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 HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
hydraNodeId SigningKey HydraKey
aliceSk [] [Int
1] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Init" []
HeadId
headId <- NominalDiffTime
-> HydraClient -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n1 ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice])
UTxO' (TxOut CtxUTxO Era)
someUTxO <- backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
seedFromFaucet backend
backend VerificationKey PaymentKey
someExternalVk Coin
10_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
UTxO' (TxOut CtxUTxO Era)
utxoToCommit <- backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
seedFromFaucet backend
backend VerificationKey PaymentKey
someExternalVk Coin
5_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
NetworkId
networkId <- backend -> IO NetworkId
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> m NetworkId
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> m NetworkId
Backend.queryNetworkId backend
backend
let someAddress :: AddressInEra Era
someAddress = NetworkId -> VerificationKey PaymentKey -> AddressInEra Era
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
someExternalVk
let someOutput :: TxOut CtxTx Era
someOutput =
AddressInEra Era
-> Value
-> TxOutDatum CtxTx Era
-> ReferenceScript Era
-> TxOut CtxTx Era
forall ctx.
AddressInEra Era
-> Value -> TxOutDatum ctx -> ReferenceScript Era -> TxOut ctx
TxOut
AddressInEra Era
someAddress
(Coin -> Value
lovelaceToValue (Coin -> Value) -> Coin -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2_000_000)
TxOutDatum CtxTx Era
forall ctx. TxOutDatum ctx
TxOutDatumNone
ReferenceScript Era
ReferenceScriptNone
backend
-> AddressInEra Era
-> UTxO' (TxOut CtxUTxO Era)
-> [TxIn]
-> [TxOut CtxTx Era]
-> IO (Either (TxBodyErrorAutoBalance Era) (Tx Era))
forall backend.
ChainBackend backend =>
backend
-> AddressInEra Era
-> UTxO' (TxOut CtxUTxO Era)
-> [TxIn]
-> [TxOut CtxTx Era]
-> IO (Either (TxBodyErrorAutoBalance Era) (Tx Era))
buildTransaction backend
backend AddressInEra Era
someAddress UTxO' (TxOut CtxUTxO Era)
utxoToCommit ((TxIn, TxOut CtxUTxO Era) -> TxIn
forall a b. (a, b) -> a
fst ((TxIn, TxOut CtxUTxO Era) -> TxIn)
-> [(TxIn, TxOut CtxUTxO Era)] -> [TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxO' (TxOut CtxUTxO Era) -> [(TxIn, TxOut CtxUTxO Era)]
forall out. UTxO' out -> [(TxIn, out)]
UTxO.toList UTxO' (TxOut CtxUTxO Era)
someUTxO) [TxOut CtxTx Era
someOutput] IO (Either (TxBodyErrorAutoBalance Era) (Tx Era))
-> (Either (TxBodyErrorAutoBalance Era) (Tx Era) -> 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
>>= \case
Left TxBodyErrorAutoBalance Era
e -> String -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ TxBodyErrorAutoBalance Era -> String
forall b a. (Show a, IsString b) => a -> b
show TxBodyErrorAutoBalance Era
e
Right Tx Era
tx -> do
let unsignedTx :: Tx Era
unsignedTx = [KeyWitness Era] -> TxBody Era -> Tx Era
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [] (TxBody Era -> Tx Era) -> TxBody Era -> Tx Era
forall a b. (a -> b) -> a -> b
$ Tx Era -> TxBody Era
forall era. Tx era -> TxBody era
getTxBody Tx Era
tx
let clientPayload :: Value
clientPayload =
[Pair] -> Value
Aeson.object
[ Key
"blueprintTx" Key -> Tx Era -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tx Era
unsignedTx
, Key
"utxo" Key -> UTxO' (TxOut CtxUTxO Era) -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxO' (TxOut CtxUTxO Era)
utxoToCommit
]
JsonResponse (Tx Era)
res <-
HttpConfig
-> Req (JsonResponse (Tx Era)) -> IO (JsonResponse (Tx Era))
forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
runReq HttpConfig
defaultHttpConfig (Req (JsonResponse (Tx Era)) -> IO (JsonResponse (Tx Era)))
-> Req (JsonResponse (Tx Era)) -> IO (JsonResponse (Tx Era))
forall a b. (a -> b) -> a -> b
$
POST
-> Url 'Http
-> ReqBodyJson Value
-> Proxy (JsonResponse (Tx Era))
-> Option 'Http
-> Req (JsonResponse (Tx Era))
forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
HttpResponse response,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req
POST
POST
(Text -> Url 'Http
http Text
"127.0.0.1" Url 'Http -> Text -> Url 'Http
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"commit")
(Value -> ReqBodyJson Value
forall a. a -> ReqBodyJson a
ReqBodyJson Value
clientPayload)
(Proxy (JsonResponse (Tx Era))
forall {k} (t :: k). Proxy t
Proxy :: Proxy (JsonResponse Tx))
(Int -> Option 'Http
forall (scheme :: Scheme). Int -> Option scheme
port (Int -> Option 'Http) -> Int -> Option 'Http
forall a b. (a -> b) -> a -> b
$ Int
4000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hydraNodeId)
let commitTx :: HttpResponseBody (JsonResponse (Tx Era))
commitTx = JsonResponse (Tx Era) -> HttpResponseBody (JsonResponse (Tx Era))
forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody JsonResponse (Tx Era)
res
let signedTx :: Tx Era
signedTx = SigningKey PaymentKey -> Tx Era -> Tx Era
forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
signTx SigningKey PaymentKey
someExternalSk Tx Era
HttpResponseBody (JsonResponse (Tx Era))
commitTx
backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend Tx Era
signedTx
Maybe Value
lockedUTxO <- NominalDiffTime
-> HydraClient
-> (Value -> Maybe (Maybe Value))
-> IO (Maybe Value)
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n1 ((Value -> Maybe (Maybe Value)) -> IO (Maybe Value))
-> (Value -> Maybe (Maybe Value)) -> IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"headId" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (HeadId -> Value
forall a. ToJSON a => a -> Value
toJSON HeadId
headId)
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"HeadIsOpen"
Maybe Value -> Maybe (Maybe Value)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> Maybe (Maybe Value))
-> Maybe Value -> Maybe (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"utxo"
Maybe Value
lockedUTxO Maybe Value -> Maybe Value -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Value -> Maybe Value
forall a. a -> Maybe a
Just (UTxO' (TxOut CtxUTxO Era) -> Value
forall a. ToJSON a => a -> Value
toJSON UTxO' (TxOut CtxUTxO Era)
utxoToCommit)
canCloseWithLongContestationPeriod ::
ChainBackend backend =>
Tracer IO EndToEndLog ->
FilePath ->
backend ->
[TxId] ->
IO ()
canCloseWithLongContestationPeriod :: forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> String -> backend -> [TxId] -> IO ()
canCloseWithLongContestationPeriod Tracer IO EndToEndLog
tracer String
workDir backend
backend [TxId]
hydraScriptsTxId = do
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
refuelIfNeeded Tracer IO EndToEndLog
tracer backend
backend Actor
Alice Coin
100_000_000
ChainPoint
tip <- 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
let oneWeek :: ContestationPeriod
oneWeek = ContestationPeriod
60 ContestationPeriod -> ContestationPeriod -> ContestationPeriod
forall a. Num a => a -> a -> a
* ContestationPeriod
60 ContestationPeriod -> ContestationPeriod -> ContestationPeriod
forall a. Num a => a -> a -> a
* ContestationPeriod
24 ContestationPeriod -> ContestationPeriod -> ContestationPeriod
forall a. Num a => a -> a -> a
* ContestationPeriod
7
ChainConfig
aliceChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Alice String
workDir backend
backend [TxId]
hydraScriptsTxId [] ContestationPeriod
oneWeek
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (CardanoChainConfig -> CardanoChainConfig)
-> ChainConfig -> ChainConfig
modifyConfig (\CardanoChainConfig
config -> CardanoChainConfig
config{startChainFrom = Just tip})
let hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
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 HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
1 SigningKey HydraKey
aliceSk [] [Int
1] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Init" []
HeadId
headId <- NominalDiffTime
-> HydraClient -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n1 ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice])
HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n1 UTxO' (TxOut CtxUTxO Era)
forall a. Monoid a => a
mempty IO (Tx Era) -> (Tx Era -> 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
>>= backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"HeadIsOpen" [Key
"utxo" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Pair]
forall a. Monoid a => a
mempty, Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId]
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Close" []
IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
NominalDiffTime -> HydraClient -> (Value -> Maybe ()) -> IO ()
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n1 ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"HeadIsClosed"
Actor -> IO ()
traceRemainingFunds Actor
Alice
where
traceRemainingFunds :: Actor -> IO ()
traceRemainingFunds Actor
actor = do
(VerificationKey PaymentKey
actorVk, SigningKey PaymentKey
_) <- Actor -> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
keysFor Actor
actor
UTxO' (TxOut CtxUTxO Era)
utxo <- backend
-> QueryPoint
-> VerificationKey PaymentKey
-> IO (UTxO' (TxOut CtxUTxO Era))
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a
-> QueryPoint
-> VerificationKey PaymentKey
-> m (UTxO' (TxOut CtxUTxO Era))
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend
-> QueryPoint
-> VerificationKey PaymentKey
-> m (UTxO' (TxOut CtxUTxO Era))
Backend.queryUTxOFor backend
backend QueryPoint
QueryTip VerificationKey PaymentKey
actorVk
Tracer IO EndToEndLog -> EndToEndLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO EndToEndLog
tracer RemainingFunds{$sel:actor:ClusterOptions :: String
actor = Actor -> String
actorName Actor
actor, UTxO' (TxOut CtxUTxO Era)
$sel:utxo:ClusterOptions :: UTxO' (TxOut CtxUTxO Era)
utxo :: UTxO' (TxOut CtxUTxO Era)
utxo}
canSubmitTransactionThroughAPI ::
ChainBackend backend =>
Tracer IO EndToEndLog ->
FilePath ->
backend ->
[TxId] ->
IO ()
canSubmitTransactionThroughAPI :: forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> String -> backend -> [TxId] -> IO ()
canSubmitTransactionThroughAPI Tracer IO EndToEndLog
tracer String
workDir backend
backend [TxId]
hydraScriptsTxId =
(IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` Tracer IO EndToEndLog -> backend -> Actor -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
returnFundsToFaucet Tracer IO EndToEndLog
tracer backend
backend Actor
Alice) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
refuelIfNeeded Tracer IO EndToEndLog
tracer backend
backend Actor
Alice Coin
25_000_000
let contestationPeriod :: ContestationPeriod
contestationPeriod = ContestationPeriod
100
ChainConfig
aliceChainConfig <- Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Alice String
workDir backend
backend [TxId]
hydraScriptsTxId [] ContestationPeriod
contestationPeriod
let hydraNodeId :: Int
hydraNodeId = Int
1
let hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
hydraNodeId SigningKey HydraKey
aliceSk [] [Int
hydraNodeId] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
_ -> do
(VerificationKey PaymentKey
cardanoBobVk, SigningKey PaymentKey
cardanoBobSk) <- Actor -> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
keysFor Actor
Bob
(VerificationKey PaymentKey
cardanoCarolVk, SigningKey PaymentKey
_) <- Actor -> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
keysFor Actor
Carol
NetworkId
networkId <- backend -> IO NetworkId
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> m NetworkId
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> m NetworkId
Backend.queryNetworkId backend
backend
UTxO' (TxOut CtxUTxO Era)
bobUTxO <- backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
seedFromFaucet backend
backend VerificationKey PaymentKey
cardanoBobVk Coin
5_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
let carolsAddress :: AddressInEra Era
carolsAddress = NetworkId -> VerificationKey PaymentKey -> AddressInEra Era
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
cardanoCarolVk
bobsAddress :: AddressInEra Era
bobsAddress = NetworkId -> VerificationKey PaymentKey -> AddressInEra Era
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
cardanoBobVk
carolsOutput :: TxOut CtxTx Era
carolsOutput =
AddressInEra Era
-> Value
-> TxOutDatum CtxTx Era
-> ReferenceScript Era
-> TxOut CtxTx Era
forall ctx.
AddressInEra Era
-> Value -> TxOutDatum ctx -> ReferenceScript Era -> TxOut ctx
TxOut
AddressInEra Era
carolsAddress
(Coin -> Value
lovelaceToValue (Coin -> Value) -> Coin -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2_000_000)
TxOutDatum CtxTx Era
forall ctx. TxOutDatum ctx
TxOutDatumNone
ReferenceScript Era
ReferenceScriptNone
backend
-> AddressInEra Era
-> UTxO' (TxOut CtxUTxO Era)
-> [TxIn]
-> [TxOut CtxTx Era]
-> IO (Either (TxBodyErrorAutoBalance Era) (Tx Era))
forall backend.
ChainBackend backend =>
backend
-> AddressInEra Era
-> UTxO' (TxOut CtxUTxO Era)
-> [TxIn]
-> [TxOut CtxTx Era]
-> IO (Either (TxBodyErrorAutoBalance Era) (Tx Era))
buildTransaction backend
backend AddressInEra Era
bobsAddress UTxO' (TxOut CtxUTxO Era)
bobUTxO ((TxIn, TxOut CtxUTxO Era) -> TxIn
forall a b. (a, b) -> a
fst ((TxIn, TxOut CtxUTxO Era) -> TxIn)
-> [(TxIn, TxOut CtxUTxO Era)] -> [TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxO' (TxOut CtxUTxO Era) -> [(TxIn, TxOut CtxUTxO Era)]
forall out. UTxO' out -> [(TxIn, out)]
UTxO.toList UTxO' (TxOut CtxUTxO Era)
bobUTxO) [TxOut CtxTx Era
carolsOutput] IO (Either (TxBodyErrorAutoBalance Era) (Tx Era))
-> (Either (TxBodyErrorAutoBalance Era) (Tx Era) -> 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
>>= \case
Left TxBodyErrorAutoBalance Era
e -> String -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ TxBodyErrorAutoBalance Era -> String
forall b a. (Show a, IsString b) => a -> b
show TxBodyErrorAutoBalance Era
e
Right Tx Era
tx -> do
let unsignedTx :: Tx Era
unsignedTx = [KeyWitness Era] -> TxBody Era -> Tx Era
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [] (TxBody Era -> Tx Era) -> TxBody Era -> Tx Era
forall a b. (a -> b) -> a -> b
$ Tx Era -> TxBody Era
forall era. Tx era -> TxBody era
getTxBody Tx Era
tx
let unsignedRequest :: Value
unsignedRequest = Tx Era -> Value
forall a. ToJSON a => a -> Value
toJSON Tx Era
unsignedTx
Int -> Value -> IO (JsonResponse TransactionSubmitted)
forall {m :: * -> *} {a}.
(MonadIO m, ToJSON a) =>
Int -> a -> m (JsonResponse TransactionSubmitted)
sendRequest Int
hydraNodeId Value
unsignedRequest
IO (JsonResponse TransactionSubmitted)
-> Selector HttpException -> IO ()
forall e a.
(HasCallStack, Exception e) =>
IO a -> Selector e -> IO ()
`shouldThrow` Int -> Maybe ByteString -> Selector HttpException
expectErrorStatus Int
400 (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"MissingVKeyWitnessesUTXOW")
let signedTx :: Tx Era
signedTx = SigningKey PaymentKey -> Tx Era -> Tx Era
forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
signTx SigningKey PaymentKey
cardanoBobSk Tx Era
unsignedTx
let signedRequest :: Value
signedRequest = Tx Era -> Value
forall a. ToJSON a => a -> Value
toJSON Tx Era
signedTx
(Int -> Value -> IO (JsonResponse TransactionSubmitted)
forall {m :: * -> *} {a}.
(MonadIO m, ToJSON a) =>
Int -> a -> m (JsonResponse TransactionSubmitted)
sendRequest Int
hydraNodeId Value
signedRequest IO (JsonResponse TransactionSubmitted)
-> (JsonResponse TransactionSubmitted -> TransactionSubmitted)
-> IO TransactionSubmitted
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> JsonResponse TransactionSubmitted -> TransactionSubmitted
JsonResponse TransactionSubmitted
-> HttpResponseBody (JsonResponse TransactionSubmitted)
forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody)
IO TransactionSubmitted -> TransactionSubmitted -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` TransactionSubmitted
TransactionSubmitted
where
sendRequest :: Int -> a -> m (JsonResponse TransactionSubmitted)
sendRequest Int
hydraNodeId a
tx =
HttpConfig
-> Req (JsonResponse TransactionSubmitted)
-> m (JsonResponse TransactionSubmitted)
forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
runReq HttpConfig
defaultHttpConfig (Req (JsonResponse TransactionSubmitted)
-> m (JsonResponse TransactionSubmitted))
-> Req (JsonResponse TransactionSubmitted)
-> m (JsonResponse TransactionSubmitted)
forall a b. (a -> b) -> a -> b
$
POST
-> Url 'Http
-> ReqBodyJson a
-> Proxy (JsonResponse TransactionSubmitted)
-> Option 'Http
-> Req (JsonResponse TransactionSubmitted)
forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
HttpResponse response,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req
POST
POST
(Text -> Url 'Http
http Text
"127.0.0.1" Url 'Http -> Text -> Url 'Http
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"cardano-transaction")
(a -> ReqBodyJson a
forall a. a -> ReqBodyJson a
ReqBodyJson a
tx)
(Proxy (JsonResponse TransactionSubmitted)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (JsonResponse TransactionSubmitted))
(Int -> Option 'Http
forall (scheme :: Scheme). Int -> Option scheme
port (Int -> Option 'Http) -> Int -> Option 'Http
forall a b. (a -> b) -> a -> b
$ Int
4000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hydraNodeId)
threeNodesNoErrorsOnOpen :: ChainBackend backend => Tracer IO EndToEndLog -> FilePath -> backend -> [TxId] -> IO ()
threeNodesNoErrorsOnOpen :: forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> String -> backend -> [TxId] -> IO ()
threeNodesNoErrorsOnOpen Tracer IO EndToEndLog
tracer String
tmpDir backend
backend [TxId]
hydraScriptsTxId = do
aliceKeys :: (VerificationKey PaymentKey, SigningKey PaymentKey)
aliceKeys@(VerificationKey PaymentKey
aliceCardanoVk, SigningKey PaymentKey
_) <- Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
-> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
forall a. Gen a -> IO a
generate Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
genKeyPair
bobKeys :: (VerificationKey PaymentKey, SigningKey PaymentKey)
bobKeys@(VerificationKey PaymentKey
bobCardanoVk, SigningKey PaymentKey
_) <- Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
-> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
forall a. Gen a -> IO a
generate Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
genKeyPair
carolKeys :: (VerificationKey PaymentKey, SigningKey PaymentKey)
carolKeys@(VerificationKey PaymentKey
carolCardanoVk, SigningKey PaymentKey
_) <- Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
-> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
forall a. Gen a -> IO a
generate Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
genKeyPair
let cardanoKeys :: [(VerificationKey PaymentKey, SigningKey PaymentKey)]
cardanoKeys = [(VerificationKey PaymentKey, SigningKey PaymentKey)
aliceKeys, (VerificationKey PaymentKey, SigningKey PaymentKey)
bobKeys, (VerificationKey PaymentKey, SigningKey PaymentKey)
carolKeys]
hydraKeys :: [SigningKey HydraKey]
hydraKeys = [SigningKey HydraKey
aliceSk, SigningKey HydraKey
bobSk, SigningKey HydraKey
carolSk]
let contestationPeriod :: ContestationPeriod
contestationPeriod = ContestationPeriod
2
let hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
let nodeSocket' :: SocketPath
nodeSocket' =
case backend -> ChainBackendOptions
forall a. ChainBackend a => a -> ChainBackendOptions
Backend.getOptions backend
backend of
Direct DirectOptions{SocketPath
nodeSocket :: SocketPath
$sel:nodeSocket:DirectOptions :: DirectOptions -> SocketPath
nodeSocket} -> SocketPath
nodeSocket
Blockfrost BlockfrostOptions
_ -> Text -> SocketPath
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Unexpected Blockfrost options"
Tracer IO HydraNodeLog
-> String
-> SocketPath
-> Int
-> [(VerificationKey PaymentKey, SigningKey PaymentKey)]
-> [SigningKey HydraKey]
-> [TxId]
-> ContestationPeriod
-> (NonEmpty HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> String
-> SocketPath
-> Int
-> [(VerificationKey PaymentKey, SigningKey PaymentKey)]
-> [SigningKey HydraKey]
-> [TxId]
-> ContestationPeriod
-> (NonEmpty HydraClient -> IO a)
-> IO a
withHydraCluster Tracer IO HydraNodeLog
hydraTracer String
tmpDir SocketPath
nodeSocket' Int
1 [(VerificationKey PaymentKey, SigningKey PaymentKey)]
cardanoKeys [SigningKey HydraKey]
hydraKeys [TxId]
hydraScriptsTxId ContestationPeriod
contestationPeriod ((NonEmpty HydraClient -> IO ()) -> IO ())
-> (NonEmpty HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \NonEmpty HydraClient
clients -> do
let leader :: HydraClient
leader = NonEmpty HydraClient -> HydraClient
forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head NonEmpty HydraClient
clients
Tracer IO HydraNodeLog
-> NominalDiffTime -> NonEmpty HydraClient -> IO ()
waitForNodesConnected Tracer IO HydraNodeLog
hydraTracer NominalDiffTime
20 NonEmpty HydraClient
clients
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
seedFromFaucet_ backend
backend VerificationKey PaymentKey
aliceCardanoVk Coin
100_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
seedFromFaucet_ backend
backend VerificationKey PaymentKey
bobCardanoVk Coin
100_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
seedFromFaucet_ backend
backend VerificationKey PaymentKey
carolCardanoVk Coin
100_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
HydraClient -> Value -> IO ()
send HydraClient
leader (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Init" []
IO HeadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO HeadId -> IO ())
-> ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime
-> [HydraClient] -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch NominalDiffTime
10 (NonEmpty HydraClient -> [HydraClient]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty HydraClient
clients) ((Value -> Maybe HeadId) -> IO ())
-> (Value -> Maybe HeadId) -> IO ()
forall a b. (a -> b) -> a -> b
$
Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice, Party
bob, Party
carol])
(HydraClient -> IO ()) -> NonEmpty HydraClient -> IO ()
forall (f :: * -> *) a b. Foldable f => (a -> IO b) -> f a -> IO ()
mapConcurrently_ (\HydraClient
n -> HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n UTxO' (TxOut CtxUTxO Era)
forall a. Monoid a => a
mempty IO (Tx Era) -> (Tx Era -> 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
>>= backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend) NonEmpty HydraClient
clients
(HydraClient -> IO ()) -> NonEmpty HydraClient -> IO ()
forall (f :: * -> *) a b. Foldable f => (a -> IO b) -> f a -> IO ()
mapConcurrently_ HydraClient -> IO ()
shouldNotReceivePostTxError NonEmpty HydraClient
clients
where
shouldNotReceivePostTxError :: HydraClient -> IO ()
shouldNotReceivePostTxError client :: HydraClient
client@HydraClient{Int
$sel:hydraNodeId:HydraClient :: HydraClient -> Int
hydraNodeId :: Int
hydraNodeId} = do
Either (Maybe Value) ()
err <- NominalDiffTime
-> HydraClient
-> (Value -> Maybe (Either (Maybe Value) ()))
-> IO (Either (Maybe Value) ())
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch NominalDiffTime
10 HydraClient
client ((Value -> Maybe (Either (Maybe Value) ()))
-> IO (Either (Maybe Value) ()))
-> (Value -> Maybe (Either (Maybe Value) ()))
-> IO (Either (Maybe Value) ())
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
case Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" of
Just Value
"PostTxOnChainFailed" -> Either (Maybe Value) () -> Maybe (Either (Maybe Value) ())
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Maybe Value) () -> Maybe (Either (Maybe Value) ()))
-> Either (Maybe Value) () -> Maybe (Either (Maybe Value) ())
forall a b. (a -> b) -> a -> b
$ Maybe Value -> Either (Maybe Value) ()
forall a b. a -> Either a b
Left (Maybe Value -> Either (Maybe Value) ())
-> Maybe Value -> Either (Maybe Value) ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"postTxError"
Just Value
"HeadIsOpen" -> Either (Maybe Value) () -> Maybe (Either (Maybe Value) ())
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Maybe Value) () -> Maybe (Either (Maybe Value) ()))
-> Either (Maybe Value) () -> Maybe (Either (Maybe Value) ())
forall a b. (a -> b) -> a -> b
$ () -> Either (Maybe Value) ()
forall a b. b -> Either a b
Right ()
Maybe Value
_ -> Maybe (Either (Maybe Value) ())
forall a. Maybe a
Nothing
case Either (Maybe Value) ()
err of
Left Maybe Value
receivedError ->
String -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"node " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall b a. (Show a, IsString b) => a -> b
show Int
hydraNodeId String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" should not receive error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Maybe Value -> String
forall b a. (Show a, IsString b) => a -> b
show Maybe Value
receivedError
Right ()
_headIsOpen ->
() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
nodeCanSupportMultipleEtcdClusters :: ChainBackend backend => Tracer IO EndToEndLog -> FilePath -> backend -> [TxId] -> IO ()
nodeCanSupportMultipleEtcdClusters :: forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> String -> backend -> [TxId] -> IO ()
nodeCanSupportMultipleEtcdClusters Tracer IO EndToEndLog
tracer String
workDir backend
backend [TxId]
hydraScriptsTxId = do
let contestationPeriod :: ContestationPeriod
contestationPeriod = ContestationPeriod
2
NetworkId
networkId <- backend -> IO NetworkId
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> m NetworkId
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> m NetworkId
Backend.queryNetworkId backend
backend
ChainConfig
aliceChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Alice String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Bob, Actor
Carol] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId
ChainConfig
bobChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Bob String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Alice, Actor
Carol] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId
ChainConfig
carolChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Carol String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Alice, Actor
Bob] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId
let hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
1 SigningKey HydraKey
aliceSk [VerificationKey HydraKey
bobVk, VerificationKey HydraKey
carolVk] [Int
1, Int
2, Int
3] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
bobChainConfig String
workDir Int
2 SigningKey HydraKey
bobSk [VerificationKey HydraKey
aliceVk, VerificationKey HydraKey
carolVk] [Int
1, Int
2, Int
3] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n2 -> do
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
carolChainConfig String
workDir Int
3 SigningKey HydraKey
carolSk [VerificationKey HydraKey
aliceVk, VerificationKey HydraKey
bobVk] [Int
1, Int
2, Int
3] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n3 -> do
Tracer IO HydraNodeLog
-> NominalDiffTime -> NonEmpty HydraClient -> IO ()
waitForNodesConnected Tracer IO HydraNodeLog
hydraTracer NominalDiffTime
30 (NonEmpty HydraClient -> IO ()) -> NonEmpty HydraClient -> IO ()
forall a b. (a -> b) -> a -> b
$ HydraClient
n1 HydraClient -> [HydraClient] -> NonEmpty HydraClient
forall a. a -> [a] -> NonEmpty a
:| [HydraClient
n2, HydraClient
n3]
ChainConfig
bobChainConfig' <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Bob String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Carol] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId
ChainConfig
carolChainConfig' <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Carol String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Bob] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId
Tracer IO HydraNodeLog
-> NominalDiffTime -> NonEmpty HydraClient -> IO ()
waitForNodesDisconnected Tracer IO HydraNodeLog
hydraTracer NominalDiffTime
60 (NonEmpty HydraClient -> IO ()) -> NonEmpty HydraClient -> IO ()
forall a b. (a -> b) -> a -> b
$ HydraClient
n1 HydraClient -> [HydraClient] -> NonEmpty HydraClient
forall a. a -> [a] -> NonEmpty a
:| []
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
bobChainConfig' String
workDir Int
2 SigningKey HydraKey
bobSk [VerificationKey HydraKey
carolVk] [Int
2, Int
3] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n2 -> do
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
carolChainConfig' String
workDir Int
3 SigningKey HydraKey
carolSk [VerificationKey HydraKey
bobVk] [Int
2, Int
3] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n3 -> do
Tracer IO HydraNodeLog
-> NominalDiffTime -> NonEmpty HydraClient -> IO ()
waitForNodesConnected Tracer IO HydraNodeLog
hydraTracer NominalDiffTime
30 (NonEmpty HydraClient -> IO ()) -> NonEmpty HydraClient -> IO ()
forall a b. (a -> b) -> a -> b
$ HydraClient
n2 HydraClient -> [HydraClient] -> NonEmpty HydraClient
forall a. a -> [a] -> NonEmpty a
:| [HydraClient
n3]
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
bobChainConfig String
workDir Int
2 SigningKey HydraKey
bobSk [VerificationKey HydraKey
aliceVk, VerificationKey HydraKey
carolVk] [Int
1, Int
2, Int
3] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n2 -> do
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
carolChainConfig String
workDir Int
3 SigningKey HydraKey
carolSk [VerificationKey HydraKey
aliceVk, VerificationKey HydraKey
bobVk] [Int
1, Int
2, Int
3] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n3 -> do
Tracer IO HydraNodeLog
-> NominalDiffTime -> NonEmpty HydraClient -> IO ()
waitForNodesConnected Tracer IO HydraNodeLog
hydraTracer NominalDiffTime
30 (NonEmpty HydraClient -> IO ()) -> NonEmpty HydraClient -> IO ()
forall a b. (a -> b) -> a -> b
$ HydraClient
n1 HydraClient -> [HydraClient] -> NonEmpty HydraClient
forall a. a -> [a] -> NonEmpty a
:| [HydraClient
n2, HydraClient
n3]
initWithWrongKeys :: ChainBackend backend => FilePath -> Tracer IO EndToEndLog -> backend -> [TxId] -> IO ()
initWithWrongKeys :: forall backend.
ChainBackend backend =>
String -> Tracer IO EndToEndLog -> backend -> [TxId] -> IO ()
initWithWrongKeys String
workDir Tracer IO EndToEndLog
tracer backend
backend [TxId]
hydraScriptsTxId = do
(VerificationKey PaymentKey
aliceCardanoVk, SigningKey PaymentKey
_) <- Actor -> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
keysFor Actor
Alice
(VerificationKey PaymentKey
carolCardanoVk, SigningKey PaymentKey
_) <- Actor -> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
keysFor Actor
Carol
let contestationPeriod :: ContestationPeriod
contestationPeriod = ContestationPeriod
2
ChainConfig
aliceChainConfig <- Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Alice String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Carol] ContestationPeriod
contestationPeriod
ChainConfig
bobChainConfig <- Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Bob String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Alice] ContestationPeriod
contestationPeriod
let hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
3 SigningKey HydraKey
aliceSk [VerificationKey HydraKey
bobVk] [Int
3, Int
4] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
bobChainConfig String
workDir Int
4 SigningKey HydraKey
bobSk [VerificationKey HydraKey
aliceVk] [Int
3, Int
4] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n2 -> do
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
seedFromFaucet_ backend
backend VerificationKey PaymentKey
aliceCardanoVk Coin
100_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Init" []
HeadId
headId <-
NominalDiffTime
-> [HydraClient] -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch NominalDiffTime
10 [HydraClient
n1] ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$
Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice, Party
bob])
let expectedParticipants :: [OnChainId]
expectedParticipants =
VerificationKey PaymentKey -> OnChainId
verificationKeyToOnChainId
(VerificationKey PaymentKey -> OnChainId)
-> [VerificationKey PaymentKey] -> [OnChainId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VerificationKey PaymentKey
aliceCardanoVk, VerificationKey PaymentKey
carolCardanoVk]
[OnChainId]
participants <- NominalDiffTime
-> HydraClient -> (Value -> Maybe [OnChainId]) -> IO [OnChainId]
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch NominalDiffTime
10 HydraClient
n2 ((Value -> Maybe [OnChainId]) -> IO [OnChainId])
-> (Value -> Maybe [OnChainId]) -> IO [OnChainId]
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (Text -> Value
Aeson.String Text
"IgnoredHeadInitializing")
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"headId" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (HeadId -> Value
forall a. ToJSON a => a -> Value
toJSON HeadId
headId)
Value
v Value
-> Getting (First [OnChainId]) Value [OnChainId]
-> Maybe [OnChainId]
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"participants" ((Value -> Const (First [OnChainId]) Value)
-> Value -> Const (First [OnChainId]) Value)
-> Getting (First [OnChainId]) Value [OnChainId]
-> Getting (First [OnChainId]) Value [OnChainId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First [OnChainId]) Value [OnChainId]
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
forall a b. (FromJSON a, ToJSON b) => Prism Value Value a b
Prism Value Value [OnChainId] [OnChainId]
_JSON
[OnChainId]
participants [OnChainId] -> [OnChainId] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldMatchList` [OnChainId]
expectedParticipants
startWithWrongPeers :: ChainBackend backend => FilePath -> Tracer IO EndToEndLog -> backend -> [TxId] -> IO ()
startWithWrongPeers :: forall backend.
ChainBackend backend =>
String -> Tracer IO EndToEndLog -> backend -> [TxId] -> IO ()
startWithWrongPeers String
workDir Tracer IO EndToEndLog
tracer backend
backend [TxId]
hydraScriptsTxId = do
(VerificationKey PaymentKey
aliceCardanoVk, SigningKey PaymentKey
_) <- Actor -> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
keysFor Actor
Alice
let contestationPeriod :: ContestationPeriod
contestationPeriod = ContestationPeriod
2
ChainConfig
aliceChainConfig <- Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Alice String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Carol] ContestationPeriod
contestationPeriod
ChainConfig
bobChainConfig <- Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Bob String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Alice] ContestationPeriod
contestationPeriod
let hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
3 SigningKey HydraKey
aliceSk [VerificationKey HydraKey
bobVk] [Int
3, Int
4] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
bobChainConfig String
workDir Int
4 SigningKey HydraKey
bobSk [VerificationKey HydraKey
aliceVk] [Int
4] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
_ -> do
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
seedFromFaucet_ backend
backend VerificationKey PaymentKey
aliceCardanoVk Coin
100_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
(Text
clusterPeers, Text
configuredPeers) <- NominalDiffTime
-> HydraClient -> (Value -> Maybe (Text, Text)) -> IO (Text, Text)
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch NominalDiffTime
20 HydraClient
n1 ((Value -> Maybe (Text, Text)) -> IO (Text, Text))
-> (Value -> Maybe (Text, Text)) -> IO (Text, Text)
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (Text -> Value
Aeson.String Text
"NetworkClusterIDMismatch")
Text
clusterPeers <- Value
v Value
-> ((Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value)
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"clusterPeers" ((Value -> Const (First Text) Value)
-> Value -> Const (First Text) Value)
-> ((Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value)
-> (Text -> Const (First Text) Text)
-> Value
-> Const (First Text) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value
forall t. AsValue t => Prism' t Text
Prism' Value Text
_String
Text
configuredPeers <- Value
v Value
-> ((Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value)
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"misconfiguredPeers" ((Value -> Const (First Text) Value)
-> Value -> Const (First Text) Value)
-> ((Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value)
-> (Text -> Const (First Text) Text)
-> Value
-> Const (First Text) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value
forall t. AsValue t => Prism' t Text
Prism' Value Text
_String
(Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
clusterPeers, Text
configuredPeers)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
clusterPeers Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
configuredPeers) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure String
"Expected clusterPeers and configuredPeers to be different"
Text
clusterPeers Text -> Text -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Text
"0.0.0.0:5003=http://0.0.0.0:5003,0.0.0.0:5004=http://0.0.0.0:5004"
Text
configuredPeers Text -> Text -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Text
"0.0.0.0:5004=http://0.0.0.0:5004"
canCommit :: ChainBackend backend => Tracer IO EndToEndLog -> FilePath -> NominalDiffTime -> backend -> [TxId] -> IO ()
canCommit :: forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog
-> String -> NominalDiffTime -> backend -> [TxId] -> IO ()
canCommit Tracer IO EndToEndLog
tracer String
workDir NominalDiffTime
blockTime backend
backend [TxId]
hydraScriptsTxId =
(IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` Tracer IO EndToEndLog -> backend -> Actor -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
returnFundsToFaucet Tracer IO EndToEndLog
tracer backend
backend Actor
Alice) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
(IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` Tracer IO EndToEndLog -> backend -> Actor -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
returnFundsToFaucet Tracer IO EndToEndLog
tracer backend
backend Actor
Bob) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
refuelIfNeeded Tracer IO EndToEndLog
tracer backend
backend Actor
Alice Coin
30_000_000
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
refuelIfNeeded Tracer IO EndToEndLog
tracer backend
backend Actor
Bob Coin
30_000_000
let contestationPeriod :: 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
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime
depositPeriod :: DepositPeriod
depositPeriod = NominalDiffTime -> DepositPeriod
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (NominalDiffTime -> DepositPeriod)
-> NominalDiffTime -> DepositPeriod
forall a b. (a -> b) -> a -> b
$ NominalDiffTime
100 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime
NetworkId
networkId <- backend -> IO NetworkId
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> m NetworkId
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> m NetworkId
Backend.queryNetworkId backend
backend
ChainConfig
aliceChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Alice String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Bob] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId (ChainConfig -> ChainConfig)
-> (ChainConfig -> ChainConfig) -> ChainConfig -> ChainConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoChainConfig -> CardanoChainConfig)
-> ChainConfig -> ChainConfig
modifyConfig (\CardanoChainConfig
c -> CardanoChainConfig
c{depositPeriod})
ChainConfig
bobChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Bob String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Alice] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId (ChainConfig -> ChainConfig)
-> (ChainConfig -> ChainConfig) -> ChainConfig -> ChainConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoChainConfig -> CardanoChainConfig)
-> ChainConfig -> ChainConfig
modifyConfig (\CardanoChainConfig
c -> CardanoChainConfig
c{depositPeriod})
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
1 SigningKey HydraKey
aliceSk [VerificationKey HydraKey
bobVk] [Int
2] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
bobChainConfig String
workDir Int
2 SigningKey HydraKey
bobSk [VerificationKey HydraKey
aliceVk] [Int
1] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n2 -> do
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Init" []
HeadId
headId <- NominalDiffTime
-> HydraClient -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n2 ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice, Party
bob])
HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n1 UTxO' (TxOut CtxUTxO Era)
forall a. Monoid a => a
mempty IO (Tx Era) -> (Tx Era -> 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
>>= backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend
HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n2 UTxO' (TxOut CtxUTxO Era)
forall a. Monoid a => a
mempty IO (Tx Era) -> (Tx Era -> 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
>>= backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
20 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1, HydraClient
n2] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"HeadIsOpen" [Key
"utxo" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Pair]
forall a. Monoid a => a
mempty, Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId]
(VerificationKey PaymentKey
walletVk, SigningKey PaymentKey
walletSk) <- Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
-> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
forall a. Gen a -> IO a
generate Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
genKeyPair
UTxO' (TxOut CtxUTxO Era)
commitUTxO <- backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
seedFromFaucet backend
backend VerificationKey PaymentKey
walletVk Coin
5_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
UTxO' (TxOut CtxUTxO Era)
commitUTxO2 <- backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
seedFromFaucet backend
backend VerificationKey PaymentKey
walletVk Coin
5_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
Response (Tx Era)
resp <-
String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow (String
"POST " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> HydraClient -> String
forall {a}. (Semigroup a, IsString a) => HydraClient -> a
hydraNodeBaseUrl HydraClient
n2 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/commit")
IO Request -> (Request -> Request) -> IO Request
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> UTxO' (TxOut CtxUTxO Era) -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
setRequestBodyJSON UTxO' (TxOut CtxUTxO Era)
commitUTxO
IO Request
-> (Request -> IO (Response (Tx Era))) -> IO (Response (Tx Era))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Request -> IO (Response (Tx Era))
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response a)
httpJSON
let depositTransaction :: Tx Era
depositTransaction = Response (Tx Era) -> Tx Era
forall a. Response a -> a
getResponseBody Response (Tx Era)
resp :: Tx
let tx :: Tx Era
tx = SigningKey PaymentKey -> Tx Era -> Tx Era
forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
signTx SigningKey PaymentKey
walletSk Tx Era
depositTransaction
backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend Tx Era
tx
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
2 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* DepositPeriod -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac DepositPeriod
depositPeriod) [HydraClient
n1, HydraClient
n2] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"CommitApproved" [Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId, Key
"utxoToCommit" Key -> UTxO' (TxOut CtxUTxO Era) -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxO' (TxOut CtxUTxO Era)
commitUTxO]
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
20 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1, HydraClient
n2] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"CommitFinalized" [Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId, Key
"depositTxId" Key -> TxId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TxBody Era -> TxId
forall era. TxBody era -> TxId
getTxId (Tx Era -> TxBody Era
forall era. Tx era -> TxBody era
getTxBody Tx Era
tx)]
HydraClient -> IO (UTxO' (TxOut CtxUTxO Era))
getSnapshotUTxO HydraClient
n1 IO (UTxO' (TxOut CtxUTxO Era))
-> UTxO' (TxOut CtxUTxO Era) -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` UTxO' (TxOut CtxUTxO Era)
commitUTxO
Response (Tx Era)
resp2 <-
String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow (String
"POST " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> HydraClient -> String
forall {a}. (Semigroup a, IsString a) => HydraClient -> a
hydraNodeBaseUrl HydraClient
n1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/commit")
IO Request -> (Request -> Request) -> IO Request
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> UTxO' (TxOut CtxUTxO Era) -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
setRequestBodyJSON UTxO' (TxOut CtxUTxO Era)
commitUTxO2
IO Request
-> (Request -> IO (Response (Tx Era))) -> IO (Response (Tx Era))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Request -> IO (Response (Tx Era))
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response a)
httpJSON
let depositTransaction' :: Tx Era
depositTransaction' = Response (Tx Era) -> Tx Era
forall a. Response a -> a
getResponseBody Response (Tx Era)
resp2 :: Tx
let tx' :: Tx Era
tx' = SigningKey PaymentKey -> Tx Era -> Tx Era
forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
signTx SigningKey PaymentKey
walletSk Tx Era
depositTransaction'
backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend Tx Era
tx'
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
2 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* DepositPeriod -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac DepositPeriod
depositPeriod) [HydraClient
n1, HydraClient
n2] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"CommitApproved" [Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId, Key
"utxoToCommit" Key -> UTxO' (TxOut CtxUTxO Era) -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxO' (TxOut CtxUTxO Era)
commitUTxO2]
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
20 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1, HydraClient
n2] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"CommitFinalized" [Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId, Key
"depositTxId" Key -> TxId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TxBody Era -> TxId
forall era. TxBody era -> TxId
getTxId (Tx Era -> TxBody Era
forall era. Tx era -> TxBody era
getTxBody Tx Era
tx')]
HydraClient -> IO (UTxO' (TxOut CtxUTxO Era))
getSnapshotUTxO HydraClient
n1 IO (UTxO' (TxOut CtxUTxO Era))
-> UTxO' (TxOut CtxUTxO Era) -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` UTxO' (TxOut CtxUTxO Era)
commitUTxO UTxO' (TxOut CtxUTxO Era)
-> UTxO' (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era)
forall a. Semigroup a => a -> a -> a
<> UTxO' (TxOut CtxUTxO Era)
commitUTxO2
HydraClient -> Value -> IO ()
send HydraClient
n2 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Close" []
UTCTime
deadline <- NominalDiffTime
-> HydraClient -> (Value -> Maybe UTCTime) -> IO UTCTime
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n2 ((Value -> Maybe UTCTime) -> IO UTCTime)
-> (Value -> Maybe UTCTime) -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"HeadIsClosed"
Value
v Value -> Getting (First UTCTime) Value UTCTime -> Maybe UTCTime
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"contestationDeadline" ((Value -> Const (First UTCTime) Value)
-> Value -> Const (First UTCTime) Value)
-> Getting (First UTCTime) Value UTCTime
-> Getting (First UTCTime) Value UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First UTCTime) Value UTCTime
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
forall a b. (FromJSON a, ToJSON b) => Prism Value Value a b
Prism Value Value UTCTime UTCTime
_JSON
NominalDiffTime
remainingTime <- UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
deadline (UTCTime -> NominalDiffTime) -> IO UTCTime -> IO NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
remainingTime NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime
3 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1, HydraClient
n2] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"ReadyToFanout" [Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId]
HydraClient -> Value -> IO ()
send HydraClient
n2 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Fanout" []
NominalDiffTime -> HydraClient -> (Value -> Maybe ()) -> IO ()
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n2 ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v ->
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"HeadIsFinalized"
(UTxO' (TxOut CtxUTxO Era) -> Value
UTxOType (Tx Era) -> ValueType (Tx Era)
forall tx. IsTx tx => UTxOType tx -> ValueType tx
balance (UTxO' (TxOut CtxUTxO Era) -> Value)
-> IO (UTxO' (TxOut CtxUTxO Era)) -> IO Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> backend
-> QueryPoint
-> VerificationKey PaymentKey
-> IO (UTxO' (TxOut CtxUTxO Era))
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a
-> QueryPoint
-> VerificationKey PaymentKey
-> m (UTxO' (TxOut CtxUTxO Era))
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend
-> QueryPoint
-> VerificationKey PaymentKey
-> m (UTxO' (TxOut CtxUTxO Era))
Backend.queryUTxOFor backend
backend QueryPoint
QueryTip VerificationKey PaymentKey
walletVk)
IO Value -> Value -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` UTxOType (Tx Era) -> ValueType (Tx Era)
forall tx. IsTx tx => UTxOType tx -> ValueType tx
balance (UTxO' (TxOut CtxUTxO Era)
commitUTxO UTxO' (TxOut CtxUTxO Era)
-> UTxO' (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era)
forall a. Semigroup a => a -> a -> a
<> UTxO' (TxOut CtxUTxO Era)
commitUTxO2)
where
hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
hydraNodeBaseUrl :: HydraClient -> a
hydraNodeBaseUrl HydraClient{Int
$sel:hydraNodeId:HydraClient :: HydraClient -> Int
hydraNodeId :: Int
hydraNodeId} = a
"http://127.0.0.1:" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Int -> a
forall b a. (Show a, IsString b) => a -> b
show (Int
4000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hydraNodeId)
canRecoverDeposit :: ChainBackend backend => Tracer IO EndToEndLog -> FilePath -> backend -> [TxId] -> IO ()
canRecoverDeposit :: forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> String -> backend -> [TxId] -> IO ()
canRecoverDeposit Tracer IO EndToEndLog
tracer String
workDir backend
backend [TxId]
hydraScriptsTxId =
(IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` Tracer IO EndToEndLog -> backend -> Actor -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
returnFundsToFaucet Tracer IO EndToEndLog
tracer backend
backend Actor
Alice) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
(IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` Tracer IO EndToEndLog -> backend -> Actor -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
returnFundsToFaucet Tracer IO EndToEndLog
tracer backend
backend Actor
Bob) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
refuelIfNeeded Tracer IO EndToEndLog
tracer backend
backend Actor
Alice Coin
30_000_000
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
refuelIfNeeded Tracer IO EndToEndLog
tracer backend
backend Actor
Bob Coin
30_000_000
ContestationPeriod
contestationPeriod <- NominalDiffTime -> IO ContestationPeriod
forall (m :: * -> *).
MonadFail m =>
NominalDiffTime -> m ContestationPeriod
CP.fromNominalDiffTime NominalDiffTime
1
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
let depositPeriod :: DepositPeriod
depositPeriod = DepositPeriod
1
NetworkId
networkId <- backend -> IO NetworkId
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> m NetworkId
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> m NetworkId
Backend.queryNetworkId backend
backend
ChainConfig
aliceChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Alice String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Bob] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId (ChainConfig -> ChainConfig)
-> (ChainConfig -> ChainConfig) -> ChainConfig -> ChainConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoChainConfig -> CardanoChainConfig)
-> ChainConfig -> ChainConfig
modifyConfig (\CardanoChainConfig
c -> CardanoChainConfig
c{depositPeriod})
ChainConfig
bobChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Bob String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Alice] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId (ChainConfig -> ChainConfig)
-> (ChainConfig -> ChainConfig) -> ChainConfig -> ChainConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoChainConfig -> CardanoChainConfig)
-> ChainConfig -> ChainConfig
modifyConfig (\CardanoChainConfig
c -> CardanoChainConfig
c{depositPeriod})
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
1 SigningKey HydraKey
aliceSk [VerificationKey HydraKey
bobVk] [Int
2] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
HeadId
headId <- Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO HeadId)
-> IO HeadId
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
bobChainConfig String
workDir Int
2 SigningKey HydraKey
bobSk [VerificationKey HydraKey
aliceVk] [Int
1] ((HydraClient -> IO HeadId) -> IO HeadId)
-> (HydraClient -> IO HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ \HydraClient
n2 -> do
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Init" []
HeadId
headId <- NominalDiffTime
-> HydraClient -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch NominalDiffTime
10 HydraClient
n1 ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice, Party
bob])
HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n1 UTxO' (TxOut CtxUTxO Era)
forall a. Monoid a => a
mempty IO (Tx Era) -> (Tx Era -> 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
>>= backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend
HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n2 UTxO' (TxOut CtxUTxO Era)
forall a. Monoid a => a
mempty IO (Tx Era) -> (Tx Era -> 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
>>= backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
20 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1, HydraClient
n2] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"HeadIsOpen" [Key
"utxo" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Pair]
forall a. Monoid a => a
mempty, Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId]
HeadId -> IO HeadId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HeadId
headId
(VerificationKey PaymentKey
walletVk, SigningKey PaymentKey
walletSk) <- Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
-> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
forall a. Gen a -> IO a
generate Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
genKeyPair
let commitAmount :: Coin
commitAmount = Coin
5_000_000
UTxO' (TxOut CtxUTxO Era)
commitUTxO <- backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
seedFromFaucet backend
backend VerificationKey PaymentKey
walletVk Coin
commitAmount ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
(UTxO' (TxOut CtxUTxO Era) -> Value
UTxOType (Tx Era) -> ValueType (Tx Era)
forall tx. IsTx tx => UTxOType tx -> ValueType tx
balance (UTxO' (TxOut CtxUTxO Era) -> Value)
-> IO (UTxO' (TxOut CtxUTxO Era)) -> IO Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> backend
-> QueryPoint
-> VerificationKey PaymentKey
-> IO (UTxO' (TxOut CtxUTxO Era))
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a
-> QueryPoint
-> VerificationKey PaymentKey
-> m (UTxO' (TxOut CtxUTxO Era))
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend
-> QueryPoint
-> VerificationKey PaymentKey
-> m (UTxO' (TxOut CtxUTxO Era))
Backend.queryUTxOFor backend
backend QueryPoint
QueryTip VerificationKey PaymentKey
walletVk)
IO Value -> Value -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` Coin -> Value
lovelaceToValue Coin
commitAmount
Tx Era
depositTransaction <-
String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow (String
"POST " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> HydraClient -> String
forall {a}. (Semigroup a, IsString a) => HydraClient -> a
hydraNodeBaseUrl HydraClient
n1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/commit")
IO Request -> (Request -> Request) -> IO Request
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> UTxO' (TxOut CtxUTxO Era) -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
setRequestBodyJSON UTxO' (TxOut CtxUTxO Era)
commitUTxO
IO Request
-> (Request -> IO (Response (Tx Era))) -> IO (Response (Tx Era))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Request -> IO (Response (Tx Era))
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response a)
httpJSON
IO (Response (Tx Era))
-> (Response (Tx Era) -> Tx Era) -> IO (Tx Era)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Response (Tx Era) -> Tx Era
forall a. Response a -> a
getResponseBody
let tx :: Tx Era
tx = SigningKey PaymentKey -> Tx Era -> Tx Era
forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
signTx SigningKey PaymentKey
walletSk Tx Era
depositTransaction
backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend Tx Era
tx
UTCTime
deadline <- NominalDiffTime
-> [HydraClient] -> (Value -> Maybe UTCTime) -> IO UTCTime
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch NominalDiffTime
10 [HydraClient
n1] ((Value -> Maybe UTCTime) -> IO UTCTime)
-> (Value -> Maybe UTCTime) -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"CommitRecorded"
Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"deadline" Maybe Value -> (Value -> Maybe UTCTime) -> Maybe UTCTime
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser UTCTime) -> Value -> Maybe UTCTime
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe Value -> Parser UTCTime
forall a. FromJSON a => Value -> Parser a
parseJSON
(Value -> Coin
selectLovelace (Value -> Coin)
-> (UTxO' (TxOut CtxUTxO Era) -> Value)
-> UTxO' (TxOut CtxUTxO Era)
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO' (TxOut CtxUTxO Era) -> Value
UTxOType (Tx Era) -> ValueType (Tx Era)
forall tx. IsTx tx => UTxOType tx -> ValueType tx
balance (UTxO' (TxOut CtxUTxO Era) -> Coin)
-> IO (UTxO' (TxOut CtxUTxO Era)) -> IO Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> backend
-> QueryPoint
-> VerificationKey PaymentKey
-> IO (UTxO' (TxOut CtxUTxO Era))
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a
-> QueryPoint
-> VerificationKey PaymentKey
-> m (UTxO' (TxOut CtxUTxO Era))
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend
-> QueryPoint
-> VerificationKey PaymentKey
-> m (UTxO' (TxOut CtxUTxO Era))
Backend.queryUTxOFor backend
backend QueryPoint
QueryTip VerificationKey PaymentKey
walletVk)
IO Coin -> Coin -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` Coin
0
let path :: String
path = ByteString -> String
BSC.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Bool -> ByteString -> ByteString
urlEncode Bool
False (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TxId -> String
forall b a. (Show a, IsString b) => a -> b
show (TxBody Era -> TxId
forall era. TxBody era -> TxId
getTxId (TxBody Era -> TxId) -> TxBody Era -> TxId
forall a b. (a -> b) -> a -> b
$ Tx Era -> TxBody Era
forall era. Tx era -> TxBody era
getTxBody Tx Era
tx)
DiffTime
diff <- NominalDiffTime -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (NominalDiffTime -> DiffTime)
-> (UTCTime -> NominalDiffTime) -> UTCTime -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
deadline (UTCTime -> DiffTime) -> IO UTCTime -> IO DiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
DiffTime -> IO ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay (DiffTime -> IO ()) -> DiffTime -> IO ()
forall a b. (a -> b) -> a -> b
$ DiffTime
diff DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
1
(IO String -> String -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` String
"OK") (IO String -> IO ()) -> IO String -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow (String
"DELETE " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> HydraClient -> String
forall {a}. (Semigroup a, IsString a) => HydraClient -> a
hydraNodeBaseUrl HydraClient
n1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/commits/" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
path)
IO Request
-> (Request -> IO (Response String)) -> IO (Response String)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Request -> IO (Response String)
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response a)
httpJSON
IO (Response String) -> (Response String -> String) -> IO String
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a. Response a -> a
getResponseBody @String
NominalDiffTime -> [HydraClient] -> (Value -> Maybe ()) -> IO ()
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch NominalDiffTime
20 [HydraClient
n1] ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"CommitRecovered"
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"recoveredUTxO" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (UTxO' (TxOut CtxUTxO Era) -> Value
forall a. ToJSON a => a -> Value
toJSON UTxO' (TxOut CtxUTxO Era)
commitUTxO)
(UTxO' (TxOut CtxUTxO Era) -> Value
UTxOType (Tx Era) -> ValueType (Tx Era)
forall tx. IsTx tx => UTxOType tx -> ValueType tx
balance (UTxO' (TxOut CtxUTxO Era) -> Value)
-> IO (UTxO' (TxOut CtxUTxO Era)) -> IO Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> backend
-> QueryPoint
-> VerificationKey PaymentKey
-> IO (UTxO' (TxOut CtxUTxO Era))
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a
-> QueryPoint
-> VerificationKey PaymentKey
-> m (UTxO' (TxOut CtxUTxO Era))
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend
-> QueryPoint
-> VerificationKey PaymentKey
-> m (UTxO' (TxOut CtxUTxO Era))
Backend.queryUTxOFor backend
backend QueryPoint
QueryTip VerificationKey PaymentKey
walletVk)
IO Value -> Value -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` Coin -> Value
lovelaceToValue Coin
commitAmount
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Close" []
UTCTime
deadline' <- NominalDiffTime
-> HydraClient -> (Value -> Maybe UTCTime) -> IO UTCTime
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n1 ((Value -> Maybe UTCTime) -> IO UTCTime)
-> (Value -> Maybe UTCTime) -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"HeadIsClosed"
Value
v Value -> Getting (First UTCTime) Value UTCTime -> Maybe UTCTime
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"contestationDeadline" ((Value -> Const (First UTCTime) Value)
-> Value -> Const (First UTCTime) Value)
-> Getting (First UTCTime) Value UTCTime
-> Getting (First UTCTime) Value UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First UTCTime) Value UTCTime
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
forall a b. (FromJSON a, ToJSON b) => Prism Value Value a b
Prism Value Value UTCTime UTCTime
_JSON
NominalDiffTime
remainingTime <- UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
deadline' (UTCTime -> NominalDiffTime) -> IO UTCTime -> IO NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
remainingTime NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime
3 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"ReadyToFanout" [Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId]
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Fanout" []
NominalDiffTime -> HydraClient -> (Value -> Maybe ()) -> IO ()
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
20 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n1 ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v ->
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"HeadIsFinalized"
(UTxO' (TxOut CtxUTxO Era) -> Value
UTxOType (Tx Era) -> ValueType (Tx Era)
forall tx. IsTx tx => UTxOType tx -> ValueType tx
balance (UTxO' (TxOut CtxUTxO Era) -> Value)
-> IO (UTxO' (TxOut CtxUTxO Era)) -> IO Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> backend
-> QueryPoint
-> VerificationKey PaymentKey
-> IO (UTxO' (TxOut CtxUTxO Era))
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a
-> QueryPoint
-> VerificationKey PaymentKey
-> m (UTxO' (TxOut CtxUTxO Era))
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend
-> QueryPoint
-> VerificationKey PaymentKey
-> m (UTxO' (TxOut CtxUTxO Era))
Backend.queryUTxOFor backend
backend QueryPoint
QueryTip VerificationKey PaymentKey
walletVk)
IO Value -> Value -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` UTxOType (Tx Era) -> ValueType (Tx Era)
forall tx. IsTx tx => UTxOType tx -> ValueType tx
balance UTxO' (TxOut CtxUTxO Era)
UTxOType (Tx Era)
commitUTxO
where
hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
hydraNodeBaseUrl :: HydraClient -> a
hydraNodeBaseUrl HydraClient{Int
$sel:hydraNodeId:HydraClient :: HydraClient -> Int
hydraNodeId :: Int
hydraNodeId} = a
"http://127.0.0.1:" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Int -> a
forall b a. (Show a, IsString b) => a -> b
show (Int
4000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hydraNodeId)
canSeePendingDeposits :: ChainBackend backend => Tracer IO EndToEndLog -> FilePath -> NominalDiffTime -> backend -> [TxId] -> IO ()
canSeePendingDeposits :: forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog
-> String -> NominalDiffTime -> backend -> [TxId] -> IO ()
canSeePendingDeposits Tracer IO EndToEndLog
tracer String
workDir NominalDiffTime
blockTime backend
backend [TxId]
hydraScriptsTxId =
(IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` Tracer IO EndToEndLog -> backend -> Actor -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
returnFundsToFaucet Tracer IO EndToEndLog
tracer backend
backend Actor
Alice) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
(IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` Tracer IO EndToEndLog -> backend -> Actor -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
returnFundsToFaucet Tracer IO EndToEndLog
tracer backend
backend Actor
Bob) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
refuelIfNeeded Tracer IO EndToEndLog
tracer backend
backend Actor
Alice Coin
30_000_000
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
refuelIfNeeded Tracer IO EndToEndLog
tracer backend
backend Actor
Bob Coin
30_000_000
let contestationPeriod :: 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
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime
depositPeriod :: DepositPeriod
depositPeriod = NominalDiffTime -> DepositPeriod
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (NominalDiffTime -> DepositPeriod)
-> NominalDiffTime -> DepositPeriod
forall a b. (a -> b) -> a -> b
$ NominalDiffTime
100 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime
NetworkId
networkId <- backend -> IO NetworkId
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> m NetworkId
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> m NetworkId
Backend.queryNetworkId backend
backend
ChainConfig
aliceChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Alice String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Bob] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId (ChainConfig -> ChainConfig)
-> (ChainConfig -> ChainConfig) -> ChainConfig -> ChainConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoChainConfig -> CardanoChainConfig)
-> ChainConfig -> ChainConfig
modifyConfig (\CardanoChainConfig
c -> CardanoChainConfig
c{depositPeriod})
ChainConfig
bobChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Bob String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Alice] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId (ChainConfig -> ChainConfig)
-> (ChainConfig -> ChainConfig) -> ChainConfig -> ChainConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoChainConfig -> CardanoChainConfig)
-> ChainConfig -> ChainConfig
modifyConfig (\CardanoChainConfig
c -> CardanoChainConfig
c{depositPeriod})
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
1 SigningKey HydraKey
aliceSk [VerificationKey HydraKey
bobVk] [Int
2] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
()
_ <- Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
bobChainConfig String
workDir Int
2 SigningKey HydraKey
bobSk [VerificationKey HydraKey
aliceVk] [Int
1] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n2 -> do
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Init" []
HeadId
headId <- NominalDiffTime
-> HydraClient -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch NominalDiffTime
10 HydraClient
n1 ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice, Party
bob])
HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n1 UTxO' (TxOut CtxUTxO Era)
forall a. Monoid a => a
mempty IO (Tx Era) -> (Tx Era -> 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
>>= backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend
HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n2 UTxO' (TxOut CtxUTxO Era)
forall a. Monoid a => a
mempty IO (Tx Era) -> (Tx Era -> 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
>>= backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
20 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1, HydraClient
n2] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"HeadIsOpen" [Key
"utxo" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Pair]
forall a. Monoid a => a
mempty, Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId]
() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
(VerificationKey PaymentKey
walletVk, SigningKey PaymentKey
walletSk) <- Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
-> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
forall a. Gen a -> IO a
generate Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
genKeyPair
UTxO' (TxOut CtxUTxO Era)
commitUTxO <- backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
seedFromFaucet backend
backend VerificationKey PaymentKey
walletVk Coin
5_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
UTxO' (TxOut CtxUTxO Era)
commitUTxO2 <- backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
seedFromFaucet backend
backend VerificationKey PaymentKey
walletVk Coin
4_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
UTxO' (TxOut CtxUTxO Era)
commitUTxO3 <- backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
seedFromFaucet backend
backend VerificationKey PaymentKey
walletVk Coin
3_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
[TxId]
deposited <- [UTxO' (TxOut CtxUTxO Era)]
-> (UTxO' (TxOut CtxUTxO Era) -> IO TxId) -> IO [TxId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [UTxO' (TxOut CtxUTxO Era)
commitUTxO, UTxO' (TxOut CtxUTxO Era)
commitUTxO2, UTxO' (TxOut CtxUTxO Era)
commitUTxO3] ((UTxO' (TxOut CtxUTxO Era) -> IO TxId) -> IO [TxId])
-> (UTxO' (TxOut CtxUTxO Era) -> IO TxId) -> IO [TxId]
forall a b. (a -> b) -> a -> b
$ \UTxO' (TxOut CtxUTxO Era)
utxo -> do
Tx Era
depositTransaction <-
String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow (String
"POST " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> HydraClient -> String
forall {a}. (Semigroup a, IsString a) => HydraClient -> a
hydraNodeBaseUrl HydraClient
n1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/commit")
IO Request -> (Request -> Request) -> IO Request
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> UTxO' (TxOut CtxUTxO Era) -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
setRequestBodyJSON UTxO' (TxOut CtxUTxO Era)
utxo
IO Request
-> (Request -> IO (Response (Tx Era))) -> IO (Response (Tx Era))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Request -> IO (Response (Tx Era))
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response a)
httpJSON
IO (Response (Tx Era))
-> (Response (Tx Era) -> Tx Era) -> IO (Tx Era)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Response (Tx Era) -> Tx Era
forall a. Response a -> a
getResponseBody
let tx :: Tx Era
tx = SigningKey PaymentKey -> Tx Era -> Tx Era
forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
signTx SigningKey PaymentKey
walletSk Tx Era
depositTransaction
let depositTxId :: TxId
depositTxId = TxBody Era -> TxId
forall era. TxBody era -> TxId
getTxId (Tx Era -> TxBody Era
forall era. Tx era -> TxBody era
getTxBody Tx Era
tx)
IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend Tx Era
tx
IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> [HydraClient] -> (Value -> Maybe ()) -> IO ()
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch NominalDiffTime
10 [HydraClient
n1] ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v ->
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"CommitRecorded"
[TxId]
pendingDeposits <-
String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow (String
"GET " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> HydraClient -> String
forall {a}. (Semigroup a, IsString a) => HydraClient -> a
hydraNodeBaseUrl HydraClient
n1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/commits")
IO Request
-> (Request -> IO (Response [TxId])) -> IO (Response [TxId])
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Request -> IO (Response [TxId])
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response a)
httpJSON
IO (Response [TxId]) -> (Response [TxId] -> [TxId]) -> IO [TxId]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Response [TxId] -> [TxId]
forall a. Response a -> a
getResponseBody
IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [TxId]
pendingDeposits [TxId] -> [TxId] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [TxId
depositTxId]
TxId -> IO TxId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxId
depositTxId
[TxId] -> (TxId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TxId]
deposited ((TxId -> IO ()) -> IO ()) -> (TxId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TxId
deposit -> do
let path :: String
path = ByteString -> String
BSC.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Bool -> ByteString -> ByteString
urlEncode Bool
False (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TxId -> String
forall b a. (Show a, IsString b) => a -> b
show TxId
deposit
DiffTime -> IO ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay (DiffTime -> IO ()) -> DiffTime -> IO ()
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (DepositPeriod -> NominalDiffTime
toNominalDiffTime DepositPeriod
depositPeriod NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
4)
(IO String -> String -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` String
"OK") (IO String -> IO ()) -> IO String -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow (String
"DELETE " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> HydraClient -> String
forall {a}. (Semigroup a, IsString a) => HydraClient -> a
hydraNodeBaseUrl HydraClient
n1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/commits/" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
path)
IO Request
-> (Request -> IO (Response String)) -> IO (Response String)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Request -> IO (Response String)
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response a)
httpJSON
IO (Response String) -> (Response String -> String) -> IO String
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a. Response a -> a
getResponseBody @String
NominalDiffTime -> [HydraClient] -> (Value -> Maybe ()) -> IO ()
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch NominalDiffTime
10 [HydraClient
n1] ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"CommitRecovered"
[TxId]
pendingDeposits :: [TxId] <-
String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow (String
"GET " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> HydraClient -> String
forall {a}. (Semigroup a, IsString a) => HydraClient -> a
hydraNodeBaseUrl HydraClient
n1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/commits")
IO Request
-> (Request -> IO (Response [TxId])) -> IO (Response [TxId])
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Request -> IO (Response [TxId])
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response a)
httpJSON
IO (Response [TxId]) -> (Response [TxId] -> [TxId]) -> IO [TxId]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Response [TxId] -> [TxId]
forall a. Response a -> a
getResponseBody
[TxId]
pendingDeposits [TxId] -> [TxId] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` []
where
hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
hydraNodeBaseUrl :: HydraClient -> a
hydraNodeBaseUrl HydraClient{Int
$sel:hydraNodeId:HydraClient :: HydraClient -> Int
hydraNodeId :: Int
hydraNodeId} = a
"http://127.0.0.1:" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Int -> a
forall b a. (Show a, IsString b) => a -> b
show (Int
4000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hydraNodeId)
canDecommit :: ChainBackend backend => Tracer IO EndToEndLog -> FilePath -> backend -> [TxId] -> IO ()
canDecommit :: forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> String -> backend -> [TxId] -> IO ()
canDecommit Tracer IO EndToEndLog
tracer String
workDir backend
backend [TxId]
hydraScriptsTxId =
(IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` Tracer IO EndToEndLog -> backend -> Actor -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
returnFundsToFaucet Tracer IO EndToEndLog
tracer backend
backend Actor
Alice) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
refuelIfNeeded Tracer IO EndToEndLog
tracer backend
backend Actor
Alice Coin
30_000_000
let contestationPeriod :: ContestationPeriod
contestationPeriod = ContestationPeriod
1
NetworkId
networkId <- backend -> IO NetworkId
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> m NetworkId
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> m NetworkId
Backend.queryNetworkId backend
backend
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
ChainConfig
aliceChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Alice String
workDir backend
backend [TxId]
hydraScriptsTxId [] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
1 SigningKey HydraKey
aliceSk [] [Int
1] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Init" []
HeadId
headId <- NominalDiffTime
-> HydraClient -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch NominalDiffTime
10 HydraClient
n1 ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice])
(VerificationKey PaymentKey
walletVk, SigningKey PaymentKey
walletSk) <- Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
-> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
forall a. Gen a -> IO a
generate Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
genKeyPair
let headAmount :: Coin
headAmount = Coin
8_000_000
let commitAmount :: Coin
commitAmount = Coin
5_000_000
UTxO' (TxOut CtxUTxO Era)
headUTxO <- backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
seedFromFaucet backend
backend VerificationKey PaymentKey
walletVk Coin
headAmount ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
UTxO' (TxOut CtxUTxO Era)
commitUTxO <- backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
seedFromFaucet backend
backend VerificationKey PaymentKey
walletVk Coin
commitAmount ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n1 (UTxO' (TxOut CtxUTxO Era)
headUTxO UTxO' (TxOut CtxUTxO Era)
-> UTxO' (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era)
forall a. Semigroup a => a -> a -> a
<> UTxO' (TxOut CtxUTxO Era)
commitUTxO) IO (Tx Era) -> (Tx Era -> Tx Era) -> IO (Tx Era)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> SigningKey PaymentKey -> Tx Era -> Tx Era
forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
signTx SigningKey PaymentKey
walletSk IO (Tx Era) -> (Tx Era -> 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
>>= backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer NominalDiffTime
10 [HydraClient
n1] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"HeadIsOpen" [Key
"utxo" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxO' (TxOut CtxUTxO Era) -> Value
forall a. ToJSON a => a -> Value
toJSON (UTxO' (TxOut CtxUTxO Era)
headUTxO UTxO' (TxOut CtxUTxO Era)
-> UTxO' (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era)
forall a. Semigroup a => a -> a -> a
<> UTxO' (TxOut CtxUTxO Era)
commitUTxO), Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId]
let walletAddress :: AddressInEra Era
walletAddress = NetworkId -> VerificationKey PaymentKey -> AddressInEra Era
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
networkId VerificationKey PaymentKey
walletVk
Tx Era
decommitTx <- do
let (TxIn
i, TxOut CtxUTxO Era
o) = [(TxIn, TxOut CtxUTxO Era)] -> (TxIn, TxOut CtxUTxO Era)
forall a. HasCallStack => [a] -> a
List.head ([(TxIn, TxOut CtxUTxO Era)] -> (TxIn, TxOut CtxUTxO Era))
-> [(TxIn, TxOut CtxUTxO Era)] -> (TxIn, TxOut CtxUTxO Era)
forall a b. (a -> b) -> a -> b
$ UTxO' (TxOut CtxUTxO Era) -> [(TxIn, TxOut CtxUTxO Era)]
forall out. UTxO' out -> [(TxIn, out)]
UTxO.toList UTxO' (TxOut CtxUTxO Era)
commitUTxO
(TxBodyError -> IO (Tx Era))
-> (Tx Era -> IO (Tx Era))
-> Either TxBodyError (Tx Era)
-> IO (Tx Era)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> IO (Tx Era)
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure (String -> IO (Tx Era))
-> (TxBodyError -> String) -> TxBodyError -> IO (Tx Era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBodyError -> String
forall b a. (Show a, IsString b) => a -> b
show) Tx Era -> IO (Tx Era)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TxBodyError (Tx Era) -> IO (Tx Era))
-> Either TxBodyError (Tx Era) -> IO (Tx Era)
forall a b. (a -> b) -> a -> b
$
(TxIn, TxOut CtxUTxO Era)
-> (AddressInEra Era, Value)
-> SigningKey PaymentKey
-> Either TxBodyError (Tx Era)
mkSimpleTx (TxIn
i, TxOut CtxUTxO Era
o) (AddressInEra Era
walletAddress, TxOut CtxUTxO Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue TxOut CtxUTxO Era
o) SigningKey PaymentKey
walletSk
HydraClient -> HeadId -> Tx Era -> IO ()
forall {a}. ToJSON a => HydraClient -> a -> Tx Era -> IO ()
expectFailureOnUnsignedDecommitTx HydraClient
n1 HeadId
headId Tx Era
decommitTx
HydraClient -> HeadId -> Tx Era -> IO ()
expectSuccessOnSignedDecommitTx HydraClient
n1 HeadId
headId Tx Era
decommitTx
HydraClient -> IO (UTxO' (TxOut CtxUTxO Era))
getSnapshotUTxO HydraClient
n1 IO (UTxO' (TxOut CtxUTxO Era))
-> UTxO' (TxOut CtxUTxO Era) -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` UTxO' (TxOut CtxUTxO Era)
headUTxO
(UTxO' (TxOut CtxUTxO Era) -> Value
UTxOType (Tx Era) -> ValueType (Tx Era)
forall tx. IsTx tx => UTxOType tx -> ValueType tx
balance (UTxO' (TxOut CtxUTxO Era) -> Value)
-> IO (UTxO' (TxOut CtxUTxO Era)) -> IO Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> backend
-> QueryPoint
-> VerificationKey PaymentKey
-> IO (UTxO' (TxOut CtxUTxO Era))
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a
-> QueryPoint
-> VerificationKey PaymentKey
-> m (UTxO' (TxOut CtxUTxO Era))
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend
-> QueryPoint
-> VerificationKey PaymentKey
-> m (UTxO' (TxOut CtxUTxO Era))
Backend.queryUTxOFor backend
backend QueryPoint
QueryTip VerificationKey PaymentKey
walletVk)
IO Value -> Value -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` Coin -> Value
lovelaceToValue Coin
commitAmount
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Close" []
UTCTime
deadline <- NominalDiffTime
-> HydraClient -> (Value -> Maybe UTCTime) -> IO UTCTime
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n1 ((Value -> Maybe UTCTime) -> IO UTCTime)
-> (Value -> Maybe UTCTime) -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"HeadIsClosed"
Value
v Value -> Getting (First UTCTime) Value UTCTime -> Maybe UTCTime
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"contestationDeadline" ((Value -> Const (First UTCTime) Value)
-> Value -> Const (First UTCTime) Value)
-> Getting (First UTCTime) Value UTCTime
-> Getting (First UTCTime) Value UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First UTCTime) Value UTCTime
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
forall a b. (FromJSON a, ToJSON b) => Prism Value Value a b
Prism Value Value UTCTime UTCTime
_JSON
NominalDiffTime
remainingTime <- UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
deadline (UTCTime -> NominalDiffTime) -> IO UTCTime -> IO NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
remainingTime NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime
3 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"ReadyToFanout" [Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId]
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Fanout" []
NominalDiffTime -> HydraClient -> (Value -> Maybe ()) -> IO ()
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n1 ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v ->
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"HeadIsFinalized"
(UTxO' (TxOut CtxUTxO Era) -> Value
UTxOType (Tx Era) -> ValueType (Tx Era)
forall tx. IsTx tx => UTxOType tx -> ValueType tx
balance (UTxO' (TxOut CtxUTxO Era) -> Value)
-> IO (UTxO' (TxOut CtxUTxO Era)) -> IO Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> backend
-> QueryPoint
-> VerificationKey PaymentKey
-> IO (UTxO' (TxOut CtxUTxO Era))
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a
-> QueryPoint
-> VerificationKey PaymentKey
-> m (UTxO' (TxOut CtxUTxO Era))
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend
-> QueryPoint
-> VerificationKey PaymentKey
-> m (UTxO' (TxOut CtxUTxO Era))
Backend.queryUTxOFor backend
backend QueryPoint
QueryTip VerificationKey PaymentKey
walletVk)
IO Value -> Value -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` Coin -> Value
lovelaceToValue (Coin
headAmount Coin -> Coin -> Coin
forall a. Num a => a -> a -> a
+ Coin
commitAmount)
where
expectSuccessOnSignedDecommitTx :: HydraClient -> HeadId -> Tx Era -> IO ()
expectSuccessOnSignedDecommitTx HydraClient
n HeadId
headId Tx Era
decommitTx = do
let decommitUTxO :: UTxO' (TxOut CtxUTxO Era)
decommitUTxO = Tx Era -> UTxO' (TxOut CtxUTxO Era)
utxoFromTx Tx Era
decommitTx
decommitTxId :: TxIdType (Tx Era)
decommitTxId = Tx Era -> TxIdType (Tx Era)
forall tx. IsTx tx => tx -> TxIdType tx
txId Tx Era
decommitTx
IO (IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO ()) -> IO ())
-> (Gen (IO ()) -> IO (IO ())) -> Gen (IO ()) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen (IO ()) -> IO (IO ())
forall a. Gen a -> IO a
generate (Gen (IO ()) -> IO ()) -> Gen (IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
[IO ()] -> Gen (IO ())
forall a. HasCallStack => [a] -> Gen a
elements
[ HydraClient -> Value -> IO ()
send HydraClient
n (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Decommit" [Key
"decommitTx" Key -> Tx Era -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tx Era
decommitTx]
, HydraClient -> Tx Era -> IO ()
postDecommit HydraClient
n Tx Era
decommitTx
]
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer NominalDiffTime
10 [HydraClient
n] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"DecommitRequested" [Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId, Key
"decommitTx" Key -> Tx Era -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tx Era
decommitTx, Key
"utxoToDecommit" Key -> UTxO' (TxOut CtxUTxO Era) -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxO' (TxOut CtxUTxO Era)
decommitUTxO]
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer NominalDiffTime
10 [HydraClient
n] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"DecommitApproved" [Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId, Key
"decommitTxId" Key -> TxId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TxId
TxIdType (Tx Era)
decommitTxId, Key
"utxoToDecommit" Key -> UTxO' (TxOut CtxUTxO Era) -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxO' (TxOut CtxUTxO Era)
decommitUTxO]
NominalDiffTime -> IO () -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTimer m, MonadThrow m) =>
NominalDiffTime -> m a -> m a
failAfter NominalDiffTime
10 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ backend -> UTxO' (TxOut CtxUTxO Era) -> IO ()
forall backend.
ChainBackend backend =>
backend -> UTxO' (TxOut CtxUTxO Era) -> IO ()
waitForUTxO backend
backend UTxO' (TxOut CtxUTxO Era)
decommitUTxO
UTxO' (TxOut CtxUTxO Era)
distributedUTxO <- NominalDiffTime
-> [HydraClient]
-> (Value -> Maybe (UTxO' (TxOut CtxUTxO Era)))
-> IO (UTxO' (TxOut CtxUTxO Era))
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch NominalDiffTime
10 [HydraClient
n] ((Value -> Maybe (UTxO' (TxOut CtxUTxO Era)))
-> IO (UTxO' (TxOut CtxUTxO Era)))
-> (Value -> Maybe (UTxO' (TxOut CtxUTxO Era)))
-> IO (UTxO' (TxOut CtxUTxO Era))
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"DecommitFinalized"
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"headId" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (HeadId -> Value
forall a. ToJSON a => a -> Value
toJSON HeadId
headId)
Value
v Value
-> Getting
(First (UTxO' (TxOut CtxUTxO Era)))
Value
(UTxO' (TxOut CtxUTxO Era))
-> Maybe (UTxO' (TxOut CtxUTxO Era))
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"distributedUTxO" ((Value -> Const (First (UTxO' (TxOut CtxUTxO Era))) Value)
-> Value -> Const (First (UTxO' (TxOut CtxUTxO Era))) Value)
-> Getting
(First (UTxO' (TxOut CtxUTxO Era)))
Value
(UTxO' (TxOut CtxUTxO Era))
-> Getting
(First (UTxO' (TxOut CtxUTxO Era)))
Value
(UTxO' (TxOut CtxUTxO Era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
(First (UTxO' (TxOut CtxUTxO Era)))
Value
(UTxO' (TxOut CtxUTxO Era))
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
forall a b. (FromJSON a, ToJSON b) => Prism Value Value a b
Prism
Value Value (UTxO' (TxOut CtxUTxO Era)) (UTxO' (TxOut CtxUTxO Era))
_JSON
Bool -> IO ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ UTxO' (TxOut CtxUTxO Era)
distributedUTxO UTxO' (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era) -> Bool
forall out. Eq out => UTxO' out -> UTxO' out -> Bool
`UTxO.containsOutputs` UTxO' (TxOut CtxUTxO Era)
decommitUTxO
expectFailureOnUnsignedDecommitTx :: HydraClient -> a -> Tx Era -> IO ()
expectFailureOnUnsignedDecommitTx HydraClient
n a
headId Tx Era
decommitTx = do
let unsignedDecommitTx :: Tx Era
unsignedDecommitTx = [KeyWitness Era] -> TxBody Era -> Tx Era
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [] (TxBody Era -> Tx Era) -> TxBody Era -> Tx Era
forall a b. (a -> b) -> a -> b
$ Tx Era -> TxBody Era
forall era. Tx era -> TxBody era
getTxBody Tx Era
decommitTx
IO (IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO ()) -> IO ())
-> (Gen (IO ()) -> IO (IO ())) -> Gen (IO ()) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen (IO ()) -> IO (IO ())
forall a. Gen a -> IO a
generate (Gen (IO ()) -> IO ()) -> Gen (IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
[IO ()] -> Gen (IO ())
forall a. HasCallStack => [a] -> Gen a
elements
[ HydraClient -> Value -> IO ()
send HydraClient
n (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Decommit" [Key
"decommitTx" Key -> Tx Era -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tx Era
unsignedDecommitTx]
, HydraClient -> Tx Era -> IO ()
postDecommit HydraClient
n Tx Era
unsignedDecommitTx
]
String
validationError <- NominalDiffTime
-> HydraClient -> (Value -> Maybe String) -> IO String
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch NominalDiffTime
10 HydraClient
n ((Value -> Maybe String) -> IO String)
-> (Value -> Maybe String) -> IO String
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"headId" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
headId)
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (Text -> Value
Aeson.String Text
"DecommitInvalid")
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"decommitTx" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (Tx Era -> Value
forall a. ToJSON a => a -> Value
toJSON Tx Era
unsignedDecommitTx)
Value
v Value -> Getting (First String) Value String -> Maybe String
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"decommitInvalidReason" ((Value -> Const (First String) Value)
-> Value -> Const (First String) Value)
-> Getting (First String) Value String
-> Getting (First String) Value String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"validationError" ((Value -> Const (First String) Value)
-> Value -> Const (First String) Value)
-> Getting (First String) Value String
-> Getting (First String) Value String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"reason" ((Value -> Const (First String) Value)
-> Value -> Const (First String) Value)
-> Getting (First String) Value String
-> Getting (First String) Value String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First String) Value String
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
forall a b. (FromJSON a, ToJSON b) => Prism Value Value a b
Prism Value Value String String
_JSON
String
validationError String -> String -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` String
"MissingVKeyWitnessesUTXOW"
hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
canSideLoadSnapshot :: ChainBackend backend => Tracer IO EndToEndLog -> FilePath -> backend -> [TxId] -> IO ()
canSideLoadSnapshot :: forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> String -> backend -> [TxId] -> IO ()
canSideLoadSnapshot Tracer IO EndToEndLog
tracer String
workDir backend
backend [TxId]
hydraScriptsTxId = do
let clients :: [Actor]
clients = [Actor
Alice, Actor
Bob, Actor
Carol]
[(VerificationKey PaymentKey
aliceCardanoVk, SigningKey PaymentKey
aliceCardanoSk), (VerificationKey PaymentKey
bobCardanoVk, SigningKey PaymentKey
_), (VerificationKey PaymentKey
carolCardanoVk, SigningKey PaymentKey
_)] <- [Actor]
-> (Actor
-> IO (VerificationKey PaymentKey, SigningKey PaymentKey))
-> IO [(VerificationKey PaymentKey, SigningKey PaymentKey)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Actor]
clients Actor -> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
keysFor
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
seedFromFaucet_ backend
backend VerificationKey PaymentKey
aliceCardanoVk Coin
100_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
seedFromFaucet_ backend
backend VerificationKey PaymentKey
bobCardanoVk Coin
100_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
seedFromFaucet_ backend
backend VerificationKey PaymentKey
carolCardanoVk Coin
100_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
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
let contestationPeriod :: ContestationPeriod
contestationPeriod = ContestationPeriod
1
NetworkId
networkId <- backend -> IO NetworkId
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> m NetworkId
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> m NetworkId
Backend.queryNetworkId backend
backend
ChainConfig
aliceChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Alice String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Bob, Actor
Carol] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId
ChainConfig
bobChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Bob String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Alice, Actor
Carol] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId
ChainConfig
carolChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Carol String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Alice, Actor
Bob] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
1 SigningKey HydraKey
aliceSk [VerificationKey HydraKey
bobVk, VerificationKey HydraKey
carolVk] [Int
1, Int
2, Int
3] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
UTxO' (TxOut CtxUTxO Era)
aliceUTxO <- backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
seedFromFaucet backend
backend VerificationKey PaymentKey
aliceCardanoVk Coin
1_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
bobChainConfig String
workDir Int
2 SigningKey HydraKey
bobSk [VerificationKey HydraKey
aliceVk, VerificationKey HydraKey
carolVk] [Int
1, Int
2, Int
3] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n2 -> do
let pparamsDecorator :: Value -> Value
pparamsDecorator = Key -> Traversal' Value (Maybe Value)
forall t. AsValue t => Key -> Traversal' t (Maybe Value)
atKey Key
"maxTxSize" ((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
?~ Value -> Value
forall a. ToJSON a => a -> Value
toJSON (Scientific -> Value
Aeson.Number Scientific
0)
RunOptions
wrongOptions <- HasCallStack =>
ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (Value -> Value)
-> IO RunOptions
ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (Value -> Value)
-> IO RunOptions
prepareHydraNode ChainConfig
carolChainConfig String
workDir Int
3 SigningKey HydraKey
carolSk [VerificationKey HydraKey
aliceVk, VerificationKey HydraKey
bobVk] [Int
1, Int
2, Int
3] Value -> Value
pparamsDecorator
Tx Era
tx <- Tracer IO HydraNodeLog
-> String
-> Int
-> RunOptions
-> (HydraClient -> IO (Tx Era))
-> IO (Tx Era)
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> String -> Int -> RunOptions -> (HydraClient -> IO a) -> IO a
withPreparedHydraNode Tracer IO HydraNodeLog
hydraTracer String
workDir Int
3 RunOptions
wrongOptions ((HydraClient -> IO (Tx Era)) -> IO (Tx Era))
-> (HydraClient -> IO (Tx Era)) -> IO (Tx Era)
forall a b. (a -> b) -> a -> b
$ \HydraClient
n3 -> do
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Init" []
HeadId
headId <- NominalDiffTime
-> [HydraClient] -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1, HydraClient
n2, HydraClient
n3] ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice, Party
bob, Party
carol])
HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n1 UTxO' (TxOut CtxUTxO Era)
aliceUTxO IO (Tx Era) -> (Tx Era -> 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
>>= backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend
(HydraClient -> IO ()) -> [HydraClient] -> IO ()
forall (f :: * -> *) a b. Foldable f => (a -> IO b) -> f a -> IO ()
mapConcurrently_ (\HydraClient
n -> HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n UTxO' (TxOut CtxUTxO Era)
forall a. Monoid a => a
mempty IO (Tx Era) -> (Tx Era -> 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
>>= backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend) [HydraClient
n2, HydraClient
n3]
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
20 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1, HydraClient
n2, HydraClient
n3] (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"HeadIsOpen" [Key
"utxo" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxO' (TxOut CtxUTxO Era) -> Value
forall a. ToJSON a => a -> Value
toJSON UTxO' (TxOut CtxUTxO Era)
aliceUTxO, Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId]
UTxO' (TxOut CtxUTxO Era)
utxo <- HydraClient -> IO (UTxO' (TxOut CtxUTxO Era))
getSnapshotUTxO HydraClient
n1
Tx Era
tx <- NetworkId
-> UTxO' (TxOut CtxUTxO Era)
-> SigningKey PaymentKey
-> VerificationKey PaymentKey
-> IO (Tx Era)
forall (m :: * -> *).
MonadFail m =>
NetworkId
-> UTxO' (TxOut CtxUTxO Era)
-> SigningKey PaymentKey
-> VerificationKey PaymentKey
-> m (Tx Era)
mkTransferTx NetworkId
testNetworkId UTxO' (TxOut CtxUTxO Era)
utxo SigningKey PaymentKey
aliceCardanoSk VerificationKey PaymentKey
aliceCardanoVk
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"NewTx" [Key
"transaction" Key -> Tx Era -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tx Era
tx]
NominalDiffTime -> [HydraClient] -> (Value -> Maybe ()) -> IO ()
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch (NominalDiffTime
200 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1, HydraClient
n2] ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"TxValid"
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"transactionId" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (TxId -> Value
forall a. ToJSON a => a -> Value
toJSON (TxId -> Value) -> TxId -> Value
forall a b. (a -> b) -> a -> b
$ Tx Era -> TxIdType (Tx Era)
forall tx. IsTx tx => tx -> TxIdType tx
txId Tx Era
tx)
NominalDiffTime -> HydraClient -> (Value -> Maybe ()) -> IO ()
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch NominalDiffTime
3 HydraClient
n3 ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"TxInvalid"
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"transaction" Getting (First Value) Value Value
-> Getting (First Value) Value Value
-> Getting (First Value) Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"txId" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (TxId -> Value
forall a. ToJSON a => a -> Value
toJSON (TxId -> Value) -> TxId -> Value
forall a b. (a -> b) -> a -> b
$ Tx Era -> TxIdType (Tx Era)
forall tx. IsTx tx => tx -> TxIdType tx
txId Tx Era
tx)
SeenSnapshot (Tx Era)
seenSn1 <- HydraClient -> IO (SeenSnapshot (Tx Era))
getSnapshotLastSeen HydraClient
n1
SeenSnapshot (Tx Era)
seenSn2 <- HydraClient -> IO (SeenSnapshot (Tx Era))
getSnapshotLastSeen HydraClient
n2
SeenSnapshot (Tx Era)
seenSn1 SeenSnapshot (Tx Era) -> SeenSnapshot (Tx Era) -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` SeenSnapshot (Tx Era)
seenSn2
SeenSnapshot (Tx Era)
seenSn3 <- HydraClient -> IO (SeenSnapshot (Tx Era))
getSnapshotLastSeen HydraClient
n3
SeenSnapshot (Tx Era)
seenSn2 SeenSnapshot (Tx Era) -> SeenSnapshot (Tx Era) -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldNotBe` SeenSnapshot (Tx Era)
seenSn3
Tx Era -> IO (Tx Era)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tx Era
tx
NominalDiffTime -> [HydraClient] -> (Value -> Maybe ()) -> IO ()
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch (NominalDiffTime
100 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1, HydraClient
n2] ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"PeerDisconnected"
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
carolChainConfig String
workDir Int
3 SigningKey HydraKey
carolSk [VerificationKey HydraKey
aliceVk, VerificationKey HydraKey
bobVk] [Int
1, Int
2, Int
3] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n3 -> do
HydraClient -> Value -> IO ()
send HydraClient
n3 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"NewTx" [Key
"transaction" Key -> Tx Era -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tx Era
tx]
NominalDiffTime -> HydraClient -> (Value -> Maybe ()) -> IO ()
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch NominalDiffTime
3 HydraClient
n3 ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"TxValid"
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"transactionId" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (TxId -> Value
forall a. ToJSON a => a -> Value
toJSON (TxId -> Value) -> TxId -> Value
forall a b. (a -> b) -> a -> b
$ Tx Era -> TxIdType (Tx Era)
forall tx. IsTx tx => tx -> TxIdType tx
txId Tx Era
tx)
NominalDiffTime -> [HydraClient] -> (Value -> Maybe ()) -> IO ()
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch (NominalDiffTime
200 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1, HydraClient
n2] ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"TxInvalid"
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"transaction" Getting (First Value) Value Value
-> Getting (First Value) Value Value
-> Getting (First Value) Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"txId" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (TxId -> Value
forall a. ToJSON a => a -> Value
toJSON (TxId -> Value) -> TxId -> Value
forall a b. (a -> b) -> a -> b
$ Tx Era -> TxIdType (Tx Era)
forall tx. IsTx tx => tx -> TxIdType tx
txId Tx Era
tx)
SeenSnapshot (Tx Era)
seenSn1 <- HydraClient -> IO (SeenSnapshot (Tx Era))
getSnapshotLastSeen HydraClient
n1
SeenSnapshot (Tx Era)
seenSn2 <- HydraClient -> IO (SeenSnapshot (Tx Era))
getSnapshotLastSeen HydraClient
n2
SeenSnapshot (Tx Era)
seenSn1 SeenSnapshot (Tx Era) -> SeenSnapshot (Tx Era) -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` SeenSnapshot (Tx Era)
seenSn2
SeenSnapshot (Tx Era)
seenSn3 <- HydraClient -> IO (SeenSnapshot (Tx Era))
getSnapshotLastSeen HydraClient
n3
SeenSnapshot (Tx Era)
seenSn2 SeenSnapshot (Tx Era) -> SeenSnapshot (Tx Era) -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldNotBe` SeenSnapshot (Tx Era)
seenSn3
ConfirmedSnapshot (Tx Era)
snapshotConfirmed <- HydraClient -> IO (ConfirmedSnapshot (Tx Era))
getSnapshotConfirmed HydraClient
n1
((HydraClient -> IO ()) -> [HydraClient] -> IO ())
-> [HydraClient] -> (HydraClient -> IO ()) -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (HydraClient -> IO ()) -> [HydraClient] -> IO ()
forall (f :: * -> *) a b. Foldable f => (a -> IO b) -> f a -> IO ()
mapConcurrently_ [HydraClient
n1, HydraClient
n2, HydraClient
n3] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n -> do
HydraClient -> Value -> IO ()
send HydraClient
n (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"SideLoadSnapshot" [Key
"snapshot" Key -> ConfirmedSnapshot (Tx Era) -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ConfirmedSnapshot (Tx Era)
snapshotConfirmed]
NominalDiffTime -> HydraClient -> (Value -> Maybe ()) -> IO ()
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
200 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"SnapshotSideLoaded"
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"snapshotNumber" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer
0 :: Integer))
HydraClient -> Value -> IO ()
send HydraClient
n3 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"NewTx" [Key
"transaction" Key -> Tx Era -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tx Era
tx]
((HydraClient -> IO ()) -> [HydraClient] -> IO ())
-> [HydraClient] -> (HydraClient -> IO ()) -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (HydraClient -> IO ()) -> [HydraClient] -> IO ()
forall (f :: * -> *) a b. Foldable f => (a -> IO b) -> f a -> IO ()
mapConcurrently_ [HydraClient
n1, HydraClient
n2, HydraClient
n3] ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n ->
NominalDiffTime -> HydraClient -> (Value -> Maybe ()) -> IO ()
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch (NominalDiffTime
200 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) HydraClient
n ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"SnapshotConfirmed"
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"snapshot" Getting (First Value) Value Value
-> Getting (First Value) Value Value
-> Getting (First Value) Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"number" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer
1 :: Integer))
let sigs :: [Value]
sigs = Value
v Value -> Getting (Endo [Value]) Value Value -> [Value]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"signatures" Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"multiSignature" Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Value]) Value Value
forall t. AsValue t => IndexedTraversal' Int t Value
IndexedTraversal' Int Value Value
values
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
sigs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3
SeenSnapshot (Tx Era)
seenSn1' <- HydraClient -> IO (SeenSnapshot (Tx Era))
getSnapshotLastSeen HydraClient
n1
SeenSnapshot (Tx Era)
seenSn2' <- HydraClient -> IO (SeenSnapshot (Tx Era))
getSnapshotLastSeen HydraClient
n2
SeenSnapshot (Tx Era)
seenSn1' SeenSnapshot (Tx Era) -> SeenSnapshot (Tx Era) -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` SeenSnapshot (Tx Era)
seenSn2'
SeenSnapshot (Tx Era)
seenSn3' <- HydraClient -> IO (SeenSnapshot (Tx Era))
getSnapshotLastSeen HydraClient
n3
SeenSnapshot (Tx Era)
seenSn2' SeenSnapshot (Tx Era) -> SeenSnapshot (Tx Era) -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` SeenSnapshot (Tx Era)
seenSn3'
where
hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
threeNodesWithMirrorParty :: ChainBackend backend => Tracer IO EndToEndLog -> FilePath -> backend -> [TxId] -> IO ()
threeNodesWithMirrorParty :: forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> String -> backend -> [TxId] -> IO ()
threeNodesWithMirrorParty Tracer IO EndToEndLog
tracer String
workDir backend
backend [TxId]
hydraScriptsTxId = do
let parties :: [Actor]
parties = [Actor
Alice, Actor
Bob]
[(VerificationKey PaymentKey
aliceCardanoVk, SigningKey PaymentKey
aliceCardanoSk), (VerificationKey PaymentKey
bobCardanoVk, SigningKey PaymentKey
_)] <- [Actor]
-> (Actor
-> IO (VerificationKey PaymentKey, SigningKey PaymentKey))
-> IO [(VerificationKey PaymentKey, SigningKey PaymentKey)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Actor]
parties Actor -> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
keysFor
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
seedFromFaucet_ backend
backend VerificationKey PaymentKey
aliceCardanoVk Coin
100_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO ()
seedFromFaucet_ backend
backend VerificationKey PaymentKey
bobCardanoVk Coin
100_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
NetworkId
networkId <- backend -> IO NetworkId
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> m NetworkId
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> m NetworkId
Backend.queryNetworkId backend
backend
let contestationPeriod :: ContestationPeriod
contestationPeriod = ContestationPeriod
1
ChainConfig
aliceChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Alice String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Bob] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId
ChainConfig
bobChainConfig <-
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
forall backend.
(ChainBackend backend, HasCallStack) =>
Actor
-> String
-> backend
-> [TxId]
-> [Actor]
-> ContestationPeriod
-> IO ChainConfig
chainConfigFor Actor
Bob String
workDir backend
backend [TxId]
hydraScriptsTxId [Actor
Alice] ContestationPeriod
contestationPeriod
IO ChainConfig -> (ChainConfig -> ChainConfig) -> IO ChainConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NetworkId -> ChainConfig -> ChainConfig
setNetworkId NetworkId
networkId
let hydraTracer :: Tracer IO HydraNodeLog
hydraTracer = (HydraNodeLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO HydraNodeLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap HydraNodeLog -> EndToEndLog
FromHydraNode Tracer IO EndToEndLog
tracer
let allNodeIds :: [Int]
allNodeIds = [Int
1, Int
2, Int
3]
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 HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
1 SigningKey HydraKey
aliceSk [VerificationKey HydraKey
bobVk] [Int]
allNodeIds ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n1 -> do
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
bobChainConfig String
workDir Int
2 SigningKey HydraKey
bobSk [VerificationKey HydraKey
aliceVk] [Int]
allNodeIds ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n2 -> do
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO ())
-> IO ()
forall a.
HasCallStack =>
Tracer IO HydraNodeLog
-> ChainConfig
-> String
-> Int
-> SigningKey HydraKey
-> [VerificationKey HydraKey]
-> [Int]
-> (HydraClient -> IO a)
-> IO a
withHydraNode Tracer IO HydraNodeLog
hydraTracer ChainConfig
aliceChainConfig String
workDir Int
3 SigningKey HydraKey
aliceSk [VerificationKey HydraKey
bobVk] [Int]
allNodeIds ((HydraClient -> IO ()) -> IO ())
-> (HydraClient -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HydraClient
n3 -> do
let clients :: [HydraClient]
clients = [HydraClient
n1, HydraClient
n2, HydraClient
n3]
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"Init" []
HeadId
headId <- NominalDiffTime
-> [HydraClient] -> (Value -> Maybe HeadId) -> IO HeadId
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient]
clients ((Value -> Maybe HeadId) -> IO HeadId)
-> (Value -> Maybe HeadId) -> IO HeadId
forall a b. (a -> b) -> a -> b
$ Set Party -> Value -> Maybe HeadId
headIsInitializingWith ([Party] -> Set Party
forall a. Ord a => [a] -> Set a
Set.fromList [Party
alice, Party
bob])
UTxO' (TxOut CtxUTxO Era)
aliceUTxO <- backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
seedFromFaucet backend
backend VerificationKey PaymentKey
aliceCardanoVk Coin
1_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO ()
forall (m :: * -> *) a b. MonadAsync m => m a -> m b -> m ()
race_
(HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n1 UTxO' (TxOut CtxUTxO Era)
aliceUTxO IO (Tx Era) -> (Tx Era -> 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
>>= backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend)
(HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n3 UTxO' (TxOut CtxUTxO Era)
aliceUTxO IO (Tx Era) -> (Tx Era -> 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
>>= backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend)
UTxO' (TxOut CtxUTxO Era)
bobUTxO <- backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
seedFromFaucet backend
backend VerificationKey PaymentKey
bobCardanoVk Coin
1_000_000 ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
HydraClient -> UTxO' (TxOut CtxUTxO Era) -> IO (Tx Era)
requestCommitTx HydraClient
n2 UTxO' (TxOut CtxUTxO Era)
bobUTxO IO (Tx Era) -> (Tx Era -> 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
>>= backend -> Tx Era -> IO ()
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a -> Tx Era -> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend -> Tx Era -> m ()
Backend.submitTransaction backend
backend
HasCallStack =>
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
Tracer IO HydraNodeLog
-> NominalDiffTime -> [HydraClient] -> Value -> IO ()
waitFor Tracer IO HydraNodeLog
hydraTracer (NominalDiffTime
20 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient]
clients (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> [Pair] -> Value
output Text
"HeadIsOpen" [Key
"utxo" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxO' (TxOut CtxUTxO Era) -> Value
forall a. ToJSON a => a -> Value
toJSON (UTxO' (TxOut CtxUTxO Era)
aliceUTxO UTxO' (TxOut CtxUTxO Era)
-> UTxO' (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era)
forall a. Semigroup a => a -> a -> a
<> UTxO' (TxOut CtxUTxO Era)
bobUTxO), Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId]
UTxO' (TxOut CtxUTxO Era)
utxo <- HydraClient -> IO (UTxO' (TxOut CtxUTxO Era))
getSnapshotUTxO HydraClient
n3
Tx Era
tx <- NetworkId
-> UTxO' (TxOut CtxUTxO Era)
-> SigningKey PaymentKey
-> VerificationKey PaymentKey
-> IO (Tx Era)
forall (m :: * -> *).
MonadFail m =>
NetworkId
-> UTxO' (TxOut CtxUTxO Era)
-> SigningKey PaymentKey
-> VerificationKey PaymentKey
-> m (Tx Era)
mkTransferTx NetworkId
networkId UTxO' (TxOut CtxUTxO Era)
utxo SigningKey PaymentKey
aliceCardanoSk VerificationKey PaymentKey
aliceCardanoVk
HydraClient -> Value -> IO ()
send HydraClient
n3 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"NewTx" [Key
"transaction" Key -> Tx Era -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tx Era
tx]
NominalDiffTime -> [HydraClient] -> (Value -> Maybe ()) -> IO ()
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch (NominalDiffTime
200 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient]
clients ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"SnapshotConfirmed"
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"snapshot" Getting (First Value) Value Value
-> Getting (First Value) Value Value
-> Getting (First Value) Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"number" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer
1 :: Integer))
NominalDiffTime -> [HydraClient] -> (Value -> Maybe ()) -> IO ()
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch (NominalDiffTime
100 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1, HydraClient
n2] ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"PeerDisconnected"
UTxO' (TxOut CtxUTxO Era)
utxo <- HydraClient -> IO (UTxO' (TxOut CtxUTxO Era))
getSnapshotUTxO HydraClient
n1
Tx Era
tx <- NetworkId
-> UTxO' (TxOut CtxUTxO Era)
-> SigningKey PaymentKey
-> VerificationKey PaymentKey
-> IO (Tx Era)
forall (m :: * -> *).
MonadFail m =>
NetworkId
-> UTxO' (TxOut CtxUTxO Era)
-> SigningKey PaymentKey
-> VerificationKey PaymentKey
-> m (Tx Era)
mkTransferTx NetworkId
networkId UTxO' (TxOut CtxUTxO Era)
utxo SigningKey PaymentKey
aliceCardanoSk VerificationKey PaymentKey
aliceCardanoVk
HydraClient -> Value -> IO ()
send HydraClient
n1 (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"NewTx" [Key
"transaction" Key -> Tx Era -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tx Era
tx]
NominalDiffTime -> [HydraClient] -> (Value -> Maybe ()) -> IO ()
forall a.
(Eq a, Show a, HasCallStack) =>
NominalDiffTime -> [HydraClient] -> (Value -> Maybe a) -> IO a
waitForAllMatch (NominalDiffTime
200 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
blockTime) [HydraClient
n1, HydraClient
n2] ((Value -> Maybe ()) -> IO ()) -> (Value -> Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"SnapshotConfirmed"
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"snapshot" Getting (First Value) Value Value
-> Getting (First Value) Value Value
-> Getting (First Value) Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"number" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer
2 :: Integer))
respendUTxO :: HydraClient -> SigningKey PaymentKey -> NominalDiffTime -> IO ()
respendUTxO :: HydraClient -> SigningKey PaymentKey -> NominalDiffTime -> IO ()
respendUTxO HydraClient
client SigningKey PaymentKey
sk NominalDiffTime
delay = do
UTxO' (TxOut CtxUTxO Era)
utxo <- HydraClient -> IO (UTxO' (TxOut CtxUTxO Era))
getSnapshotUTxO HydraClient
client
IO Any -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO Any -> IO ()) -> IO Any -> IO ()
forall a b. (a -> b) -> a -> b
$ UTxO' (TxOut CtxUTxO Era) -> IO Any
respend UTxO' (TxOut CtxUTxO Era)
utxo
where
vk :: VerificationKey PaymentKey
vk = SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey PaymentKey
sk
respend :: UTxO' (TxOut CtxUTxO Era) -> IO Any
respend UTxO' (TxOut CtxUTxO Era)
utxo = do
Tx Era
tx <- NetworkId
-> UTxO' (TxOut CtxUTxO Era)
-> SigningKey PaymentKey
-> VerificationKey PaymentKey
-> IO (Tx Era)
forall (m :: * -> *).
MonadFail m =>
NetworkId
-> UTxO' (TxOut CtxUTxO Era)
-> SigningKey PaymentKey
-> VerificationKey PaymentKey
-> m (Tx Era)
mkTransferTx NetworkId
testNetworkId UTxO' (TxOut CtxUTxO Era)
utxo SigningKey PaymentKey
sk VerificationKey PaymentKey
vk
UTxO' (TxOut CtxUTxO Era)
utxo' <- Tx Era -> IO (UTxO' (TxOut CtxUTxO Era))
submitToHead (SigningKey PaymentKey -> Tx Era -> Tx Era
forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
signTx SigningKey PaymentKey
sk Tx Era
tx)
DiffTime -> IO ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay (DiffTime -> IO ()) -> DiffTime -> IO ()
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
delay
UTxO' (TxOut CtxUTxO Era) -> IO Any
respend UTxO' (TxOut CtxUTxO Era)
utxo'
submitToHead :: Tx Era -> IO (UTxO' (TxOut CtxUTxO Era))
submitToHead Tx Era
tx = do
HydraClient -> Value -> IO ()
send HydraClient
client (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Pair] -> Value
input Text
"NewTx" [Key
"transaction" Key -> Tx Era -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tx Era
tx]
NominalDiffTime
-> HydraClient
-> (Value -> Maybe (UTxO' (TxOut CtxUTxO Era)))
-> IO (UTxO' (TxOut CtxUTxO Era))
forall a.
HasCallStack =>
NominalDiffTime -> HydraClient -> (Value -> Maybe a) -> IO a
waitMatch NominalDiffTime
10 HydraClient
client ((Value -> Maybe (UTxO' (TxOut CtxUTxO Era)))
-> IO (UTxO' (TxOut CtxUTxO Era)))
-> (Value -> Maybe (UTxO' (TxOut CtxUTxO Era)))
-> IO (UTxO' (TxOut CtxUTxO Era))
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"SnapshotConfirmed"
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$
Tx Era -> Value
forall a. ToJSON a => a -> Value
toJSON Tx Era
tx
Value -> [Value] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` (Value
v Value -> Getting (Endo [Value]) Value Value -> [Value]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"snapshot" Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"confirmed" Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
-> Getting (Endo [Value]) Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Value]) Value Value
forall t. AsValue t => IndexedTraversal' Int t Value
IndexedTraversal' Int Value Value
values)
Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"snapshot" Getting (First Value) Value Value
-> Getting (First Value) Value Value
-> Getting (First Value) Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"utxo" Maybe Value
-> (Value -> Maybe (UTxO' (TxOut CtxUTxO Era)))
-> Maybe (UTxO' (TxOut CtxUTxO Era))
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser (UTxO' (TxOut CtxUTxO Era)))
-> Value -> Maybe (UTxO' (TxOut CtxUTxO Era))
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe Value -> Parser (UTxO' (TxOut CtxUTxO Era))
forall a. FromJSON a => Value -> Parser a
parseJSON
refuelIfNeeded ::
ChainBackend backend =>
Tracer IO EndToEndLog ->
backend ->
Actor ->
Coin ->
IO ()
refuelIfNeeded :: forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> Coin -> IO ()
refuelIfNeeded Tracer IO EndToEndLog
tracer backend
backend Actor
actor Coin
amount = do
(VerificationKey PaymentKey
actorVk, SigningKey PaymentKey
_) <- Actor -> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
keysFor Actor
actor
UTxO' (TxOut CtxUTxO Era)
existingUtxo <- backend
-> QueryPoint
-> VerificationKey PaymentKey
-> IO (UTxO' (TxOut CtxUTxO Era))
forall a (m :: * -> *).
(ChainBackend a, MonadIO m, MonadThrow m) =>
a
-> QueryPoint
-> VerificationKey PaymentKey
-> m (UTxO' (TxOut CtxUTxO Era))
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
backend
-> QueryPoint
-> VerificationKey PaymentKey
-> m (UTxO' (TxOut CtxUTxO Era))
Backend.queryUTxOFor backend
backend QueryPoint
QueryTip VerificationKey PaymentKey
actorVk
Tracer IO EndToEndLog -> EndToEndLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO EndToEndLog
tracer (EndToEndLog -> IO ()) -> EndToEndLog -> IO ()
forall a b. (a -> b) -> a -> b
$ StartingFunds{$sel:actor:ClusterOptions :: String
actor = Actor -> String
actorName Actor
actor, $sel:utxo:ClusterOptions :: UTxO' (TxOut CtxUTxO Era)
utxo = UTxO' (TxOut CtxUTxO Era)
existingUtxo}
let currentBalance :: Coin
currentBalance = Value -> Coin
selectLovelace (Value -> Coin) -> Value -> Coin
forall a b. (a -> b) -> a -> b
$ forall tx. IsTx tx => UTxOType tx -> ValueType tx
balance @Tx UTxO' (TxOut CtxUTxO Era)
UTxOType (Tx Era)
existingUtxo
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Coin
currentBalance Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
< Coin
amount) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
UTxO' (TxOut CtxUTxO Era)
utxo <- backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
forall backend.
ChainBackend backend =>
backend
-> VerificationKey PaymentKey
-> Coin
-> Tracer IO FaucetLog
-> IO (UTxO' (TxOut CtxUTxO Era))
seedFromFaucet backend
backend VerificationKey PaymentKey
actorVk Coin
amount ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
Tracer IO EndToEndLog -> EndToEndLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO EndToEndLog
tracer (EndToEndLog -> IO ()) -> EndToEndLog -> IO ()
forall a b. (a -> b) -> a -> b
$ RefueledFunds{$sel:actor:ClusterOptions :: String
actor = Actor -> String
actorName Actor
actor, $sel:refuelingAmount:ClusterOptions :: Coin
refuelingAmount = Coin
amount, UTxO' (TxOut CtxUTxO Era)
$sel:utxo:ClusterOptions :: UTxO' (TxOut CtxUTxO Era)
utxo :: UTxO' (TxOut CtxUTxO Era)
utxo}
returnFundsToFaucet ::
ChainBackend backend =>
Tracer IO EndToEndLog ->
backend ->
Actor ->
IO ()
returnFundsToFaucet :: forall backend.
ChainBackend backend =>
Tracer IO EndToEndLog -> backend -> Actor -> IO ()
returnFundsToFaucet Tracer IO EndToEndLog
tracer =
Tracer IO FaucetLog -> backend -> Actor -> IO ()
forall backend.
ChainBackend backend =>
Tracer IO FaucetLog -> backend -> Actor -> IO ()
Faucet.returnFundsToFaucet ((FaucetLog -> EndToEndLog)
-> Tracer IO EndToEndLog -> Tracer IO FaucetLog
forall a' a. (a' -> a) -> Tracer IO a -> Tracer IO a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap FaucetLog -> EndToEndLog
FromFaucet Tracer IO EndToEndLog
tracer)
headIsInitializingWith :: Set Party -> Value -> Maybe HeadId
headIsInitializingWith :: Set Party -> Value -> Maybe HeadId
headIsInitializingWith Set Party
expectedParties Value
v = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"HeadIsInitializing"
Set Party
parties <- Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"parties" Maybe Value -> (Value -> Maybe (Set Party)) -> Maybe (Set Party)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser (Set Party)) -> Value -> Maybe (Set Party)
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe Value -> Parser (Set Party)
forall a. FromJSON a => Value -> Parser a
parseJSON
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Set Party
parties Set Party -> Set Party -> Bool
forall a. Eq a => a -> a -> Bool
== Set Party
expectedParties
Value
headId <- Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"headId"
(Value -> Parser HeadId) -> Value -> Maybe HeadId
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe Value -> Parser HeadId
forall a. FromJSON a => Value -> Parser a
parseJSON Value
headId
checkFanout :: HeadId -> UTxO -> Value -> Maybe ()
checkFanout :: HeadId -> UTxO' (TxOut CtxUTxO Era) -> Value -> Maybe ()
checkFanout HeadId
expectedHeadId UTxO' (TxOut CtxUTxO Era)
expectedUTxO Value
v = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"tag" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"HeadIsFinalized"
HeadId
headId' <- Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"headId" Maybe Value -> (Value -> Maybe HeadId) -> Maybe HeadId
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser HeadId) -> Value -> Maybe HeadId
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe Value -> Parser HeadId
forall a. FromJSON a => Value -> Parser a
parseJSON
UTxO' (TxOut CtxUTxO Era)
utxo <- Value
v Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"utxo" Maybe Value
-> (Value -> Maybe (UTxO' (TxOut CtxUTxO Era)))
-> Maybe (UTxO' (TxOut CtxUTxO Era))
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser (UTxO' (TxOut CtxUTxO Era)))
-> Value -> Maybe (UTxO' (TxOut CtxUTxO Era))
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe Value -> Parser (UTxO' (TxOut CtxUTxO Era))
forall a. FromJSON a => Value -> Parser a
parseJSON
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (HeadId
headId' HeadId -> HeadId -> Bool
forall a. Eq a => a -> a -> Bool
== HeadId
expectedHeadId)
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (UTxO' (TxOut CtxUTxO Era) -> UTxO' (TxOut CtxUTxO Era) -> Bool
forall out. Eq out => UTxO' out -> UTxO' out -> Bool
UTxO.containsOutputs UTxO' (TxOut CtxUTxO Era)
utxo UTxO' (TxOut CtxUTxO Era)
expectedUTxO)
expectErrorStatus ::
Int ->
Maybe ByteString ->
HttpException ->
Bool
expectErrorStatus :: Int -> Maybe ByteString -> Selector HttpException
expectErrorStatus
Int
stat
Maybe ByteString
mbodyContains
( VanillaHttpException
( L.HttpExceptionRequest
Request
_
(L.StatusCodeException Response ()
response ByteString
chunk)
)
) =
Response () -> Status
forall body. Response body -> Status
L.responseStatus Response ()
response Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Status
forall a. Enum a => Int -> a
toEnum Int
stat Bool -> Bool -> Bool
&& Bool -> Bool
not (ByteString -> Bool
B.null ByteString
chunk) Bool -> Bool -> Bool
&& Maybe ByteString -> ByteString -> Bool
assertBodyContains Maybe ByteString
mbodyContains ByteString
chunk
where
assertBodyContains :: Maybe ByteString -> ByteString -> Bool
assertBodyContains :: Maybe ByteString -> ByteString -> Bool
assertBodyContains (Just ByteString
bodyContains) ByteString
bodyChunk = ByteString
bodyContains ByteString -> ByteString -> Bool
`isInfixOf` ByteString
bodyChunk
assertBodyContains Maybe ByteString
Nothing ByteString
_ = Bool
False
expectErrorStatus Int
_ Maybe ByteString
_ HttpException
_ = Bool
False