{-# LANGUAGE DuplicateRecordFields #-}

module Hydra.BehaviorSpec where

import Hydra.Prelude
import Test.Hydra.Prelude hiding (shouldBe, shouldNotBe, shouldReturn, shouldSatisfy)

import Control.Concurrent.Class.MonadSTM (
  MonadLabelledSTM,
  modifyTVar,
  modifyTVar',
  newTQueue,
  newTVarIO,
  readTQueue,
  readTVarIO,
  stateTVar,
  writeTQueue,
  writeTVar,
 )
import Control.Monad.Class.MonadAsync (Async, MonadAsync (async), cancel, forConcurrently)
import Control.Monad.IOSim (IOSim, runSimTrace, selectTraceEventsDynamic)
import Data.List ((!!))
import Data.List qualified as List
import Hydra.API.ClientInput
import Hydra.API.Server (Server (..), mkTimedServerOutputFromStateEvent)
import Hydra.API.ServerOutput (ClientMessage (..), DecommitInvalidReason (..), ServerOutput (..), TimedServerOutput (..))
import Hydra.Cardano.Api (SigningKey)
import Hydra.Chain (
  Chain (..),
  ChainEvent (..),
  OnChainTx (..),
  PostChainTx (..),
  initHistory,
 )
import Hydra.Chain.ChainState (ChainSlot (ChainSlot), ChainStateType, IsChainState, chainStateSlot)
import Hydra.Chain.Direct.Handlers (getLatest, newLocalChainState, pushNew, rollback)
import Hydra.Events (EventSink (..))
import Hydra.HeadLogic (CoordinatedHeadState (..), Effect (..), HeadState (..), IdleState (..), InitialState (..), Input (..), OpenState (..), defaultTTL)
import Hydra.HeadLogicSpec (testSnapshot)
import Hydra.Ledger (Ledger, nextChainSlot)
import Hydra.Ledger.Simple (SimpleChainState (..), SimpleTx (..), aValidTx, simpleLedger, utxoRef, utxoRefs)
import Hydra.Logging (Tracer)
import Hydra.Network (Network (..))
import Hydra.Network.Message (Message, NetworkEvent (..))
import Hydra.Node (DraftHydraNode (..), HydraNode (..), HydraNodeLog (..), connect, createNodeState, queryHeadState, runHydraNode, waitDelay)
import Hydra.Node.DepositPeriod (DepositPeriod (..))
import Hydra.Node.DepositPeriod qualified as DP
import Hydra.Node.Environment (Environment (..))
import Hydra.Node.InputQueue (InputQueue (enqueue), createInputQueue)
import Hydra.NodeSpec (createMockSourceSink)
import Hydra.Options (defaultContestationPeriod, defaultDepositPeriod)
import Hydra.Tx (HeadId)
import Hydra.Tx.ContestationPeriod (ContestationPeriod)
import Hydra.Tx.ContestationPeriod qualified as CP
import Hydra.Tx.Crypto (HydraKey, aggregate, sign)
import Hydra.Tx.IsTx (IsTx (..))
import Hydra.Tx.Party (Party (..), deriveParty, getParty)
import Hydra.Tx.Snapshot (Snapshot (..), SnapshotNumber, getSnapshot)
import Test.Hydra.Tx.Fixture (
  alice,
  aliceSk,
  bob,
  bobSk,
  deriveOnChainId,
  testHeadId,
  testHeadSeed,
 )
import Test.QuickCheck (chooseEnum, counterexample, forAll, getNegative, ioProperty)
import Test.Util (
  propRunInSim,
  shouldBe,
  shouldNotBe,
  shouldRunInSim,
  shouldSatisfy,
  traceInIOSim,
 )

spec :: Spec
spec :: Spec
spec = Spec -> Spec
forall a. SpecWith a -> SpecWith a
parallel (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Sanity tests of test suite" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"does not delay for real" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      -- If it works, it simulates a lot of time passing within 1 second
      NominalDiffTime -> IO () -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTimer m, MonadThrow m) =>
NominalDiffTime -> m a -> m a
failAfter NominalDiffTime
1 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
          DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
600

  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Single participant Head" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"accepts Init command" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n ->
            TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n ClientInput SimpleTx
forall tx. ClientInput tx
Init

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"accepts Commit after successful Init" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 -> do
            TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Init
            [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> [Party] -> ServerOutput SimpleTx
forall tx. HeadId -> [Party] -> ServerOutput tx
HeadIsInitializing HeadId
testHeadId ([Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice])
            SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId -> Party -> UTxOType SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> Party -> UTxOType tx -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Party
alice (Integer -> UTxOType SimpleTx
utxoRef Integer
1)
            [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> Party -> UTxOType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> Party -> UTxOType tx -> ServerOutput tx
Committed HeadId
testHeadId Party
alice (Integer -> UTxOType SimpleTx
utxoRef Integer
1)

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"can close an open head" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 -> do
            TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Init
            [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> [Party] -> ServerOutput SimpleTx
forall tx. HeadId -> [Party] -> ServerOutput tx
HeadIsInitializing HeadId
testHeadId ([Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice])
            SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId -> Party -> UTxOType SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> Party -> UTxOType tx -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Party
alice (Integer -> UTxOType SimpleTx
utxoRef Integer
1)
            [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> Party -> UTxOType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> Party -> UTxOType tx -> ServerOutput tx
Committed HeadId
testHeadId Party
alice (Integer -> UTxOType SimpleTx
utxoRef Integer
1)
            [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsOpen{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:NetworkConnected :: UTxOType SimpleTx
utxo = Integer -> UTxOType SimpleTx
utxoRef Integer
1}
            TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Close
            TestHydraClient SimpleTx (IOSim s)
-> IOSim s (ServerOutput SimpleTx)
forall tx (m :: * -> *).
TestHydraClient tx m -> m (ServerOutput tx)
waitForNext TestHydraClient SimpleTx (IOSim s)
n1 IOSim s (ServerOutput SimpleTx)
-> (ServerOutput SimpleTx -> IOSim s ()) -> IOSim s ()
forall a b. IOSim s a -> (a -> IOSim s b) -> IOSim s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m) =>
ServerOutput tx -> m ()
assertHeadIsClosed

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"does not fanout automatically" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 -> do
            TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Init
            [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> [Party] -> ServerOutput SimpleTx
forall tx. HeadId -> [Party] -> ServerOutput tx
HeadIsInitializing HeadId
testHeadId ([Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice])
            SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId -> Party -> UTxOType SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> Party -> UTxOType tx -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Party
alice (Integer -> UTxOType SimpleTx
utxoRef Integer
1)
            [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> Party -> UTxOType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> Party -> UTxOType tx -> ServerOutput tx
Committed HeadId
testHeadId Party
alice (Integer -> UTxOType SimpleTx
utxoRef Integer
1)
            [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsOpen{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:NetworkConnected :: UTxOType SimpleTx
utxo = Integer -> UTxOType SimpleTx
utxoRef Integer
1}
            TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Close
            TestHydraClient SimpleTx (IOSim s)
-> IOSim s (ServerOutput SimpleTx)
forall tx (m :: * -> *).
TestHydraClient tx m -> m (ServerOutput tx)
waitForNext TestHydraClient SimpleTx (IOSim s)
n1 IOSim s (ServerOutput SimpleTx)
-> (ServerOutput SimpleTx -> IOSim s ()) -> IOSim s ()
forall a b. IOSim s a -> (a -> IOSim s b) -> IOSim s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m) =>
ServerOutput tx -> m ()
assertHeadIsClosed
            [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> ServerOutput SimpleTx
forall tx. HeadId -> ServerOutput tx
ReadyToFanout HeadId
testHeadId
            TestHydraClient SimpleTx (IOSim s) -> NominalDiffTime -> IOSim s ()
forall (m :: * -> *) tx.
(MonadTimer m, MonadThrow m, IsChainState tx) =>
TestHydraClient tx m -> NominalDiffTime -> m ()
nothingHappensFor TestHydraClient SimpleTx (IOSim s)
n1 NominalDiffTime
1000000

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"does finalize head after contestation period upon command" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 -> do
            TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Init
            [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> [Party] -> ServerOutput SimpleTx
forall tx. HeadId -> [Party] -> ServerOutput tx
HeadIsInitializing HeadId
testHeadId ([Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice])
            SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId -> Party -> UTxOType SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> Party -> UTxOType tx -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Party
alice (Integer -> UTxOType SimpleTx
utxoRef Integer
1)
            [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> Party -> UTxOType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> Party -> UTxOType tx -> ServerOutput tx
Committed HeadId
testHeadId Party
alice (Integer -> UTxOType SimpleTx
utxoRef Integer
1)
            [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsOpen{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:NetworkConnected :: UTxOType SimpleTx
utxo = Integer -> UTxOType SimpleTx
utxoRef Integer
1}
            TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Close
            TestHydraClient SimpleTx (IOSim s)
-> IOSim s (ServerOutput SimpleTx)
forall tx (m :: * -> *).
TestHydraClient tx m -> m (ServerOutput tx)
waitForNext TestHydraClient SimpleTx (IOSim s)
n1 IOSim s (ServerOutput SimpleTx)
-> (ServerOutput SimpleTx -> IOSim s ()) -> IOSim s ()
forall a b. IOSim s a -> (a -> IOSim s b) -> IOSim s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m) =>
ServerOutput tx -> m ()
assertHeadIsClosed
            [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> ServerOutput SimpleTx
forall tx. HeadId -> ServerOutput tx
ReadyToFanout HeadId
testHeadId
            TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Fanout
            [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:NetworkConnected :: UTxOType SimpleTx
utxo = Integer -> UTxOType SimpleTx
utxoRef Integer
1}

  -- XXX: Restructure test suites as it makes more sense to speak about
  -- features rather than head structure
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Two participant Head" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"only opens the head after all nodes committed" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 ->
            SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
              TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Init
              [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> [Party] -> ServerOutput SimpleTx
forall tx. HeadId -> [Party] -> ServerOutput tx
HeadIsInitializing HeadId
testHeadId ([Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice, Item [Party]
Party
bob])

              SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId -> Party -> UTxOType SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> Party -> UTxOType tx -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Party
alice (Integer -> UTxOType SimpleTx
utxoRef Integer
1)
              [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> Party -> UTxOType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> Party -> UTxOType tx -> ServerOutput tx
Committed HeadId
testHeadId Party
alice (Integer -> UTxOType SimpleTx
utxoRef Integer
1)
              let veryLong :: IOSim s a -> IOSim s (Maybe a)
veryLong = DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall a. DiffTime -> IOSim s a -> IOSim s (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
1000000
              IOSim s (ServerOutput SimpleTx)
-> IOSim s (Maybe (ServerOutput SimpleTx))
forall {a}. IOSim s a -> IOSim s (Maybe a)
veryLong (TestHydraClient SimpleTx (IOSim s)
-> IOSim s (ServerOutput SimpleTx)
forall tx (m :: * -> *).
TestHydraClient tx m -> m (ServerOutput tx)
waitForNext TestHydraClient SimpleTx (IOSim s)
n1) IOSim s (Maybe (ServerOutput SimpleTx))
-> (Maybe (ServerOutput SimpleTx) -> IOSim s ()) -> IOSim s ()
forall a b. IOSim s a -> (a -> IOSim s b) -> IOSim s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe (ServerOutput SimpleTx)
-> Maybe (ServerOutput SimpleTx) -> IOSim s ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m, Eq a, Show a) =>
a -> a -> m ()
`shouldNotBe` ServerOutput SimpleTx -> Maybe (ServerOutput SimpleTx)
forall a. a -> Maybe a
Just HeadIsOpen{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:NetworkConnected :: UTxOType SimpleTx
utxo = Integer -> UTxOType SimpleTx
utxoRef Integer
1})

              SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId -> Party -> UTxOType SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> Party -> UTxOType tx -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Party
bob (Integer -> UTxOType SimpleTx
utxoRef Integer
2)
              [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> Party -> UTxOType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> Party -> UTxOType tx -> ServerOutput tx
Committed HeadId
testHeadId Party
bob (Integer -> UTxOType SimpleTx
utxoRef Integer
2)
              [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsOpen{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:NetworkConnected :: UTxOType SimpleTx
utxo = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1, Integer
2]}

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"can abort and re-open a head when one party has not committed" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 ->
            SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
              TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Init
              [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> [Party] -> ServerOutput SimpleTx
forall tx. HeadId -> [Party] -> ServerOutput tx
HeadIsInitializing HeadId
testHeadId ([Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice, Item [Party]
Party
bob])
              SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId -> Party -> UTxOType SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> Party -> UTxOType tx -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Party
alice ([Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1, Integer
2])
              [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> Party -> UTxOType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> Party -> UTxOType tx -> ServerOutput tx
Committed HeadId
testHeadId Party
alice ([Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1, Integer
2])
              TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 ClientInput SimpleTx
forall tx. ClientInput tx
Abort
              [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsAborted{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:NetworkConnected :: UTxOType SimpleTx
utxo = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1, Integer
2]}
              TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Init
              [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> [Party] -> ServerOutput SimpleTx
forall tx. HeadId -> [Party] -> ServerOutput tx
HeadIsInitializing HeadId
testHeadId ([Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice, Item [Party]
Party
bob])

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"cannot abort head when commits have been collected" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 ->
            SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
              TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Init
              [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> [Party] -> ServerOutput SimpleTx
forall tx. HeadId -> [Party] -> ServerOutput tx
HeadIsInitializing HeadId
testHeadId ([Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice, Item [Party]
Party
bob])
              SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId -> Party -> UTxOType SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> Party -> UTxOType tx -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Party
alice (Integer -> UTxOType SimpleTx
utxoRef Integer
1)
              SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId -> Party -> UTxOType SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> Party -> UTxOType tx -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Party
bob (Integer -> UTxOType SimpleTx
utxoRef Integer
2)

              [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsOpen{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:NetworkConnected :: UTxOType SimpleTx
utxo = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1, Integer
2]}

              TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Abort

              ClientMessage SimpleTx
m <- TestHydraClient SimpleTx (IOSim s)
-> IOSim s (ClientMessage SimpleTx)
forall tx (m :: * -> *).
TestHydraClient tx m -> m (ClientMessage tx)
waitForNextMessage TestHydraClient SimpleTx (IOSim s)
n1
              ClientMessage SimpleTx
m ClientMessage SimpleTx
-> (ClientMessage SimpleTx -> Bool) -> IOSim s ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m, Show a) =>
a -> (a -> Bool) -> m ()
`shouldSatisfy` \case
                CommandFailed{} -> Bool
True
                ClientMessage SimpleTx
_ -> Bool
False

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"ignores head initialization of other head" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 ->
            SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
              TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Init
              [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> [Party] -> ServerOutput SimpleTx
forall tx. HeadId -> [Party] -> ServerOutput tx
HeadIsInitializing HeadId
testHeadId ([Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice])
              -- We expect bob to ignore alice's head which he is not part of
              -- although bob's configuration would includes alice as a
              -- peerconfigured)
              [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                IgnoredHeadInitializing{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, [Party]
parties :: [Party]
$sel:parties:NetworkConnected :: forall tx. ServerOutput tx -> [Party]
parties} ->
                  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ HeadId
headId HeadId -> HeadId -> Bool
forall a. Eq a => a -> a -> Bool
== HeadId
testHeadId Bool -> Bool -> Bool
&& [Party]
parties [Party] -> [Party] -> Bool
forall a. Eq a => a -> a -> Bool
== [Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice]
                ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"outputs committed utxo when client requests it" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 ->
            SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
              TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Init
              [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> [Party] -> ServerOutput SimpleTx
forall tx. HeadId -> [Party] -> ServerOutput tx
HeadIsInitializing HeadId
testHeadId ([Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice, Item [Party]
Party
bob])
              SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId -> Party -> UTxOType SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> Party -> UTxOType tx -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Party
alice (Integer -> UTxOType SimpleTx
utxoRef Integer
1)

              [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> Party -> UTxOType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> Party -> UTxOType tx -> ServerOutput tx
Committed HeadId
testHeadId Party
alice (Integer -> UTxOType SimpleTx
utxoRef Integer
1)
              Maybe (Set SimpleTxOut)
headUTxO <- HeadState SimpleTx -> Maybe (Set SimpleTxOut)
HeadState SimpleTx -> Maybe (UTxOType SimpleTx)
forall tx. IsTx tx => HeadState tx -> Maybe (UTxOType tx)
getHeadUTxO (HeadState SimpleTx -> Maybe (Set SimpleTxOut))
-> IOSim s (HeadState SimpleTx)
-> IOSim s (Maybe (Set SimpleTxOut))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestHydraClient SimpleTx (IOSim s) -> IOSim s (HeadState SimpleTx)
forall tx (m :: * -> *). TestHydraClient tx m -> m (HeadState tx)
queryState TestHydraClient SimpleTx (IOSim s)
n1
              Set SimpleTxOut -> Maybe (Set SimpleTxOut) -> Set SimpleTxOut
forall a. a -> Maybe a -> a
fromMaybe Set SimpleTxOut
forall a. Monoid a => a
mempty Maybe (Set SimpleTxOut)
headUTxO Set SimpleTxOut -> Set SimpleTxOut -> IOSim s ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m, Eq a, Show a) =>
a -> a -> m ()
`shouldBe` [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1]

    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"in an open head" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"sees the head closed by other nodes" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
            SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 ->
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
                SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2

                TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Close
                TestHydraClient SimpleTx (IOSim s)
-> IOSim s (ServerOutput SimpleTx)
forall tx (m :: * -> *).
TestHydraClient tx m -> m (ServerOutput tx)
waitForNext TestHydraClient SimpleTx (IOSim s)
n2
                  IOSim s (ServerOutput SimpleTx)
-> (ServerOutput SimpleTx -> IOSim s ()) -> IOSim s ()
forall a b. IOSim s a -> (a -> IOSim s b) -> IOSim s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SnapshotNumber -> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m) =>
SnapshotNumber -> ServerOutput tx -> m ()
assertHeadIsClosedWith SnapshotNumber
0

      String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"valid new transactions are seen by all parties" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
            SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 ->
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
                SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2

                TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx (Integer -> SimpleTx
aValidTx Integer
42))
                [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> TxIdType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> TxIdType tx -> ServerOutput tx
TxValid HeadId
testHeadId Integer
TxIdType SimpleTx
42

      String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"valid new transactions get snapshotted" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
            SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 ->
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
                SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2

                let tx :: SimpleTx
tx = Integer -> SimpleTx
aValidTx Integer
42
                TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx SimpleTx
tx)
                [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> TxIdType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> TxIdType tx -> ServerOutput tx
TxValid HeadId
testHeadId Integer
TxIdType SimpleTx
42

                let snapshot :: Snapshot SimpleTx
snapshot = HeadId
-> SnapshotVersion
-> SnapshotNumber
-> [SimpleTx]
-> UTxOType SimpleTx
-> Maybe (UTxOType SimpleTx)
-> Maybe (UTxOType SimpleTx)
-> Snapshot SimpleTx
forall tx.
HeadId
-> SnapshotVersion
-> SnapshotNumber
-> [tx]
-> UTxOType tx
-> Maybe (UTxOType tx)
-> Maybe (UTxOType tx)
-> Snapshot tx
Snapshot HeadId
testHeadId SnapshotVersion
0 SnapshotNumber
1 [SimpleTx
tx] ([Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1, Integer
2, Integer
42]) Maybe (Set SimpleTxOut)
Maybe (UTxOType SimpleTx)
forall a. Monoid a => a
mempty Maybe (Set SimpleTxOut)
Maybe (UTxOType SimpleTx)
forall a. Monoid a => a
mempty
                    sigs :: MultiSignature (Snapshot SimpleTx)
sigs = [Signature (Snapshot SimpleTx)]
-> MultiSignature (Snapshot SimpleTx)
forall {k} (a :: k). [Signature a] -> MultiSignature a
aggregate [SigningKey HydraKey
-> Snapshot SimpleTx -> Signature (Snapshot SimpleTx)
forall a.
SignableRepresentation a =>
SigningKey HydraKey -> a -> Signature a
sign SigningKey HydraKey
aliceSk Snapshot SimpleTx
snapshot, SigningKey HydraKey
-> Snapshot SimpleTx -> Signature (Snapshot SimpleTx)
forall a.
SignableRepresentation a =>
SigningKey HydraKey -> a -> Signature a
sign SigningKey HydraKey
bobSk Snapshot SimpleTx
snapshot]
                [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId
-> Snapshot SimpleTx
-> MultiSignature (Snapshot SimpleTx)
-> ServerOutput SimpleTx
forall tx.
HeadId
-> Snapshot tx -> MultiSignature (Snapshot tx) -> ServerOutput tx
SnapshotConfirmed HeadId
testHeadId Snapshot SimpleTx
snapshot MultiSignature (Snapshot SimpleTx)
sigs

                TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Close
                TestHydraClient SimpleTx (IOSim s)
-> IOSim s (ServerOutput SimpleTx)
forall tx (m :: * -> *).
TestHydraClient tx m -> m (ServerOutput tx)
waitForNext TestHydraClient SimpleTx (IOSim s)
n1 IOSim s (ServerOutput SimpleTx)
-> (ServerOutput SimpleTx -> IOSim s ()) -> IOSim s ()
forall a b. IOSim s a -> (a -> IOSim s b) -> IOSim s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SnapshotNumber -> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m) =>
SnapshotNumber -> ServerOutput tx -> m ()
assertHeadIsClosedWith SnapshotNumber
1

      String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"snapshots are created as long as transactions to snapshot exist" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
          (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
            SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 ->
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
                SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2

                -- Load the "ingest queue" of the head enough to have still
                -- pending transactions after a first snapshot request by
                -- alice. Note that we are in a deterministic simulation here.
                TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx (SimpleTx -> ClientInput SimpleTx)
-> SimpleTx -> ClientInput SimpleTx
forall a b. (a -> b) -> a -> b
$ Integer -> SimpleTx
aValidTx Integer
40)
                TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx (SimpleTx -> ClientInput SimpleTx)
-> SimpleTx -> ClientInput SimpleTx
forall a b. (a -> b) -> a -> b
$ Integer -> SimpleTx
aValidTx Integer
41)
                TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx (SimpleTx -> ClientInput SimpleTx)
-> SimpleTx -> ClientInput SimpleTx
forall a b. (a -> b) -> a -> b
$ Integer -> SimpleTx
aValidTx Integer
42)

                -- Expect alice to create a snapshot from the first requested
                -- transaction right away which is the current snapshot policy.
                [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                  SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{SnapshotNumber
number :: SnapshotNumber
$sel:number:Snapshot :: forall tx. Snapshot tx -> SnapshotNumber
number, [SimpleTx]
confirmed :: [SimpleTx]
$sel:confirmed:Snapshot :: forall tx. Snapshot tx -> [tx]
confirmed}} ->
                    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ SnapshotNumber
number SnapshotNumber -> SnapshotNumber -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotNumber
1 Bool -> Bool -> Bool
&& [SimpleTx]
confirmed [SimpleTx] -> [SimpleTx] -> Bool
forall a. Eq a => a -> a -> Bool
== [Integer -> SimpleTx
aValidTx Integer
40]
                  ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

                -- Expect bob to also snapshot what did "not fit" into the first
                -- snapshot.
                [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                  SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{SnapshotNumber
$sel:number:Snapshot :: forall tx. Snapshot tx -> SnapshotNumber
number :: SnapshotNumber
number, [SimpleTx]
$sel:confirmed:Snapshot :: forall tx. Snapshot tx -> [tx]
confirmed :: [SimpleTx]
confirmed}} ->
                    -- NOTE: We sort the confirmed to be clear that the order may
                    -- be freely picked by the leader.
                    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ SnapshotNumber
number SnapshotNumber -> SnapshotNumber -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotNumber
2 Bool -> Bool -> Bool
&& [SimpleTx] -> [SimpleTx]
forall a. Ord a => [a] -> [a]
sort [SimpleTx]
confirmed [SimpleTx] -> [SimpleTx] -> Bool
forall a. Eq a => a -> a -> Bool
== [Integer -> SimpleTx
aValidTx Integer
41, Integer -> SimpleTx
aValidTx Integer
42]
                  ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

                -- As there are no pending transactions and snapshots anymore
                -- we expect to continue normally on seeing just another tx.
                TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx (SimpleTx -> ClientInput SimpleTx)
-> SimpleTx -> ClientInput SimpleTx
forall a b. (a -> b) -> a -> b
$ Integer -> SimpleTx
aValidTx Integer
44)
                [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                  SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{SnapshotNumber
$sel:number:Snapshot :: forall tx. Snapshot tx -> SnapshotNumber
number :: SnapshotNumber
number, [SimpleTx]
$sel:confirmed:Snapshot :: forall tx. Snapshot tx -> [tx]
confirmed :: [SimpleTx]
confirmed}} ->
                    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ SnapshotNumber
number SnapshotNumber -> SnapshotNumber -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotNumber
3 Bool -> Bool -> Bool
&& [SimpleTx]
confirmed [SimpleTx] -> [SimpleTx] -> Bool
forall a. Eq a => a -> a -> Bool
== [Integer -> SimpleTx
aValidTx Integer
44]
                  ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

      String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"depending transactions stay pending and are confirmed in order" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
          (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
            SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 -> do
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
                SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                let firstTx :: SimpleTx
firstTx = Integer -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx Integer
1 (Integer -> UTxOType SimpleTx
utxoRef Integer
1) (Integer -> UTxOType SimpleTx
utxoRef Integer
3)
                let secondTx :: SimpleTx
secondTx = Integer -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx Integer
2 (Integer -> UTxOType SimpleTx
utxoRef Integer
3) (Integer -> UTxOType SimpleTx
utxoRef Integer
4)
                -- Expect secondTx to be valid, but not applicable and stay pending
                TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx SimpleTx
secondTx)
                TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx SimpleTx
firstTx)

                -- Expect a snapshot of the firstTx transaction
                [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> TxIdType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> TxIdType tx -> ServerOutput tx
TxValid HeadId
testHeadId Integer
TxIdType SimpleTx
1
                [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ do
                  let snapshot :: Snapshot SimpleTx
snapshot = SnapshotNumber
-> SnapshotVersion
-> [SimpleTx]
-> UTxOType SimpleTx
-> Snapshot SimpleTx
forall tx.
Monoid (UTxOType tx) =>
SnapshotNumber
-> SnapshotVersion -> [tx] -> UTxOType tx -> Snapshot tx
testSnapshot SnapshotNumber
1 SnapshotVersion
0 [SimpleTx
firstTx] ([Integer] -> UTxOType SimpleTx
utxoRefs [Integer
2, Integer
3])
                      sigs :: MultiSignature (Snapshot SimpleTx)
sigs = [Signature (Snapshot SimpleTx)]
-> MultiSignature (Snapshot SimpleTx)
forall {k} (a :: k). [Signature a] -> MultiSignature a
aggregate [SigningKey HydraKey
-> Snapshot SimpleTx -> Signature (Snapshot SimpleTx)
forall a.
SignableRepresentation a =>
SigningKey HydraKey -> a -> Signature a
sign SigningKey HydraKey
aliceSk Snapshot SimpleTx
snapshot, SigningKey HydraKey
-> Snapshot SimpleTx -> Signature (Snapshot SimpleTx)
forall a.
SignableRepresentation a =>
SigningKey HydraKey -> a -> Signature a
sign SigningKey HydraKey
bobSk Snapshot SimpleTx
snapshot]
                  HeadId
-> Snapshot SimpleTx
-> MultiSignature (Snapshot SimpleTx)
-> ServerOutput SimpleTx
forall tx.
HeadId
-> Snapshot tx -> MultiSignature (Snapshot tx) -> ServerOutput tx
SnapshotConfirmed HeadId
testHeadId Snapshot SimpleTx
snapshot MultiSignature (Snapshot SimpleTx)
sigs

                -- Expect a snapshot of the now unblocked secondTx
                [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> TxIdType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> TxIdType tx -> ServerOutput tx
TxValid HeadId
testHeadId Integer
TxIdType SimpleTx
2
                [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ do
                  let snapshot :: Snapshot SimpleTx
snapshot = SnapshotNumber
-> SnapshotVersion
-> [SimpleTx]
-> UTxOType SimpleTx
-> Snapshot SimpleTx
forall tx.
Monoid (UTxOType tx) =>
SnapshotNumber
-> SnapshotVersion -> [tx] -> UTxOType tx -> Snapshot tx
testSnapshot SnapshotNumber
2 SnapshotVersion
0 [SimpleTx
secondTx] ([Integer] -> UTxOType SimpleTx
utxoRefs [Integer
2, Integer
4])
                      sigs :: MultiSignature (Snapshot SimpleTx)
sigs = [Signature (Snapshot SimpleTx)]
-> MultiSignature (Snapshot SimpleTx)
forall {k} (a :: k). [Signature a] -> MultiSignature a
aggregate [SigningKey HydraKey
-> Snapshot SimpleTx -> Signature (Snapshot SimpleTx)
forall a.
SignableRepresentation a =>
SigningKey HydraKey -> a -> Signature a
sign SigningKey HydraKey
aliceSk Snapshot SimpleTx
snapshot, SigningKey HydraKey
-> Snapshot SimpleTx -> Signature (Snapshot SimpleTx)
forall a.
SignableRepresentation a =>
SigningKey HydraKey -> a -> Signature a
sign SigningKey HydraKey
bobSk Snapshot SimpleTx
snapshot]
                  HeadId
-> Snapshot SimpleTx
-> MultiSignature (Snapshot SimpleTx)
-> ServerOutput SimpleTx
forall tx.
HeadId
-> Snapshot tx -> MultiSignature (Snapshot tx) -> ServerOutput tx
SnapshotConfirmed HeadId
testHeadId Snapshot SimpleTx
snapshot MultiSignature (Snapshot SimpleTx)
sigs

      String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"depending transactions expire if not applicable in time" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
          (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
            SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 -> do
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
                SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                let firstTx :: SimpleTx
firstTx = Integer -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx Integer
1 (Integer -> UTxOType SimpleTx
utxoRef Integer
1) (Integer -> UTxOType SimpleTx
utxoRef Integer
3)
                let secondTx :: SimpleTx
secondTx = Integer -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx Integer
2 (Integer -> UTxOType SimpleTx
utxoRef Integer
3) (Integer -> UTxOType SimpleTx
utxoRef Integer
4)
                -- Expect secondTx to be valid, but not applicable and stay pending
                TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx SimpleTx
secondTx)
                -- If we wait too long, secondTx will expire
                DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay (DiffTime -> IOSim s ()) -> DiffTime -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ TTL -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral TTL
defaultTTL DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
waitDelay DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
1
                [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                  TxInvalid{SimpleTx
transaction :: SimpleTx
$sel:transaction:NetworkConnected :: forall tx. ServerOutput tx -> tx
transaction} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ SimpleTx
transaction SimpleTx -> SimpleTx -> Bool
forall a. Eq a => a -> a -> Bool
== SimpleTx
secondTx
                  ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

                TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx SimpleTx
firstTx)
                [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> TxIdType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> TxIdType tx -> ServerOutput tx
TxValid HeadId
testHeadId Integer
TxIdType SimpleTx
1

      String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"sending two conflicting transactions should lead one being confirmed and one expired" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
          (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
            SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 -> do
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
                SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                let tx' :: SimpleTx
tx' =
                      SimpleTx
                        { $sel:txSimpleId:SimpleTx :: Integer
txSimpleId = Integer
1
                        , $sel:txInputs:SimpleTx :: UTxOType SimpleTx
txInputs = Integer -> UTxOType SimpleTx
utxoRef Integer
1
                        , $sel:txOutputs:SimpleTx :: UTxOType SimpleTx
txOutputs = Integer -> UTxOType SimpleTx
utxoRef Integer
10
                        }
                    tx'' :: SimpleTx
tx'' =
                      SimpleTx
                        { $sel:txSimpleId:SimpleTx :: Integer
txSimpleId = Integer
2
                        , $sel:txInputs:SimpleTx :: UTxOType SimpleTx
txInputs = Integer -> UTxOType SimpleTx
utxoRef Integer
1
                        , $sel:txOutputs:SimpleTx :: UTxOType SimpleTx
txOutputs = Integer -> UTxOType SimpleTx
utxoRef Integer
11
                        }
                TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx SimpleTx
tx')
                TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx SimpleTx
tx'')
                [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ do
                  let snapshot :: Snapshot SimpleTx
snapshot = SnapshotNumber
-> SnapshotVersion
-> [SimpleTx]
-> UTxOType SimpleTx
-> Snapshot SimpleTx
forall tx.
Monoid (UTxOType tx) =>
SnapshotNumber
-> SnapshotVersion -> [tx] -> UTxOType tx -> Snapshot tx
testSnapshot SnapshotNumber
1 SnapshotVersion
0 [SimpleTx
tx'] ([Integer] -> UTxOType SimpleTx
utxoRefs [Integer
2, Integer
10])
                      sigs :: MultiSignature (Snapshot SimpleTx)
sigs = [Signature (Snapshot SimpleTx)]
-> MultiSignature (Snapshot SimpleTx)
forall {k} (a :: k). [Signature a] -> MultiSignature a
aggregate [SigningKey HydraKey
-> Snapshot SimpleTx -> Signature (Snapshot SimpleTx)
forall a.
SignableRepresentation a =>
SigningKey HydraKey -> a -> Signature a
sign SigningKey HydraKey
aliceSk Snapshot SimpleTx
snapshot, SigningKey HydraKey
-> Snapshot SimpleTx -> Signature (Snapshot SimpleTx)
forall a.
SignableRepresentation a =>
SigningKey HydraKey -> a -> Signature a
sign SigningKey HydraKey
bobSk Snapshot SimpleTx
snapshot]
                  HeadId
-> Snapshot SimpleTx
-> MultiSignature (Snapshot SimpleTx)
-> ServerOutput SimpleTx
forall tx.
HeadId
-> Snapshot tx -> MultiSignature (Snapshot tx) -> ServerOutput tx
SnapshotConfirmed HeadId
testHeadId Snapshot SimpleTx
snapshot MultiSignature (Snapshot SimpleTx)
sigs
                [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                  TxInvalid{SimpleTx
$sel:transaction:NetworkConnected :: forall tx. ServerOutput tx -> tx
transaction :: SimpleTx
transaction} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ SimpleTx
transaction SimpleTx -> SimpleTx -> Bool
forall a. Eq a => a -> a -> Bool
== SimpleTx
tx''
                  ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

      String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"outputs utxo from confirmed snapshot when client requests it" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
            SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 ->
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
                SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                let newTx :: SimpleTx
newTx = (Integer -> SimpleTx
aValidTx Integer
42){txInputs = utxoRefs [1]}
                TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx SimpleTx
newTx)

                let snapshot :: Snapshot SimpleTx
snapshot = SnapshotNumber
-> SnapshotVersion
-> [SimpleTx]
-> UTxOType SimpleTx
-> Snapshot SimpleTx
forall tx.
Monoid (UTxOType tx) =>
SnapshotNumber
-> SnapshotVersion -> [tx] -> UTxOType tx -> Snapshot tx
testSnapshot SnapshotNumber
1 SnapshotVersion
0 [SimpleTx
newTx] ([Integer] -> UTxOType SimpleTx
utxoRefs [Integer
2, Integer
42])
                    sigs :: MultiSignature (Snapshot SimpleTx)
sigs = [Signature (Snapshot SimpleTx)]
-> MultiSignature (Snapshot SimpleTx)
forall {k} (a :: k). [Signature a] -> MultiSignature a
aggregate [SigningKey HydraKey
-> Snapshot SimpleTx -> Signature (Snapshot SimpleTx)
forall a.
SignableRepresentation a =>
SigningKey HydraKey -> a -> Signature a
sign SigningKey HydraKey
aliceSk Snapshot SimpleTx
snapshot, SigningKey HydraKey
-> Snapshot SimpleTx -> Signature (Snapshot SimpleTx)
forall a.
SignableRepresentation a =>
SigningKey HydraKey -> a -> Signature a
sign SigningKey HydraKey
bobSk Snapshot SimpleTx
snapshot]

                [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId
-> Snapshot SimpleTx
-> MultiSignature (Snapshot SimpleTx)
-> ServerOutput SimpleTx
forall tx.
HeadId
-> Snapshot tx -> MultiSignature (Snapshot tx) -> ServerOutput tx
SnapshotConfirmed HeadId
testHeadId Snapshot SimpleTx
snapshot MultiSignature (Snapshot SimpleTx)
sigs

                Maybe (Set SimpleTxOut)
headUTxO <- HeadState SimpleTx -> Maybe (Set SimpleTxOut)
HeadState SimpleTx -> Maybe (UTxOType SimpleTx)
forall tx. IsTx tx => HeadState tx -> Maybe (UTxOType tx)
getHeadUTxO (HeadState SimpleTx -> Maybe (Set SimpleTxOut))
-> IOSim s (HeadState SimpleTx)
-> IOSim s (Maybe (Set SimpleTxOut))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestHydraClient SimpleTx (IOSim s) -> IOSim s (HeadState SimpleTx)
forall tx (m :: * -> *). TestHydraClient tx m -> m (HeadState tx)
queryState TestHydraClient SimpleTx (IOSim s)
n1
                Set SimpleTxOut -> Maybe (Set SimpleTxOut) -> Set SimpleTxOut
forall a. a -> Maybe a -> a
fromMaybe Set SimpleTxOut
forall a. Monoid a => a
mempty Maybe (Set SimpleTxOut)
headUTxO Set SimpleTxOut -> Set SimpleTxOut -> IOSim s ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m, Eq a, Show a) =>
a -> a -> m ()
`shouldBe` [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
2, Integer
42]

      String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Incremental commit" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
        String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"deposits with empty utxo are ignored" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
          IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Property -> Property) -> IO Property -> Property
forall a b. (a -> b) -> a -> b
$
            (forall s. IOSim s Property) -> IO Property
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s Property) -> IO Property)
-> (forall s. IOSim s Property) -> IO Property
forall a b. (a -> b) -> a -> b
$
              (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s Property)
-> IOSim s Property
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s Property)
 -> IOSim s Property)
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s Property)
-> IOSim s Property
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
                SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s Property)
-> IOSim s Property
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s Property)
 -> IOSim s Property)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s Property)
-> IOSim s Property
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 -> do
                  SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1
                  UTCTime
deadline <- IOSim s UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
newDeadlineFarEnoughFromNow
                  Integer
txid <- SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId
-> UTxOType SimpleTx
-> UTCTime
-> IOSim s (TxIdType SimpleTx)
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> UTxOType tx -> UTCTime -> m (TxIdType tx)
simulateDeposit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Set SimpleTxOut
UTxOType SimpleTx
forall a. Monoid a => a
mempty UTCTime
deadline
                  -- NOTE: Deposit is not picked up and eventually expires
                  Bool
asExpected <- [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe Bool) -> IOSim s Bool
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1] ((ServerOutput SimpleTx -> Maybe Bool) -> IOSim s Bool)
-> (ServerOutput SimpleTx -> Maybe Bool) -> IOSim s Bool
forall a b. (a -> b) -> a -> b
$ \case
                    DepositExpired{TxIdType SimpleTx
depositTxId :: TxIdType SimpleTx
$sel:depositTxId:NetworkConnected :: forall tx. ServerOutput tx -> TxIdType tx
depositTxId} -> Bool
True Bool -> Maybe () -> Maybe Bool
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
TxIdType SimpleTx
depositTxId Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
txid)
                    CommitApproved{} -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                    ServerOutput SimpleTx
_ -> Maybe Bool
forall a. Maybe a
Nothing
                  Property -> IOSim s Property
forall a. a -> IOSim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Property -> IOSim s Property) -> Property -> IOSim s Property
forall a b. (a -> b) -> a -> b
$
                    Bool
asExpected
                      Bool -> (Bool -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"Deposit with empty utxo approved instead of expired"

        String -> (Negative NominalDiffTime -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"deposits with deadline in the past are ignored" ((Negative NominalDiffTime -> Property) -> Spec)
-> (Negative NominalDiffTime -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$ \Negative NominalDiffTime
seconds ->
          IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Property -> Property) -> IO Property -> Property
forall a b. (a -> b) -> a -> b
$
            (forall s. IOSim s Property) -> IO Property
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s Property) -> IO Property)
-> (forall s. IOSim s Property) -> IO Property
forall a b. (a -> b) -> a -> b
$
              (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s Property)
-> IOSim s Property
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s Property)
 -> IOSim s Property)
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s Property)
-> IOSim s Property
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
                SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s Property)
-> IOSim s Property
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s Property)
 -> IOSim s Property)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s Property)
-> IOSim s Property
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 -> do
                  SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1
                  UTCTime
deadlineInThePast <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (Negative NominalDiffTime -> NominalDiffTime
forall a. Negative a -> a
getNegative Negative NominalDiffTime
seconds) (UTCTime -> UTCTime) -> IOSim s UTCTime -> IOSim s UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOSim s UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
                  Integer
txid <- SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId
-> UTxOType SimpleTx
-> UTCTime
-> IOSim s (TxIdType SimpleTx)
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> UTxOType tx -> UTCTime -> m (TxIdType tx)
simulateDeposit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId (Integer -> UTxOType SimpleTx
utxoRef Integer
123) UTCTime
deadlineInThePast
                  Bool
asExpected <- [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe Bool) -> IOSim s Bool
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1] ((ServerOutput SimpleTx -> Maybe Bool) -> IOSim s Bool)
-> (ServerOutput SimpleTx -> Maybe Bool) -> IOSim s Bool
forall a b. (a -> b) -> a -> b
$ \case
                    DepositExpired{TxIdType SimpleTx
$sel:depositTxId:NetworkConnected :: forall tx. ServerOutput tx -> TxIdType tx
depositTxId :: TxIdType SimpleTx
depositTxId} -> Bool
True Bool -> Maybe () -> Maybe Bool
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
TxIdType SimpleTx
depositTxId Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
txid)
                    CommitApproved{} -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                    ServerOutput SimpleTx
_ -> Maybe Bool
forall a. Maybe a
Nothing
                  Property -> IOSim s Property
forall a. a -> IOSim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Property -> IOSim s Property) -> Property -> IOSim s Property
forall a b. (a -> b) -> a -> b
$
                    Bool
asExpected
                      Bool -> (Bool -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"Deposit with deadline in the past approved instead of expired"

        String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"deposits with deadline too soon are ignored" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
          let depositPeriod :: NominalDiffTime
depositPeriod = DepositPeriod -> NominalDiffTime
DP.toNominalDiffTime DepositPeriod
defaultDepositPeriod
          -- NOTE: Any deadline between now and deposit period should
          -- eventually result in an expired deposit.
          Gen NominalDiffTime -> (NominalDiffTime -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll ((NominalDiffTime, NominalDiffTime) -> Gen NominalDiffTime
forall a. Enum a => (a, a) -> Gen a
chooseEnum (NominalDiffTime
0, NominalDiffTime
depositPeriod)) ((NominalDiffTime -> Property) -> Property)
-> (NominalDiffTime -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \NominalDiffTime
deadlineDiff ->
            (forall s. IOSim s Property) -> Property
forall prop. Testable prop => (forall s. IOSim s prop) -> Property
propRunInSim ((forall s. IOSim s Property) -> Property)
-> (forall s. IOSim s Property) -> Property
forall a b. (a -> b) -> a -> b
$
              (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s Property)
-> IOSim s Property
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s Property)
 -> IOSim s Property)
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s Property)
-> IOSim s Property
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
                SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s Property)
-> IOSim s Property
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s Property)
 -> IOSim s Property)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s Property)
-> IOSim s Property
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 -> do
                  SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1
                  UTCTime
deadlineTooEarly <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
deadlineDiff (UTCTime -> UTCTime) -> IOSim s UTCTime -> IOSim s UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOSim s UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
                  Integer
txid <- SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId
-> UTxOType SimpleTx
-> UTCTime
-> IOSim s (TxIdType SimpleTx)
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> UTxOType tx -> UTCTime -> m (TxIdType tx)
simulateDeposit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId (Integer -> UTxOType SimpleTx
utxoRef Integer
123) UTCTime
deadlineTooEarly
                  Bool
asExpected <- [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe Bool) -> IOSim s Bool
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1] ((ServerOutput SimpleTx -> Maybe Bool) -> IOSim s Bool)
-> (ServerOutput SimpleTx -> Maybe Bool) -> IOSim s Bool
forall a b. (a -> b) -> a -> b
$ \case
                    DepositExpired{TxIdType SimpleTx
$sel:depositTxId:NetworkConnected :: forall tx. ServerOutput tx -> TxIdType tx
depositTxId :: TxIdType SimpleTx
depositTxId} -> Bool
True Bool -> Maybe () -> Maybe Bool
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
TxIdType SimpleTx
depositTxId Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
txid)
                    CommitApproved{} -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                    ServerOutput SimpleTx
_ -> Maybe Bool
forall a. Maybe a
Nothing
                  Property -> IOSim s Property
forall a. a -> IOSim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Property -> IOSim s Property) -> Property -> IOSim s Property
forall a b. (a -> b) -> a -> b
$
                    Bool
asExpected
                      Bool -> (Bool -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"Deposit with deadline too soon approved instead of expired"
                      Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Deadline: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UTCTime -> String
forall b a. (Show a, IsString b) => a -> b
show UTCTime
deadlineTooEarly)

        String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"commit snapshot only approved when deadline not too soon" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain -> do
              let dpShort :: DepositPeriod
dpShort = NominalDiffTime -> DepositPeriod
DepositPeriod NominalDiffTime
60
              let dpLong :: DepositPeriod
dpLong = NominalDiffTime -> DepositPeriod
DepositPeriod NominalDiffTime
3600
              DepositPeriod
-> SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s b.
DepositPeriod
-> SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s b)
-> IOSim s b
withHydraNode' DepositPeriod
dpShort SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 ->
                DepositPeriod
-> SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s b.
DepositPeriod
-> SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s b)
-> IOSim s b
withHydraNode' DepositPeriod
dpLong SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
                  SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                  -- NOTE: We use a deadline that is okay for alice, but too soon for bob.
                  UTCTime
deadline <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
600 (UTCTime -> UTCTime) -> IOSim s UTCTime -> IOSim s UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOSim s UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
                  Integer
txid <- SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId
-> UTxOType SimpleTx
-> UTCTime
-> IOSim s (TxIdType SimpleTx)
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> UTxOType tx -> UTCTime -> m (TxIdType tx)
simulateDeposit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId (Integer -> UTxOType SimpleTx
utxoRef Integer
123) UTCTime
deadline
                  [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                    CommitRecorded{UTxOType SimpleTx
utxoToCommit :: UTxOType SimpleTx
$sel:utxoToCommit:NetworkConnected :: forall tx. ServerOutput tx -> UTxOType tx
utxoToCommit} ->
                      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Key (Set SimpleTxOut)
123 Key (Set SimpleTxOut) -> Set SimpleTxOut -> Bool
forall t. StaticMap t => Key t -> t -> Bool
`member` Set SimpleTxOut
UTxOType SimpleTx
utxoToCommit)
                    ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing
                  [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                    DepositExpired{TxIdType SimpleTx
$sel:depositTxId:NetworkConnected :: forall tx. ServerOutput tx -> TxIdType tx
depositTxId :: TxIdType SimpleTx
depositTxId} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Integer
TxIdType SimpleTx
depositTxId Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
txid
                    ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

        String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"deposits are only processed after settled" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          -- TODO: implement for
          -- https://github.com/cardano-scaling/hydra/issues/1951#issuecomment-2809966834
          -- - single node
          -- - submit deposit deadline far enough in future
          -- - recorded right away
          -- - approved only after deposit period passed
          HasCallStack => String -> IO ()
String -> IO ()
pendingWith String
"not implemented"

        String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"commit snapshot only approved when deposit settled" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          -- TODO: implement for
          -- https://github.com/cardano-scaling/hydra/issues/1951#issuecomment-2809966834
          -- - two nodes, one with low deposit period, one with high
          -- - submit deposit
          -- - see it recorded by both nodes
          -- - see it approved only when period of both nodes passed
          HasCallStack => String -> IO ()
String -> IO ()
pendingWith String
"not implemented"

        String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"requested commits get approved" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 ->
                SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
                  SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                  let depositUTxO :: UTxOType SimpleTx
depositUTxO = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
11]
                  UTCTime
deadline <- IOSim s UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
newDeadlineFarEnoughFromNow
                  Integer
depositTxId <- SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId
-> UTxOType SimpleTx
-> UTCTime
-> IOSim s (TxIdType SimpleTx)
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> UTxOType tx -> UTCTime -> m (TxIdType tx)
simulateDeposit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Set SimpleTxOut
UTxOType SimpleTx
depositUTxO UTCTime
deadline
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ CommitRecorded{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxoToCommit:NetworkConnected :: UTxOType SimpleTx
utxoToCommit = Set SimpleTxOut
UTxOType SimpleTx
depositUTxO, $sel:pendingDeposit:NetworkConnected :: TxIdType SimpleTx
pendingDeposit = Integer
TxIdType SimpleTx
depositTxId, UTCTime
deadline :: UTCTime
$sel:deadline:NetworkConnected :: UTCTime
deadline}

                  [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                    SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{Maybe (UTxOType SimpleTx)
utxoToCommit :: Maybe (UTxOType SimpleTx)
$sel:utxoToCommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToCommit}} ->
                      Maybe (Set SimpleTxOut)
Maybe (UTxOType SimpleTx)
utxoToCommit Maybe (Set SimpleTxOut)
-> (Set SimpleTxOut -> Maybe ()) -> Maybe ()
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ())
-> (Set SimpleTxOut -> Bool) -> Set SimpleTxOut -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key (Set SimpleTxOut)
SimpleTxOut
11 `member`)
                    ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ CommitApproved{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxoToCommit:NetworkConnected :: UTxOType SimpleTx
utxoToCommit = Set SimpleTxOut
UTxOType SimpleTx
depositUTxO}
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ CommitFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, Integer
TxIdType SimpleTx
$sel:depositTxId:NetworkConnected :: TxIdType SimpleTx
depositTxId :: Integer
depositTxId}

                  Maybe (Set SimpleTxOut)
headUTxO <- HeadState SimpleTx -> Maybe (Set SimpleTxOut)
HeadState SimpleTx -> Maybe (UTxOType SimpleTx)
forall tx. IsTx tx => HeadState tx -> Maybe (UTxOType tx)
getHeadUTxO (HeadState SimpleTx -> Maybe (Set SimpleTxOut))
-> IOSim s (HeadState SimpleTx)
-> IOSim s (Maybe (Set SimpleTxOut))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestHydraClient SimpleTx (IOSim s) -> IOSim s (HeadState SimpleTx)
forall tx (m :: * -> *). TestHydraClient tx m -> m (HeadState tx)
queryState TestHydraClient SimpleTx (IOSim s)
n1
                  Set SimpleTxOut -> Maybe (Set SimpleTxOut) -> Set SimpleTxOut
forall a. a -> Maybe a -> a
fromMaybe Set SimpleTxOut
forall a. Monoid a => a
mempty Maybe (Set SimpleTxOut)
headUTxO Set SimpleTxOut -> (Set SimpleTxOut -> Bool) -> IOSim s ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m, Show a) =>
a -> (a -> Bool) -> m ()
`shouldSatisfy` Key (Set SimpleTxOut) -> Set SimpleTxOut -> Bool
forall t. StaticMap t => Key t -> t -> Bool
member Key (Set SimpleTxOut)
SimpleTxOut
11

        String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"can process multiple commits" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 ->
                SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
                  SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                  let depositUTxO :: UTxOType SimpleTx
depositUTxO = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
11]
                  let depositUTxO2 :: UTxOType SimpleTx
depositUTxO2 = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
22]
                  UTCTime
deadline <- IOSim s UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
newDeadlineFarEnoughFromNow
                  Integer
deposit1 <- SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId
-> UTxOType SimpleTx
-> UTCTime
-> IOSim s (TxIdType SimpleTx)
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> UTxOType tx -> UTCTime -> m (TxIdType tx)
simulateDeposit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Set SimpleTxOut
UTxOType SimpleTx
depositUTxO UTCTime
deadline
                  Integer
deposit2 <- SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId
-> UTxOType SimpleTx
-> UTCTime
-> IOSim s (TxIdType SimpleTx)
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> UTxOType tx -> UTCTime -> m (TxIdType tx)
simulateDeposit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Set SimpleTxOut
UTxOType SimpleTx
depositUTxO2 UTCTime
deadline
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ CommitRecorded{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxoToCommit:NetworkConnected :: UTxOType SimpleTx
utxoToCommit = Set SimpleTxOut
UTxOType SimpleTx
depositUTxO, $sel:pendingDeposit:NetworkConnected :: TxIdType SimpleTx
pendingDeposit = Integer
TxIdType SimpleTx
deposit1, UTCTime
$sel:deadline:NetworkConnected :: UTCTime
deadline :: UTCTime
deadline}
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ CommitRecorded{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxoToCommit:NetworkConnected :: UTxOType SimpleTx
utxoToCommit = Set SimpleTxOut
UTxOType SimpleTx
depositUTxO2, $sel:pendingDeposit:NetworkConnected :: TxIdType SimpleTx
pendingDeposit = Integer
TxIdType SimpleTx
deposit2, UTCTime
$sel:deadline:NetworkConnected :: UTCTime
deadline :: UTCTime
deadline}
                  [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                    SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{Maybe (UTxOType SimpleTx)
$sel:utxoToCommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToCommit :: Maybe (UTxOType SimpleTx)
utxoToCommit}} ->
                      Maybe (Set SimpleTxOut)
Maybe (UTxOType SimpleTx)
utxoToCommit Maybe (Set SimpleTxOut)
-> (Set SimpleTxOut -> Maybe ()) -> Maybe ()
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ())
-> (Set SimpleTxOut -> Bool) -> Set SimpleTxOut -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key (Set SimpleTxOut)
SimpleTxOut
11 `member`)
                    ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ CommitApproved{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxoToCommit:NetworkConnected :: UTxOType SimpleTx
utxoToCommit = Set SimpleTxOut
UTxOType SimpleTx
depositUTxO}
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ CommitFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:depositTxId:NetworkConnected :: TxIdType SimpleTx
depositTxId = Integer
TxIdType SimpleTx
deposit1}
                  let normalTx :: SimpleTx
normalTx = Integer -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx Integer
3 (Integer -> UTxOType SimpleTx
utxoRef Integer
2) (Integer -> UTxOType SimpleTx
utxoRef Integer
3)
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx SimpleTx
normalTx)
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> TxIdType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> TxIdType tx -> ServerOutput tx
TxValid HeadId
testHeadId Integer
TxIdType SimpleTx
3
                  [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                    SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{Maybe (UTxOType SimpleTx)
$sel:utxoToCommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToCommit :: Maybe (UTxOType SimpleTx)
utxoToCommit}} ->
                      Maybe (Set SimpleTxOut)
Maybe (UTxOType SimpleTx)
utxoToCommit Maybe (Set SimpleTxOut)
-> (Set SimpleTxOut -> Maybe ()) -> Maybe ()
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ())
-> (Set SimpleTxOut -> Bool) -> Set SimpleTxOut -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key (Set SimpleTxOut)
SimpleTxOut
22 `member`)
                    ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ CommitApproved{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxoToCommit:NetworkConnected :: UTxOType SimpleTx
utxoToCommit = Set SimpleTxOut
UTxOType SimpleTx
depositUTxO2}
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ CommitFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:depositTxId:NetworkConnected :: TxIdType SimpleTx
depositTxId = Integer
TxIdType SimpleTx
deposit2}
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Close
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ ReadyToFanout{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId}
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 ClientInput SimpleTx
forall tx. ClientInput tx
Fanout
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:NetworkConnected :: UTxOType SimpleTx
utxo = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1, Integer
3, Integer
11, Integer
22]}

        String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"can process transactions while commit pending" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 ->
                SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
                  SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                  let depositUTxO :: UTxOType SimpleTx
depositUTxO = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
11]
                  UTCTime
deadline <- IOSim s UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
newDeadlineFarEnoughFromNow
                  Integer
depositTxId <- SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId
-> UTxOType SimpleTx
-> UTCTime
-> IOSim s (TxIdType SimpleTx)
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> UTxOType tx -> UTCTime -> m (TxIdType tx)
simulateDeposit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Set SimpleTxOut
UTxOType SimpleTx
depositUTxO UTCTime
deadline
                  [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                    CommitRecorded{UTxOType SimpleTx
$sel:utxoToCommit:NetworkConnected :: forall tx. ServerOutput tx -> UTxOType tx
utxoToCommit :: UTxOType SimpleTx
utxoToCommit} ->
                      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Key (Set SimpleTxOut)
11 Key (Set SimpleTxOut) -> Set SimpleTxOut -> Bool
forall t. StaticMap t => Key t -> t -> Bool
`member` Set SimpleTxOut
UTxOType SimpleTx
utxoToCommit)
                    ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing
                  let normalTx :: SimpleTx
normalTx = Integer -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx Integer
2 (Integer -> UTxOType SimpleTx
utxoRef Integer
2) (Integer -> UTxOType SimpleTx
utxoRef Integer
3)
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx SimpleTx
normalTx)
                  [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                    SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{[SimpleTx]
$sel:confirmed:Snapshot :: forall tx. Snapshot tx -> [tx]
confirmed :: [SimpleTx]
confirmed}} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ SimpleTx
normalTx SimpleTx -> [SimpleTx] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [SimpleTx]
confirmed
                    ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ CommitFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, Integer
TxIdType SimpleTx
$sel:depositTxId:NetworkConnected :: TxIdType SimpleTx
depositTxId :: Integer
depositTxId}
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Close
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ ReadyToFanout{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId}
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 ClientInput SimpleTx
forall tx. ClientInput tx
Fanout
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:NetworkConnected :: UTxOType SimpleTx
utxo = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1, Integer
3, Integer
11]}

        -- XXX: This could be a single node test
        String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"can close with commit in flight" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 -> do
                SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
                  SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                  let depositUTxO :: UTxOType SimpleTx
depositUTxO = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
11]
                  UTCTime
deadline <- IOSim s UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
newDeadlineFarEnoughFromNow
                  Integer
depositTxId <- SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId
-> UTxOType SimpleTx
-> UTCTime
-> IOSim s (TxIdType SimpleTx)
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> UTxOType tx -> UTCTime -> m (TxIdType tx)
simulateDeposit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Set SimpleTxOut
UTxOType SimpleTx
depositUTxO UTCTime
deadline
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ CommitRecorded{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxoToCommit:NetworkConnected :: UTxOType SimpleTx
utxoToCommit = Set SimpleTxOut
UTxOType SimpleTx
depositUTxO, $sel:pendingDeposit:NetworkConnected :: TxIdType SimpleTx
pendingDeposit = Integer
TxIdType SimpleTx
depositTxId, UTCTime
$sel:deadline:NetworkConnected :: UTCTime
deadline :: UTCTime
deadline}
                  [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                    SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{Maybe (UTxOType SimpleTx)
$sel:utxoToCommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToCommit :: Maybe (UTxOType SimpleTx)
utxoToCommit}} ->
                      Maybe (Set SimpleTxOut)
Maybe (UTxOType SimpleTx)
utxoToCommit Maybe (Set SimpleTxOut)
-> (Set SimpleTxOut -> Maybe ()) -> Maybe ()
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ())
-> (Set SimpleTxOut -> Bool) -> Set SimpleTxOut -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key (Set SimpleTxOut)
SimpleTxOut
11 `member`)
                    ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Close
                  [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                    HeadIsClosed{SnapshotNumber
snapshotNumber :: SnapshotNumber
$sel:snapshotNumber:NetworkConnected :: forall tx. ServerOutput tx -> SnapshotNumber
snapshotNumber} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ SnapshotNumber
snapshotNumber SnapshotNumber -> SnapshotNumber -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotNumber
1
                    ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ ReadyToFanout{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId}
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 ClientInput SimpleTx
forall tx. ClientInput tx
Fanout
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:NetworkConnected :: UTxOType SimpleTx
utxo = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1, Integer
2, Integer
11]}

        -- XXX: This could be a single node test
        String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"fanout utxo is correct after a commit" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 -> do
                SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
                  SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                  let depositUTxO :: UTxOType SimpleTx
depositUTxO = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
11]
                  UTCTime
deadline <- IOSim s UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
newDeadlineFarEnoughFromNow
                  Integer
depositTxId <- SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId
-> UTxOType SimpleTx
-> UTCTime
-> IOSim s (TxIdType SimpleTx)
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> UTxOType tx -> UTCTime -> m (TxIdType tx)
simulateDeposit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Set SimpleTxOut
UTxOType SimpleTx
depositUTxO UTCTime
deadline
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ CommitRecorded{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxoToCommit:NetworkConnected :: UTxOType SimpleTx
utxoToCommit = Set SimpleTxOut
UTxOType SimpleTx
depositUTxO, $sel:pendingDeposit:NetworkConnected :: TxIdType SimpleTx
pendingDeposit = Integer
TxIdType SimpleTx
depositTxId, UTCTime
$sel:deadline:NetworkConnected :: UTCTime
deadline :: UTCTime
deadline}
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Close
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ ReadyToFanout{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId}
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 ClientInput SimpleTx
forall tx. ClientInput tx
Fanout
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:NetworkConnected :: UTxOType SimpleTx
utxo = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1, Integer
2]}

        -- XXX: This could be a single node test
        String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"multiple commits and decommits in sequence" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 -> do
                SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
                  SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                  let depositUTxO :: UTxOType SimpleTx
depositUTxO = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
11]
                  UTCTime
deadline <- IOSim s UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
newDeadlineFarEnoughFromNow
                  Integer
depositTxId <- SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId
-> UTxOType SimpleTx
-> UTCTime
-> IOSim s (TxIdType SimpleTx)
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> UTxOType tx -> UTCTime -> m (TxIdType tx)
simulateDeposit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Set SimpleTxOut
UTxOType SimpleTx
depositUTxO UTCTime
deadline
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ CommitRecorded{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxoToCommit:NetworkConnected :: UTxOType SimpleTx
utxoToCommit = Set SimpleTxOut
UTxOType SimpleTx
depositUTxO, $sel:pendingDeposit:NetworkConnected :: TxIdType SimpleTx
pendingDeposit = Integer
TxIdType SimpleTx
depositTxId, UTCTime
$sel:deadline:NetworkConnected :: UTCTime
deadline :: UTCTime
deadline}
                  [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                    SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{Maybe (UTxOType SimpleTx)
$sel:utxoToCommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToCommit :: Maybe (UTxOType SimpleTx)
utxoToCommit}} ->
                      Maybe (Set SimpleTxOut)
Maybe (UTxOType SimpleTx)
utxoToCommit Maybe (Set SimpleTxOut)
-> (Set SimpleTxOut -> Maybe ()) -> Maybe ()
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ())
-> (Set SimpleTxOut -> Bool) -> Set SimpleTxOut -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key (Set SimpleTxOut)
SimpleTxOut
11 `member`)
                    ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ CommitFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, Integer
TxIdType SimpleTx
$sel:depositTxId:NetworkConnected :: TxIdType SimpleTx
depositTxId :: Integer
depositTxId}

                  let decommitTx :: SimpleTx
decommitTx = Integer -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx Integer
1 (Integer -> UTxOType SimpleTx
utxoRef Integer
1) (Integer -> UTxOType SimpleTx
utxoRef Integer
42)
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
Decommit SimpleTx
decommitTx)
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                    DecommitRequested{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, SimpleTx
decommitTx :: SimpleTx
$sel:decommitTx:NetworkConnected :: SimpleTx
decommitTx, $sel:utxoToDecommit:NetworkConnected :: UTxOType SimpleTx
utxoToDecommit = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
42]}

                  [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                    SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{Maybe (UTxOType SimpleTx)
utxoToDecommit :: Maybe (UTxOType SimpleTx)
$sel:utxoToDecommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToDecommit}} ->
                      Maybe (Set SimpleTxOut)
Maybe (UTxOType SimpleTx)
utxoToDecommit Maybe (Set SimpleTxOut)
-> (Set SimpleTxOut -> Maybe ()) -> Maybe ()
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ())
-> (Set SimpleTxOut -> Bool) -> Set SimpleTxOut -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key (Set SimpleTxOut)
SimpleTxOut
42 `member`)
                    ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ DecommitApproved{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:decommitTxId:NetworkConnected :: TxIdType SimpleTx
decommitTxId = SimpleTx -> TxIdType SimpleTx
forall tx. IsTx tx => tx -> TxIdType tx
txId SimpleTx
decommitTx, $sel:utxoToDecommit:NetworkConnected :: UTxOType SimpleTx
utxoToDecommit = Integer -> UTxOType SimpleTx
utxoRef Integer
42}
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ DecommitFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:distributedUTxO:NetworkConnected :: UTxOType SimpleTx
distributedUTxO = Integer -> UTxOType SimpleTx
utxoRef Integer
42}
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Close
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ ReadyToFanout{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId}
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 ClientInput SimpleTx
forall tx. ClientInput tx
Fanout
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:NetworkConnected :: UTxOType SimpleTx
utxo = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
2, Integer
11]}

        String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"commit and decommit same utxo" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 -> do
                SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
                  SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                  let depositUTxO :: UTxOType SimpleTx
depositUTxO = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
11]
                  UTCTime
deadline <- IOSim s UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
newDeadlineFarEnoughFromNow
                  Integer
depositTxId <- SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId
-> UTxOType SimpleTx
-> UTCTime
-> IOSim s (TxIdType SimpleTx)
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> UTxOType tx -> UTCTime -> m (TxIdType tx)
simulateDeposit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Set SimpleTxOut
UTxOType SimpleTx
depositUTxO UTCTime
deadline
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ CommitRecorded{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxoToCommit:NetworkConnected :: UTxOType SimpleTx
utxoToCommit = Set SimpleTxOut
UTxOType SimpleTx
depositUTxO, $sel:pendingDeposit:NetworkConnected :: TxIdType SimpleTx
pendingDeposit = Integer
TxIdType SimpleTx
depositTxId, UTCTime
$sel:deadline:NetworkConnected :: UTCTime
deadline :: UTCTime
deadline}
                  [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                    SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{Maybe (UTxOType SimpleTx)
$sel:utxoToCommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToCommit :: Maybe (UTxOType SimpleTx)
utxoToCommit}} ->
                      Maybe (Set SimpleTxOut)
Maybe (UTxOType SimpleTx)
utxoToCommit Maybe (Set SimpleTxOut)
-> (Set SimpleTxOut -> Maybe ()) -> Maybe ()
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ())
-> (Set SimpleTxOut -> Bool) -> Set SimpleTxOut -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key (Set SimpleTxOut)
SimpleTxOut
11 `member`)
                    ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ CommitFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, Integer
TxIdType SimpleTx
$sel:depositTxId:NetworkConnected :: TxIdType SimpleTx
depositTxId :: Integer
depositTxId}

                  Maybe (Set SimpleTxOut)
headUTxO <- HeadState SimpleTx -> Maybe (Set SimpleTxOut)
HeadState SimpleTx -> Maybe (UTxOType SimpleTx)
forall tx. IsTx tx => HeadState tx -> Maybe (UTxOType tx)
getHeadUTxO (HeadState SimpleTx -> Maybe (Set SimpleTxOut))
-> IOSim s (HeadState SimpleTx)
-> IOSim s (Maybe (Set SimpleTxOut))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestHydraClient SimpleTx (IOSim s) -> IOSim s (HeadState SimpleTx)
forall tx (m :: * -> *). TestHydraClient tx m -> m (HeadState tx)
queryState TestHydraClient SimpleTx (IOSim s)
n1
                  Set SimpleTxOut -> Maybe (Set SimpleTxOut) -> Set SimpleTxOut
forall a. a -> Maybe a -> a
fromMaybe Set SimpleTxOut
forall a. Monoid a => a
mempty Maybe (Set SimpleTxOut)
headUTxO Set SimpleTxOut -> Set SimpleTxOut -> IOSim s ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m, Eq a, Show a) =>
a -> a -> m ()
`shouldBe` [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1, Integer
2, Integer
11]

                  let decommitTx :: SimpleTx
decommitTx = Integer -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx Integer
1 (Integer -> UTxOType SimpleTx
utxoRef Integer
11) (Integer -> UTxOType SimpleTx
utxoRef Integer
88)
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
Decommit SimpleTx
decommitTx)
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                    DecommitRequested{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, SimpleTx
$sel:decommitTx:NetworkConnected :: SimpleTx
decommitTx :: SimpleTx
decommitTx, $sel:utxoToDecommit:NetworkConnected :: UTxOType SimpleTx
utxoToDecommit = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
88]}
                  [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                    SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{Maybe (UTxOType SimpleTx)
$sel:utxoToDecommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToDecommit :: Maybe (UTxOType SimpleTx)
utxoToDecommit}} ->
                      Maybe (Set SimpleTxOut)
Maybe (UTxOType SimpleTx)
utxoToDecommit Maybe (Set SimpleTxOut)
-> (Set SimpleTxOut -> Maybe ()) -> Maybe ()
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ())
-> (Set SimpleTxOut -> Bool) -> Set SimpleTxOut -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key (Set SimpleTxOut)
SimpleTxOut
88 `member`)
                    ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ DecommitApproved{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:decommitTxId:NetworkConnected :: TxIdType SimpleTx
decommitTxId = SimpleTx -> TxIdType SimpleTx
forall tx. IsTx tx => tx -> TxIdType tx
txId SimpleTx
decommitTx, $sel:utxoToDecommit:NetworkConnected :: UTxOType SimpleTx
utxoToDecommit = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
88]}
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ DecommitFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:distributedUTxO:NetworkConnected :: UTxOType SimpleTx
distributedUTxO = Integer -> UTxOType SimpleTx
utxoRef Integer
88}

                  Maybe (Set SimpleTxOut)
headUTxO2 <- HeadState SimpleTx -> Maybe (Set SimpleTxOut)
HeadState SimpleTx -> Maybe (UTxOType SimpleTx)
forall tx. IsTx tx => HeadState tx -> Maybe (UTxOType tx)
getHeadUTxO (HeadState SimpleTx -> Maybe (Set SimpleTxOut))
-> IOSim s (HeadState SimpleTx)
-> IOSim s (Maybe (Set SimpleTxOut))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestHydraClient SimpleTx (IOSim s) -> IOSim s (HeadState SimpleTx)
forall tx (m :: * -> *). TestHydraClient tx m -> m (HeadState tx)
queryState TestHydraClient SimpleTx (IOSim s)
n1
                  Set SimpleTxOut -> Maybe (Set SimpleTxOut) -> Set SimpleTxOut
forall a. a -> Maybe a -> a
fromMaybe Set SimpleTxOut
forall a. Monoid a => a
mempty Maybe (Set SimpleTxOut)
headUTxO2 Set SimpleTxOut -> (Set SimpleTxOut -> Bool) -> IOSim s ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m, Show a) =>
a -> (a -> Bool) -> m ()
`shouldSatisfy` (Bool -> Bool
not (Bool -> Bool)
-> (Set SimpleTxOut -> Bool) -> Set SimpleTxOut -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key (Set SimpleTxOut) -> Set SimpleTxOut -> Bool
forall t. StaticMap t => Key t -> t -> Bool
member Key (Set SimpleTxOut)
SimpleTxOut
11)

      String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Decommit" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
        String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"can request decommit" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 ->
                SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
                  SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2

                  let decommitTx :: SimpleTx
decommitTx = Integer -> SimpleTx
aValidTx Integer
42
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
Decommit SimpleTx
decommitTx)
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                    DecommitRequested{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, SimpleTx
$sel:decommitTx:NetworkConnected :: SimpleTx
decommitTx :: SimpleTx
decommitTx, $sel:utxoToDecommit:NetworkConnected :: UTxOType SimpleTx
utxoToDecommit = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
42]}

        String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"requested decommits get approved" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 ->
                SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
                  SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                  let decommitTx :: SimpleTx
decommitTx = Integer -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx Integer
1 (Integer -> UTxOType SimpleTx
utxoRef Integer
1) (Integer -> UTxOType SimpleTx
utxoRef Integer
42)
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
Decommit SimpleTx
decommitTx)
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                    DecommitRequested{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, SimpleTx
$sel:decommitTx:NetworkConnected :: SimpleTx
decommitTx :: SimpleTx
decommitTx, $sel:utxoToDecommit:NetworkConnected :: UTxOType SimpleTx
utxoToDecommit = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
42]}

                  [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                    SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{Maybe (UTxOType SimpleTx)
$sel:utxoToDecommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToDecommit :: Maybe (UTxOType SimpleTx)
utxoToDecommit}} ->
                      Maybe (Set SimpleTxOut)
Maybe (UTxOType SimpleTx)
utxoToDecommit Maybe (Set SimpleTxOut)
-> (Set SimpleTxOut -> Maybe ()) -> Maybe ()
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ())
-> (Set SimpleTxOut -> Bool) -> Set SimpleTxOut -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key (Set SimpleTxOut)
SimpleTxOut
42 `member`)
                    ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ DecommitApproved{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:decommitTxId:NetworkConnected :: TxIdType SimpleTx
decommitTxId = SimpleTx -> TxIdType SimpleTx
forall tx. IsTx tx => tx -> TxIdType tx
txId SimpleTx
decommitTx, $sel:utxoToDecommit:NetworkConnected :: UTxOType SimpleTx
utxoToDecommit = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
42]}
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ DecommitFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:distributedUTxO:NetworkConnected :: UTxOType SimpleTx
distributedUTxO = Integer -> UTxOType SimpleTx
utxoRef Integer
42}

                  Maybe (Set SimpleTxOut)
headUTxO <- HeadState SimpleTx -> Maybe (Set SimpleTxOut)
HeadState SimpleTx -> Maybe (UTxOType SimpleTx)
forall tx. IsTx tx => HeadState tx -> Maybe (UTxOType tx)
getHeadUTxO (HeadState SimpleTx -> Maybe (Set SimpleTxOut))
-> IOSim s (HeadState SimpleTx)
-> IOSim s (Maybe (Set SimpleTxOut))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestHydraClient SimpleTx (IOSim s) -> IOSim s (HeadState SimpleTx)
forall tx (m :: * -> *). TestHydraClient tx m -> m (HeadState tx)
queryState TestHydraClient SimpleTx (IOSim s)
n1
                  Set SimpleTxOut -> Maybe (Set SimpleTxOut) -> Set SimpleTxOut
forall a. a -> Maybe a -> a
fromMaybe Set SimpleTxOut
forall a. Monoid a => a
mempty Maybe (Set SimpleTxOut)
headUTxO Set SimpleTxOut -> (Set SimpleTxOut -> Bool) -> IOSim s ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m, Show a) =>
a -> (a -> Bool) -> m ()
`shouldSatisfy` (Bool -> Bool
not (Bool -> Bool)
-> (Set SimpleTxOut -> Bool) -> Set SimpleTxOut -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key (Set SimpleTxOut) -> Set SimpleTxOut -> Bool
forall t. StaticMap t => Key t -> t -> Bool
member Key (Set SimpleTxOut)
SimpleTxOut
42)

        String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"can only process one decommit at once" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 ->
                SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
                  SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                  let decommitTx1 :: SimpleTx
decommitTx1 = Integer -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx Integer
1 (Integer -> UTxOType SimpleTx
utxoRef Integer
1) (Integer -> UTxOType SimpleTx
utxoRef Integer
42)
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (Decommit{$sel:decommitTx:Init :: SimpleTx
decommitTx = SimpleTx
decommitTx1})
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                    DecommitRequested{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:decommitTx:NetworkConnected :: SimpleTx
decommitTx = SimpleTx
decommitTx1, $sel:utxoToDecommit:NetworkConnected :: UTxOType SimpleTx
utxoToDecommit = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
42]}

                  let decommitTx2 :: SimpleTx
decommitTx2 = Integer -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx Integer
2 (Integer -> UTxOType SimpleTx
utxoRef Integer
2) (Integer -> UTxOType SimpleTx
utxoRef Integer
22)
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 (Decommit{$sel:decommitTx:Init :: SimpleTx
decommitTx = SimpleTx
decommitTx2})
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                    DecommitInvalid
                      { $sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId
                      , $sel:decommitTx:NetworkConnected :: SimpleTx
decommitTx = SimpleTx
decommitTx2
                      , $sel:decommitInvalidReason:NetworkConnected :: DecommitInvalidReason SimpleTx
decommitInvalidReason = DecommitAlreadyInFlight{$sel:otherDecommitTxId:DecommitTxInvalid :: TxIdType SimpleTx
otherDecommitTxId = SimpleTx -> TxIdType SimpleTx
forall tx. IsTx tx => tx -> TxIdType tx
txId SimpleTx
decommitTx1}
                      }

                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ DecommitFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:distributedUTxO:NetworkConnected :: UTxOType SimpleTx
distributedUTxO = Integer -> UTxOType SimpleTx
utxoRef Integer
42}

                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 (Decommit{$sel:decommitTx:Init :: SimpleTx
decommitTx = SimpleTx
decommitTx2})
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ DecommitApproved{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:decommitTxId:NetworkConnected :: TxIdType SimpleTx
decommitTxId = SimpleTx -> TxIdType SimpleTx
forall tx. IsTx tx => tx -> TxIdType tx
txId SimpleTx
decommitTx2, $sel:utxoToDecommit:NetworkConnected :: UTxOType SimpleTx
utxoToDecommit = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
22]}
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ DecommitFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:distributedUTxO:NetworkConnected :: UTxOType SimpleTx
distributedUTxO = Integer -> UTxOType SimpleTx
utxoRef Integer
22}

        String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"can process transactions while decommit pending" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 ->
                SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
                  SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2

                  let decommitTx :: SimpleTx
decommitTx = Integer -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx Integer
1 (Integer -> UTxOType SimpleTx
utxoRef Integer
1) (Integer -> UTxOType SimpleTx
utxoRef Integer
42)
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 (Decommit{SimpleTx
$sel:decommitTx:Init :: SimpleTx
decommitTx :: SimpleTx
decommitTx})
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                    DecommitRequested{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, SimpleTx
$sel:decommitTx:NetworkConnected :: SimpleTx
decommitTx :: SimpleTx
decommitTx, $sel:utxoToDecommit:NetworkConnected :: UTxOType SimpleTx
utxoToDecommit = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
42]}
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                    DecommitApproved{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:decommitTxId:NetworkConnected :: TxIdType SimpleTx
decommitTxId = Integer
TxIdType SimpleTx
1, $sel:utxoToDecommit:NetworkConnected :: UTxOType SimpleTx
utxoToDecommit = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
42]}

                  let normalTx :: SimpleTx
normalTx = Integer -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx Integer
2 (Integer -> UTxOType SimpleTx
utxoRef Integer
2) (Integer -> UTxOType SimpleTx
utxoRef Integer
3)
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx SimpleTx
normalTx)
                  [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                    SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{[SimpleTx]
$sel:confirmed:Snapshot :: forall tx. Snapshot tx -> [tx]
confirmed :: [SimpleTx]
confirmed}} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ SimpleTx
normalTx SimpleTx -> [SimpleTx] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [SimpleTx]
confirmed
                    ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ DecommitFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:distributedUTxO:NetworkConnected :: UTxOType SimpleTx
distributedUTxO = Integer -> UTxOType SimpleTx
utxoRef Integer
42}

        String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"can close with decommit in flight" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 -> do
                SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
                  SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                  let decommitTx :: SimpleTx
decommitTx = Integer -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx Integer
1 (Integer -> UTxOType SimpleTx
utxoRef Integer
2) (Integer -> UTxOType SimpleTx
utxoRef Integer
42)
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 (Decommit{SimpleTx
$sel:decommitTx:Init :: SimpleTx
decommitTx :: SimpleTx
decommitTx})
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Close
                  -- XXX: Can't assert DecommitFinalized here as it is not
                  -- emitted because an incorrect simulation of the chain here.
                  -- The OnDecrementTx only reaches the nodes HeadLogic after
                  -- the OnCloseTx. This is impossible using a proper chain so
                  -- we don't assert it here.
                  -- waitUntil [n1, n2] $ DecommitFinalized{headId = testHeadId, distributedUTxO = utxoRef 42}
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ ReadyToFanout{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId}
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Fanout
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:NetworkConnected :: UTxOType SimpleTx
utxo = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1]}

        String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"fanout utxo is correct after a decommit" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 -> do
                SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
                  SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                  let decommitTx :: SimpleTx
decommitTx = Integer -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx Integer
1 (Integer -> UTxOType SimpleTx
utxoRef Integer
1) (Integer -> UTxOType SimpleTx
utxoRef Integer
42)
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 (Decommit{SimpleTx
$sel:decommitTx:Init :: SimpleTx
decommitTx :: SimpleTx
decommitTx})
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                    DecommitApproved
                      { $sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId
                      , $sel:decommitTxId:NetworkConnected :: TxIdType SimpleTx
decommitTxId = SimpleTx -> TxIdType SimpleTx
forall tx. IsTx tx => tx -> TxIdType tx
txId SimpleTx
decommitTx
                      , $sel:utxoToDecommit:NetworkConnected :: UTxOType SimpleTx
utxoToDecommit = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
42]
                      }
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Close
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ ReadyToFanout{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId}
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Fanout
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:NetworkConnected :: UTxOType SimpleTx
utxo = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
2]}

        String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"can fanout with empty utxo" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 -> do
                SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
                  SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                  let decommitTx :: SimpleTx
decommitTx = Integer -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx Integer
1 (Integer -> UTxOType SimpleTx
utxoRef Integer
1) (Integer -> UTxOType SimpleTx
utxoRef Integer
42)
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 (Decommit{SimpleTx
$sel:decommitTx:Init :: SimpleTx
decommitTx :: SimpleTx
decommitTx})
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                    DecommitApproved
                      { $sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId
                      , $sel:decommitTxId:NetworkConnected :: TxIdType SimpleTx
decommitTxId = SimpleTx -> TxIdType SimpleTx
forall tx. IsTx tx => tx -> TxIdType tx
txId SimpleTx
decommitTx
                      , $sel:utxoToDecommit:NetworkConnected :: UTxOType SimpleTx
utxoToDecommit = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
42]
                      }
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                    DecommitFinalized
                      { $sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId
                      , $sel:distributedUTxO:NetworkConnected :: UTxOType SimpleTx
distributedUTxO = Integer -> UTxOType SimpleTx
utxoRef Integer
42
                      }
                  let decommitTx2 :: SimpleTx
decommitTx2 = Integer -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx Integer
2 (Integer -> UTxOType SimpleTx
utxoRef Integer
2) (Integer -> UTxOType SimpleTx
utxoRef Integer
88)
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (Decommit{$sel:decommitTx:Init :: SimpleTx
decommitTx = SimpleTx
decommitTx2})
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                    DecommitFinalized
                      { $sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId
                      , $sel:distributedUTxO:NetworkConnected :: UTxOType SimpleTx
distributedUTxO = Integer -> UTxOType SimpleTx
utxoRef Integer
88
                      }
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Close
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ ReadyToFanout{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId}
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Fanout
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:NetworkConnected :: UTxOType SimpleTx
utxo = [Integer] -> UTxOType SimpleTx
utxoRefs []}

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"can be finalized by all parties after contestation period" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 ->
            SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
              SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
              TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Close
              [TestHydraClient SimpleTx (IOSim s)]
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ TestHydraClient SimpleTx (IOSim s)
-> IOSim s (ServerOutput SimpleTx)
forall tx (m :: * -> *).
TestHydraClient tx m -> m (ServerOutput tx)
waitForNext (TestHydraClient SimpleTx (IOSim s)
 -> IOSim s (ServerOutput SimpleTx))
-> (ServerOutput SimpleTx -> IOSim s ())
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m) =>
ServerOutput tx -> m ()
assertHeadIsClosed
              [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> ServerOutput SimpleTx
forall tx. HeadId -> ServerOutput tx
ReadyToFanout HeadId
testHeadId
              TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Fanout
              TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 ClientInput SimpleTx
forall tx. ClientInput tx
Fanout
              [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:NetworkConnected :: UTxOType SimpleTx
utxo = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1, Integer
2]}

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"contest automatically when detecting closing with old snapshot" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 ->
            SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
bobSk [Party
alice] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n2 -> do
              SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2

              -- Perform a transaction to produce the latest snapshot, number 1
              let tx :: SimpleTx
tx = Integer -> SimpleTx
aValidTx Integer
42
              TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx SimpleTx
tx)
              [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{SnapshotNumber
$sel:number:Snapshot :: forall tx. Snapshot tx -> SnapshotNumber
number :: SnapshotNumber
number}} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ SnapshotNumber
number SnapshotNumber -> SnapshotNumber -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotNumber
1
                ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

              -- Have n1 & n2 observe a close with not the latest snapshot
              let deadline :: UTCTime
deadline = Gen UTCTime
forall a. Arbitrary a => Gen a
arbitrary Gen UTCTime -> Int -> UTCTime
forall a. Gen a -> Int -> a
`generateWith` Int
42
              -- XXX: This is a bit cumbersome and maybe even incorrect (chain
              -- states), the simulated chain should provide a way to inject an
              -- 'OnChainTx' without providing a chain state?
              TestHydraClient SimpleTx (IOSim s)
-> ChainEvent SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ChainEvent tx -> m ()
injectChainEvent TestHydraClient SimpleTx (IOSim s)
n1 Observation{$sel:observedTx:Observation :: OnChainTx SimpleTx
observedTx = HeadId -> SnapshotNumber -> UTCTime -> OnChainTx SimpleTx
forall tx. HeadId -> SnapshotNumber -> UTCTime -> OnChainTx tx
OnCloseTx HeadId
testHeadId SnapshotNumber
0 UTCTime
deadline, $sel:newChainState:Observation :: ChainStateType SimpleTx
newChainState = SimpleChainState{$sel:slot:SimpleChainState :: ChainSlot
slot = TTL -> ChainSlot
ChainSlot TTL
0}}
              TestHydraClient SimpleTx (IOSim s)
-> ChainEvent SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ChainEvent tx -> m ()
injectChainEvent TestHydraClient SimpleTx (IOSim s)
n2 Observation{$sel:observedTx:Observation :: OnChainTx SimpleTx
observedTx = HeadId -> SnapshotNumber -> UTCTime -> OnChainTx SimpleTx
forall tx. HeadId -> SnapshotNumber -> UTCTime -> OnChainTx tx
OnCloseTx HeadId
testHeadId SnapshotNumber
0 UTCTime
deadline, $sel:newChainState:Observation :: ChainStateType SimpleTx
newChainState = SimpleChainState{$sel:slot:SimpleChainState :: ChainSlot
slot = TTL -> ChainSlot
ChainSlot TTL
0}}

              [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                HeadIsClosed{SnapshotNumber
$sel:snapshotNumber:NetworkConnected :: forall tx. ServerOutput tx -> SnapshotNumber
snapshotNumber :: SnapshotNumber
snapshotNumber} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ SnapshotNumber
snapshotNumber SnapshotNumber -> SnapshotNumber -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotNumber
0
                ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

              -- Expect n1 to contest with latest snapshot, number 1
              [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                HeadIsContested{SnapshotNumber
$sel:snapshotNumber:NetworkConnected :: forall tx. ServerOutput tx -> SnapshotNumber
snapshotNumber :: SnapshotNumber
snapshotNumber} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ SnapshotNumber
snapshotNumber SnapshotNumber -> SnapshotNumber -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotNumber
1
                ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Hydra Node Logging" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"traces processing of events" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
      let result :: SimTrace ()
result = (forall s. IOSim s ()) -> SimTrace ()
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace ((forall s. IOSim s ()) -> SimTrace ())
-> (forall s. IOSim s ()) -> SimTrace ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 -> do
                TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Init
                [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> [Party] -> ServerOutput SimpleTx
forall tx. HeadId -> [Party] -> ServerOutput tx
HeadIsInitializing HeadId
testHeadId ([Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice])
                SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId -> Party -> UTxOType SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> Party -> UTxOType tx -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Party
alice (Integer -> UTxOType SimpleTx
utxoRef Integer
1)

          logs :: [HydraNodeLog SimpleTx]
logs = forall a b. Typeable b => SimTrace a -> [b]
selectTraceEventsDynamic @_ @(HydraNodeLog SimpleTx) SimTrace ()
result

      [HydraNodeLog SimpleTx]
logs
        [HydraNodeLog SimpleTx] -> [HydraNodeLog SimpleTx] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Party -> Word64 -> Input SimpleTx -> HydraNodeLog SimpleTx
forall tx. Party -> Word64 -> Input tx -> HydraNodeLog tx
BeginInput Party
alice Word64
0 (ClientInput SimpleTx -> Input SimpleTx
forall tx. ClientInput tx -> Input tx
ClientInput ClientInput SimpleTx
forall tx. ClientInput tx
Init)]
      [HydraNodeLog SimpleTx]
logs
        [HydraNodeLog SimpleTx] -> [HydraNodeLog SimpleTx] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Party -> Word64 -> HydraNodeLog SimpleTx
forall tx. Party -> Word64 -> HydraNodeLog tx
EndInput Party
alice Word64
0]

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"traces handling of effects" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
      let result :: SimTrace ()
result = (forall s. IOSim s ()) -> SimTrace ()
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace ((forall s. IOSim s ()) -> SimTrace ())
-> (forall s. IOSim s ()) -> SimTrace ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 -> do
                TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Abort
                ClientMessage SimpleTx
msg <- TestHydraClient SimpleTx (IOSim s)
-> IOSim s (ClientMessage SimpleTx)
forall tx (m :: * -> *).
TestHydraClient tx m -> m (ClientMessage tx)
waitForNextMessage TestHydraClient SimpleTx (IOSim s)
n1
                ClientMessage SimpleTx
msg ClientMessage SimpleTx
-> (ClientMessage SimpleTx -> Bool) -> IOSim s ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m, Show a) =>
a -> (a -> Bool) -> m ()
`shouldSatisfy` \case
                  CommandFailed{} -> Bool
True
                  ClientMessage SimpleTx
_ -> Bool
False

          logs :: [HydraNodeLog SimpleTx]
logs = forall a b. Typeable b => SimTrace a -> [b]
selectTraceEventsDynamic @_ @(HydraNodeLog SimpleTx) SimTrace ()
result

      [HydraNodeLog SimpleTx]
logs
        [HydraNodeLog SimpleTx]
-> ([HydraNodeLog SimpleTx] -> Bool) -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m, Show a) =>
a -> (a -> Bool) -> m ()
`shouldSatisfy` (HydraNodeLog SimpleTx -> Bool) -> [HydraNodeLog SimpleTx] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
          ( \case
              (BeginEffect Party
_ Word64
_ Word32
_ (ClientEffect CommandFailed{})) -> Bool
True
              HydraNodeLog SimpleTx
_ -> Bool
False
          )
      [HydraNodeLog SimpleTx]
logs [HydraNodeLog SimpleTx] -> [HydraNodeLog SimpleTx] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Party -> Word64 -> Word32 -> HydraNodeLog SimpleTx
forall tx. Party -> Word64 -> Word32 -> HydraNodeLog tx
EndEffect Party
alice Word64
0 Word32
0]

  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"rolling back & forward does not make the node crash" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"does work for rollbacks past init" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 -> do
            TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Init
            [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> [Party] -> ServerOutput SimpleTx
forall tx. HeadId -> [Party] -> ServerOutput tx
HeadIsInitializing HeadId
testHeadId ([Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice])
            -- We expect the Init to be rolled back and forward again
            SimulatedChainNetwork SimpleTx (IOSim s) -> TTL -> IOSim s ()
forall tx (m :: * -> *). SimulatedChainNetwork tx m -> TTL -> m ()
rollbackAndForward SimulatedChainNetwork SimpleTx (IOSim s)
chain TTL
1
            -- We expect the node to still work and let us commit
            SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId -> Party -> UTxOType SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> Party -> UTxOType tx -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Party
alice (Integer -> UTxOType SimpleTx
utxoRef Integer
1)
            [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> Party -> UTxOType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> Party -> UTxOType tx -> ServerOutput tx
Committed HeadId
testHeadId Party
alice (Integer -> UTxOType SimpleTx
utxoRef Integer
1)

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"does work for rollbacks past open" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
aliceSk [] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 -> do
            TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Init
            [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> [Party] -> ServerOutput SimpleTx
forall tx. HeadId -> [Party] -> ServerOutput tx
HeadIsInitializing HeadId
testHeadId ([Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice])
            SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId -> Party -> UTxOType SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> Party -> UTxOType tx -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Party
alice (Integer -> UTxOType SimpleTx
utxoRef Integer
1)
            [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> Party -> UTxOType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> Party -> UTxOType tx -> ServerOutput tx
Committed HeadId
testHeadId Party
alice (Integer -> UTxOType SimpleTx
utxoRef Integer
1)
            [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsOpen{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:NetworkConnected :: UTxOType SimpleTx
utxo = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1]}
            -- We expect one Commit AND the CollectCom to be rolled back and
            -- forward again
            SimulatedChainNetwork SimpleTx (IOSim s) -> TTL -> IOSim s ()
forall tx (m :: * -> *). SimulatedChainNetwork tx m -> TTL -> m ()
rollbackAndForward SimulatedChainNetwork SimpleTx (IOSim s)
chain TTL
2
            -- We expect the node to still work and let us post L2 transactions
            TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx (Integer -> SimpleTx
aValidTx Integer
42))
            [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> TxIdType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> TxIdType tx -> ServerOutput tx
TxValid HeadId
testHeadId Integer
TxIdType SimpleTx
42

-- | Wait for some output at some node(s) to be produced /eventually/. See
-- 'waitUntilMatch' for how long it waits.
waitUntil ::
  (HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m, IsChainState tx) =>
  [TestHydraClient tx m] ->
  ServerOutput tx ->
  m ()
waitUntil :: forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient tx m]
nodes ServerOutput tx
expected =
  [TestHydraClient tx m] -> (ServerOutput tx -> Maybe ()) -> m ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient tx m]
nodes ((ServerOutput tx -> Maybe ()) -> m ())
-> (ServerOutput tx -> Maybe ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ())
-> (ServerOutput tx -> Bool) -> ServerOutput tx -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ServerOutput tx
expected ==)

-- | Wait for a server output to match some predicate /eventually/. If a client
-- message is received instead, this fails. This will not wait forever, but for
-- a long time (1 month) to get a nice error location. Should not be an issue
-- when used within `shouldRunInSim`, this was even 1000 years before - but we
-- since we are having the protocol produce 'Tick' events constantly this would
-- be fully simulated to the end.
waitUntilMatch ::
  (Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m, Eq a, Show a, IsChainState tx) =>
  [TestHydraClient tx m] ->
  (ServerOutput tx -> Maybe a) ->
  m a
waitUntilMatch :: forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient tx m]
nodes ServerOutput tx -> Maybe a
predicate = do
  TVar m [(NodeId, ServerOutput tx)]
seenMsgs <- [(NodeId, ServerOutput tx)]
-> m (TVar m [(NodeId, ServerOutput tx)])
forall a. a -> m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO []
  DiffTime -> m [a] -> m (Maybe [a])
forall a. DiffTime -> m a -> m (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
oneMonth ([(NodeId, TestHydraClient tx m)]
-> ((NodeId, TestHydraClient tx m) -> m a) -> m [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, MonadAsync m) =>
t a -> (a -> m b) -> m (t b)
forConcurrently ([NodeId]
-> [TestHydraClient tx m] -> [(NodeId, TestHydraClient tx m)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TTL -> NodeId
Node TTL
1 ..] [TestHydraClient tx m]
nodes) (((NodeId, TestHydraClient tx m) -> m a) -> m [a])
-> ((NodeId, TestHydraClient tx m) -> m a) -> m [a]
forall a b. (a -> b) -> a -> b
$ TVar m [(NodeId, ServerOutput tx)]
-> (NodeId, TestHydraClient tx m) -> m a
go TVar m [(NodeId, ServerOutput tx)]
seenMsgs) m (Maybe [a]) -> (Maybe [a] -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just [] -> String -> m a
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure String
"waitUntilMatch no results"
    Just (a
x : [a]
xs)
      | (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x) [a]
xs -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
      | Bool
otherwise -> String -> m a
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure (String -> m a) -> (Text -> String) -> Text -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString (Text -> m a) -> Text -> m a
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines [Text
"waitUntilMatch encountered inconsistent results:", [a] -> Text
forall b a. (Show a, IsString b) => a -> b
show (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)]
    Maybe [a]
Nothing -> do
      [(NodeId, ServerOutput tx)]
msgs <- TVar m [(NodeId, ServerOutput tx)] -> m [(NodeId, ServerOutput tx)]
forall a. TVar m a -> m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
readTVarIO TVar m [(NodeId, ServerOutput tx)]
seenMsgs
      String -> m a
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$
        Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
          [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines
            [ Text
"waitUntilMatch did not match a message on all nodes (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show ([TestHydraClient tx m] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TestHydraClient tx m]
nodes) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") within " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DiffTime -> Text
forall b a. (Show a, IsString b) => a -> b
show DiffTime
oneMonth Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", seen messages:"
            , [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines ((NodeId, ServerOutput tx) -> Text
forall b a. (Show a, IsString b) => a -> b
show ((NodeId, ServerOutput tx) -> Text)
-> [(NodeId, ServerOutput tx)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(NodeId, ServerOutput tx)]
msgs)
            ]
 where
  go :: TVar m [(NodeId, ServerOutput tx)]
-> (NodeId, TestHydraClient tx m) -> m a
go TVar m [(NodeId, ServerOutput tx)]
seenOutputs (NodeId
nid, TestHydraClient tx m
n) = do
    ServerOutput tx
out <-
      m (ClientMessage tx)
-> m (ServerOutput tx)
-> m (Either (ClientMessage tx) (ServerOutput tx))
forall a b. m a -> m b -> m (Either a b)
forall (m :: * -> *) a b.
MonadAsync m =>
m a -> m b -> m (Either a b)
race (TestHydraClient tx m -> m (ClientMessage tx)
forall tx (m :: * -> *).
TestHydraClient tx m -> m (ClientMessage tx)
waitForNextMessage TestHydraClient tx m
n) (TestHydraClient tx m -> m (ServerOutput tx)
forall tx (m :: * -> *).
TestHydraClient tx m -> m (ServerOutput tx)
waitForNext TestHydraClient tx m
n) m (Either (ClientMessage tx) (ServerOutput tx))
-> (Either (ClientMessage tx) (ServerOutput tx)
    -> m (ServerOutput tx))
-> m (ServerOutput tx)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left ClientMessage tx
msg -> String -> m (ServerOutput tx)
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure (String -> m (ServerOutput tx)) -> String -> m (ServerOutput tx)
forall a b. (a -> b) -> a -> b
$ String
"waitUntilMatch received unexpected client message: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ClientMessage tx -> String
forall b a. (Show a, IsString b) => a -> b
show ClientMessage tx
msg
        Right ServerOutput tx
out -> ServerOutput tx -> m (ServerOutput tx)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerOutput tx
out
    STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (TVar m [(NodeId, ServerOutput tx)]
-> ([(NodeId, ServerOutput tx)] -> [(NodeId, ServerOutput tx)])
-> STM m ()
forall a. TVar m a -> (a -> a) -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
TVar m a -> (a -> a) -> STM m ()
modifyTVar' TVar m [(NodeId, ServerOutput tx)]
seenOutputs ((NodeId
nid, ServerOutput tx
out) :))
    case ServerOutput tx -> Maybe a
predicate ServerOutput tx
out of
      Just a
x -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
      Maybe a
Nothing -> TVar m [(NodeId, ServerOutput tx)]
-> (NodeId, TestHydraClient tx m) -> m a
go TVar m [(NodeId, ServerOutput tx)]
seenOutputs (NodeId
nid, TestHydraClient tx m
n)

  oneMonth :: DiffTime
oneMonth = DiffTime
3600 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
24 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
30

newtype NodeId = Node Natural
  deriving (Int -> NodeId
NodeId -> Int
NodeId -> [NodeId]
NodeId -> NodeId
NodeId -> NodeId -> [NodeId]
NodeId -> NodeId -> NodeId -> [NodeId]
(NodeId -> NodeId)
-> (NodeId -> NodeId)
-> (Int -> NodeId)
-> (NodeId -> Int)
-> (NodeId -> [NodeId])
-> (NodeId -> NodeId -> [NodeId])
-> (NodeId -> NodeId -> [NodeId])
-> (NodeId -> NodeId -> NodeId -> [NodeId])
-> Enum NodeId
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: NodeId -> NodeId
succ :: NodeId -> NodeId
$cpred :: NodeId -> NodeId
pred :: NodeId -> NodeId
$ctoEnum :: Int -> NodeId
toEnum :: Int -> NodeId
$cfromEnum :: NodeId -> Int
fromEnum :: NodeId -> Int
$cenumFrom :: NodeId -> [NodeId]
enumFrom :: NodeId -> [NodeId]
$cenumFromThen :: NodeId -> NodeId -> [NodeId]
enumFromThen :: NodeId -> NodeId -> [NodeId]
$cenumFromTo :: NodeId -> NodeId -> [NodeId]
enumFromTo :: NodeId -> NodeId -> [NodeId]
$cenumFromThenTo :: NodeId -> NodeId -> NodeId -> [NodeId]
enumFromThenTo :: NodeId -> NodeId -> NodeId -> [NodeId]
Enum, Int -> NodeId -> String -> String
[NodeId] -> String -> String
NodeId -> String
(Int -> NodeId -> String -> String)
-> (NodeId -> String)
-> ([NodeId] -> String -> String)
-> Show NodeId
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> NodeId -> String -> String
showsPrec :: Int -> NodeId -> String -> String
$cshow :: NodeId -> String
show :: NodeId -> String
$cshowList :: [NodeId] -> String -> String
showList :: [NodeId] -> String -> String
Show)

-- XXX: The names of the following handles and functions are confusing.

-- | A thin client layer around 'HydraNode' to be interact with it through
-- 'send', 'waitForNext', access all outputs and inject events through the test
-- chain.
data TestHydraClient tx m = TestHydraClient
  { forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send :: ClientInput tx -> m ()
  , forall tx (m :: * -> *).
TestHydraClient tx m -> m (ServerOutput tx)
waitForNext :: m (ServerOutput tx)
  , forall tx (m :: * -> *).
TestHydraClient tx m -> m (ClientMessage tx)
waitForNextMessage :: m (ClientMessage tx)
  , forall tx (m :: * -> *).
TestHydraClient tx m -> ChainEvent tx -> m ()
injectChainEvent :: ChainEvent tx -> m ()
  , forall tx (m :: * -> *).
TestHydraClient tx m -> m [ServerOutput tx]
serverOutputs :: m [ServerOutput tx]
  , forall tx (m :: * -> *). TestHydraClient tx m -> m (HeadState tx)
queryState :: m (HeadState tx)
  }

-- | A simulated chain that just echoes 'PostChainTx' as 'Observation's of
-- 'OnChainTx' onto all connected nodes. It can also 'rollbackAndForward' any
-- number of these "transactions".
data SimulatedChainNetwork tx m = SimulatedChainNetwork
  { forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> DraftHydraNode tx m -> m (HydraNode tx m)
connectNode :: DraftHydraNode tx m -> m (HydraNode tx m)
  , forall tx (m :: * -> *). SimulatedChainNetwork tx m -> Async m ()
tickThread :: Async m ()
  , forall tx (m :: * -> *). SimulatedChainNetwork tx m -> TTL -> m ()
rollbackAndForward :: Natural -> m ()
  , forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> Party -> UTxOType tx -> m ()
simulateCommit :: HeadId -> Party -> UTxOType tx -> m ()
  , forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> UTxOType tx -> UTCTime -> m (TxIdType tx)
simulateDeposit :: HeadId -> UTxOType tx -> UTCTime -> m (TxIdType tx)
  , forall tx (m :: * -> *).
SimulatedChainNetwork tx m -> (Party, UTxOType tx) -> m ()
closeWithInitialSnapshot :: (Party, UTxOType tx) -> m ()
  }

dummySimulatedChainNetwork :: SimulatedChainNetwork tx m
dummySimulatedChainNetwork :: forall tx (m :: * -> *). SimulatedChainNetwork tx m
dummySimulatedChainNetwork =
  SimulatedChainNetwork
    { $sel:connectNode:SimulatedChainNetwork :: DraftHydraNode tx m -> m (HydraNode tx m)
connectNode = Text -> DraftHydraNode tx m -> m (HydraNode tx m)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"connectNode"
    , $sel:tickThread:SimulatedChainNetwork :: Async m ()
tickThread = Text -> Async m ()
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"tickThread"
    , $sel:rollbackAndForward:SimulatedChainNetwork :: TTL -> m ()
rollbackAndForward = Text -> TTL -> m ()
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"rollbackAndForward"
    , $sel:simulateCommit:SimulatedChainNetwork :: HeadId -> Party -> UTxOType tx -> m ()
simulateCommit = Text -> HeadId -> Party -> UTxOType tx -> m ()
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"simulateCommit"
    , $sel:simulateDeposit:SimulatedChainNetwork :: HeadId -> UTxOType tx -> UTCTime -> m (TxIdType tx)
simulateDeposit = Text -> HeadId -> UTxOType tx -> UTCTime -> m (TxIdType tx)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"simulateDeposit"
    , $sel:closeWithInitialSnapshot:SimulatedChainNetwork :: (Party, UTxOType tx) -> m ()
closeWithInitialSnapshot = Text -> (Party, UTxOType tx) -> m ()
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"closeWithInitialSnapshot"
    }

-- | With-pattern wrapper around 'simulatedChainAndNetwork' which does 'cancel'
-- the 'tickThread'. Also, this will fix tx to 'SimpleTx' so that it can pick an
-- initial chain state to play back to our test nodes.
-- NOTE: The simulated network has a block time of 20 (simulated) seconds.
withSimulatedChainAndNetwork ::
  (MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
  (SimulatedChainNetwork SimpleTx m -> m a) ->
  m a
withSimulatedChainAndNetwork :: forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork =
  m (SimulatedChainNetwork SimpleTx m)
-> (SimulatedChainNetwork SimpleTx m -> m ())
-> (SimulatedChainNetwork SimpleTx m -> m a)
-> m a
forall a b c. m a -> (a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadThrow m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
    (ChainStateType SimpleTx -> m (SimulatedChainNetwork SimpleTx m)
forall (m :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
ChainStateType SimpleTx -> m (SimulatedChainNetwork SimpleTx m)
simulatedChainAndNetwork SimpleChainState{$sel:slot:SimpleChainState :: ChainSlot
slot = TTL -> ChainSlot
ChainSlot TTL
0})
    (Async m () -> m ()
forall a. Async m a -> m ()
forall (m :: * -> *) a. MonadAsync m => Async m a -> m ()
cancel (Async m () -> m ())
-> (SimulatedChainNetwork SimpleTx m -> Async m ())
-> SimulatedChainNetwork SimpleTx m
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimulatedChainNetwork SimpleTx m -> Async m ()
forall tx (m :: * -> *). SimulatedChainNetwork tx m -> Async m ()
tickThread)

-- | Creates a simulated chain and network to which 'HydraNode's can be
-- connected to using 'connectNode'. NOTE: The 'tickThread' needs to be
-- 'cancel'ed after use. Use 'withSimulatedChainAndNetwork' instead where
-- possible.
simulatedChainAndNetwork ::
  forall m.
  (MonadTime m, MonadDelay m, MonadAsync m) =>
  ChainStateType SimpleTx ->
  m (SimulatedChainNetwork SimpleTx m)
simulatedChainAndNetwork :: forall (m :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
ChainStateType SimpleTx -> m (SimulatedChainNetwork SimpleTx m)
simulatedChainAndNetwork ChainStateType SimpleTx
initialChainState = do
  TVar m [ChainEvent SimpleTx]
history <- [ChainEvent SimpleTx] -> m (TVar m [ChainEvent SimpleTx])
forall a. a -> m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO []
  TVar m [HydraNode SimpleTx m]
nodes <- [HydraNode SimpleTx m] -> m (TVar m [HydraNode SimpleTx m])
forall a. a -> m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO []
  TVar m Integer
nextTxId <- Integer -> m (TVar m Integer)
forall a. a -> m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO Integer
10000
  LocalChainState m SimpleTx
localChainState <- ChainStateHistory SimpleTx -> m (LocalChainState m SimpleTx)
forall (m :: * -> *) tx.
(MonadSTM m, IsChainState tx) =>
ChainStateHistory tx -> m (LocalChainState m tx)
newLocalChainState (ChainStateType SimpleTx -> ChainStateHistory SimpleTx
forall tx. ChainStateType tx -> ChainStateHistory tx
initHistory ChainStateType SimpleTx
initialChainState)
  Async m ()
tickThread <- m () -> m (Async m ())
forall a. m a -> m (Async m a)
forall (m :: * -> *) a. MonadAsync m => m a -> m (Async m a)
async (m () -> m (Async m ())) -> m () -> m (Async m ())
forall a b. (a -> b) -> a -> b
$ TVar m [HydraNode SimpleTx m] -> LocalChainState m SimpleTx -> m ()
simulateTicks TVar m [HydraNode SimpleTx m]
nodes LocalChainState m SimpleTx
localChainState
  SimulatedChainNetwork SimpleTx m
-> m (SimulatedChainNetwork SimpleTx m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimulatedChainNetwork SimpleTx m
 -> m (SimulatedChainNetwork SimpleTx m))
-> SimulatedChainNetwork SimpleTx m
-> m (SimulatedChainNetwork SimpleTx m)
forall a b. (a -> b) -> a -> b
$
    SimulatedChainNetwork
      { $sel:connectNode:SimulatedChainNetwork :: DraftHydraNode SimpleTx m -> m (HydraNode SimpleTx m)
connectNode = \DraftHydraNode SimpleTx m
draftNode -> do
          let mockChain :: Chain SimpleTx m
mockChain =
                Chain
                  { $sel:postTx:Chain :: MonadThrow m => PostChainTx SimpleTx -> m ()
postTx = \PostChainTx SimpleTx
tx -> do
                      UTCTime
now <- m UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
                      -- Only observe "after one block"
                      m (Async m ()) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Async m ()) -> m ())
-> (m () -> m (Async m ())) -> m () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> m (Async m ())
forall a. m a -> m (Async m a)
forall (m :: * -> *) a. MonadAsync m => m a -> m (Async m a)
async (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
                        DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
blockTime
                        TVar m [HydraNode SimpleTx m]
-> TVar m [ChainEvent SimpleTx]
-> LocalChainState m SimpleTx
-> OnChainTx SimpleTx
-> m ()
forall {m :: * -> *} {t :: * -> *}.
(MonadSTM m, Foldable t) =>
TVar m (t (HydraNode SimpleTx m))
-> TVar m [ChainEvent SimpleTx]
-> LocalChainState m SimpleTx
-> OnChainTx SimpleTx
-> m ()
createAndYieldEvent TVar m [HydraNode SimpleTx m]
nodes TVar m [ChainEvent SimpleTx]
history LocalChainState m SimpleTx
localChainState (OnChainTx SimpleTx -> m ()) -> OnChainTx SimpleTx -> m ()
forall a b. (a -> b) -> a -> b
$ UTCTime -> PostChainTx SimpleTx -> OnChainTx SimpleTx
forall tx. IsTx tx => UTCTime -> PostChainTx tx -> OnChainTx tx
toOnChainTx UTCTime
now PostChainTx SimpleTx
tx
                  , $sel:draftCommitTx:Chain :: MonadThrow m =>
HeadId
-> CommitBlueprintTx SimpleTx
-> m (Either (PostTxError SimpleTx) SimpleTx)
draftCommitTx = \HeadId
_ -> Text
-> CommitBlueprintTx SimpleTx
-> m (Either (PostTxError SimpleTx) SimpleTx)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"unexpected call to draftCommitTx"
                  , $sel:draftDepositTx:Chain :: MonadThrow m =>
HeadId
-> CommitBlueprintTx SimpleTx
-> UTCTime
-> m (Either (PostTxError SimpleTx) SimpleTx)
draftDepositTx = \HeadId
_ -> Text
-> CommitBlueprintTx SimpleTx
-> UTCTime
-> m (Either (PostTxError SimpleTx) SimpleTx)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"unexpected call to draftDepositTx"
                  , $sel:submitTx:Chain :: MonadThrow m => SimpleTx -> m ()
submitTx = \SimpleTx
_ -> Text -> m ()
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"unexpected call to submitTx"
                  }
              mockNetwork :: Network m (Message SimpleTx)
mockNetwork = DraftHydraNode SimpleTx m
-> TVar m [HydraNode SimpleTx m] -> Network m (Message SimpleTx)
forall (m :: * -> *) tx.
MonadSTM m =>
DraftHydraNode tx m
-> TVar m [HydraNode tx m] -> Network m (Message tx)
createMockNetwork DraftHydraNode SimpleTx m
draftNode TVar m [HydraNode SimpleTx m]
nodes
              mockServer :: Server tx m
mockServer = Server{$sel:sendMessage:Server :: ClientMessage tx -> m ()
sendMessage = m () -> ClientMessage tx -> m ()
forall a b. a -> b -> a
const (m () -> ClientMessage tx -> m ())
-> m () -> ClientMessage tx -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()}
          HydraNode SimpleTx m
node <- Chain SimpleTx m
-> Network m (Message SimpleTx)
-> Server SimpleTx m
-> DraftHydraNode SimpleTx m
-> m (HydraNode SimpleTx m)
forall (m :: * -> *) tx.
Monad m =>
Chain tx m
-> Network m (Message tx)
-> Server tx m
-> DraftHydraNode tx m
-> m (HydraNode tx m)
connect Chain SimpleTx m
mockChain Network m (Message SimpleTx)
mockNetwork Server SimpleTx m
forall {tx}. Server tx m
mockServer DraftHydraNode SimpleTx m
draftNode
          STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ TVar m [HydraNode SimpleTx m]
-> ([HydraNode SimpleTx m] -> [HydraNode SimpleTx m]) -> STM m ()
forall a. TVar m a -> (a -> a) -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
TVar m a -> (a -> a) -> STM m ()
modifyTVar TVar m [HydraNode SimpleTx m]
nodes (HydraNode SimpleTx m
node :)
          HydraNode SimpleTx m -> m (HydraNode SimpleTx m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HydraNode SimpleTx m
node
      , Async m ()
$sel:tickThread:SimulatedChainNetwork :: Async m ()
tickThread :: Async m ()
tickThread
      , $sel:rollbackAndForward:SimulatedChainNetwork :: TTL -> m ()
rollbackAndForward = TVar m [HydraNode SimpleTx m]
-> TVar m [ChainEvent SimpleTx]
-> LocalChainState m SimpleTx
-> TTL
-> m ()
forall {tx} {a} {m :: * -> *} {t :: * -> *}.
(IsChainState tx, Integral a, MonadSTM m, Foldable t) =>
TVar m (t (HydraNode tx m))
-> TVar m [ChainEvent tx] -> LocalChainState m tx -> a -> m ()
rollbackAndForward TVar m [HydraNode SimpleTx m]
nodes TVar m [ChainEvent SimpleTx]
history LocalChainState m SimpleTx
localChainState
      , $sel:simulateCommit:SimulatedChainNetwork :: HeadId -> Party -> UTxOType SimpleTx -> m ()
simulateCommit = \HeadId
headId Party
party UTxOType SimpleTx
toCommit ->
          TVar m [HydraNode SimpleTx m]
-> TVar m [ChainEvent SimpleTx]
-> LocalChainState m SimpleTx
-> OnChainTx SimpleTx
-> m ()
forall {m :: * -> *} {t :: * -> *}.
(MonadSTM m, Foldable t) =>
TVar m (t (HydraNode SimpleTx m))
-> TVar m [ChainEvent SimpleTx]
-> LocalChainState m SimpleTx
-> OnChainTx SimpleTx
-> m ()
createAndYieldEvent TVar m [HydraNode SimpleTx m]
nodes TVar m [ChainEvent SimpleTx]
history LocalChainState m SimpleTx
localChainState (OnChainTx SimpleTx -> m ()) -> OnChainTx SimpleTx -> m ()
forall a b. (a -> b) -> a -> b
$ OnCommitTx{HeadId
headId :: HeadId
$sel:headId:OnInitTx :: HeadId
headId, Party
party :: Party
$sel:party:OnInitTx :: Party
party, $sel:committed:OnInitTx :: UTxOType SimpleTx
committed = UTxOType SimpleTx
toCommit}
      , $sel:simulateDeposit:SimulatedChainNetwork :: HeadId -> UTxOType SimpleTx -> UTCTime -> m (TxIdType SimpleTx)
simulateDeposit = \HeadId
headId UTxOType SimpleTx
toDeposit UTCTime
deadline -> do
          Integer
depositTxId <- STM m Integer -> m Integer
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m Integer -> m Integer) -> STM m Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ TVar m Integer -> (Integer -> (Integer, Integer)) -> STM m Integer
forall s a. TVar m s -> (s -> (a, s)) -> STM m a
forall (m :: * -> *) s a.
MonadSTM m =>
TVar m s -> (s -> (a, s)) -> STM m a
stateTVar TVar m Integer
nextTxId (\Integer
i -> (Integer
i, Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1))
          TVar m [HydraNode SimpleTx m]
-> TVar m [ChainEvent SimpleTx]
-> LocalChainState m SimpleTx
-> OnChainTx SimpleTx
-> m ()
forall {m :: * -> *} {t :: * -> *}.
(MonadSTM m, Foldable t) =>
TVar m (t (HydraNode SimpleTx m))
-> TVar m [ChainEvent SimpleTx]
-> LocalChainState m SimpleTx
-> OnChainTx SimpleTx
-> m ()
createAndYieldEvent TVar m [HydraNode SimpleTx m]
nodes TVar m [ChainEvent SimpleTx]
history LocalChainState m SimpleTx
localChainState (OnChainTx SimpleTx -> m ()) -> OnChainTx SimpleTx -> m ()
forall a b. (a -> b) -> a -> b
$ OnDepositTx{HeadId
$sel:headId:OnInitTx :: HeadId
headId :: HeadId
headId, $sel:deposited:OnInitTx :: UTxOType SimpleTx
deposited = UTxOType SimpleTx
toDeposit, UTCTime
deadline :: UTCTime
$sel:deadline:OnInitTx :: UTCTime
deadline, Integer
TxIdType SimpleTx
depositTxId :: Integer
$sel:depositTxId:OnInitTx :: TxIdType SimpleTx
depositTxId}
          Integer -> m Integer
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
depositTxId
      , $sel:closeWithInitialSnapshot:SimulatedChainNetwork :: (Party, UTxOType SimpleTx) -> m ()
closeWithInitialSnapshot = Text -> (Party, Set SimpleTxOut) -> m ()
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"unexpected call to closeWithInitialSnapshot"
      }
 where
  -- seconds
  blockTime :: DiffTime
blockTime = DiffTime
20

  simulateTicks :: TVar m [HydraNode SimpleTx m] -> LocalChainState m SimpleTx -> m ()
simulateTicks TVar m [HydraNode SimpleTx m]
nodes LocalChainState m SimpleTx
localChainState = m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
blockTime
    UTCTime
now <- m UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
    ChainEvent SimpleTx
event <- STM m (ChainEvent SimpleTx) -> m (ChainEvent SimpleTx)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (ChainEvent SimpleTx) -> m (ChainEvent SimpleTx))
-> STM m (ChainEvent SimpleTx) -> m (ChainEvent SimpleTx)
forall a b. (a -> b) -> a -> b
$ do
      SimpleChainState
cs <- LocalChainState m SimpleTx -> STM m (ChainStateType SimpleTx)
forall (m :: * -> *) tx.
LocalChainState m tx -> STM m (ChainStateType tx)
getLatest LocalChainState m SimpleTx
localChainState
      let chainSlot :: ChainSlot
chainSlot = ChainStateType SimpleTx -> ChainSlot
forall tx. IsChainState tx => ChainStateType tx -> ChainSlot
chainStateSlot ChainStateType SimpleTx
SimpleChainState
cs
      ChainEvent SimpleTx -> STM m (ChainEvent SimpleTx)
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChainEvent SimpleTx -> STM m (ChainEvent SimpleTx))
-> ChainEvent SimpleTx -> STM m (ChainEvent SimpleTx)
forall a b. (a -> b) -> a -> b
$ UTCTime -> ChainSlot -> ChainEvent SimpleTx
forall tx. UTCTime -> ChainSlot -> ChainEvent tx
Tick UTCTime
now ChainSlot
chainSlot
    TVar m [HydraNode SimpleTx m] -> m [HydraNode SimpleTx m]
forall a. TVar m a -> m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
readTVarIO TVar m [HydraNode SimpleTx m]
nodes m [HydraNode SimpleTx m]
-> ([HydraNode SimpleTx m] -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (HydraNode SimpleTx m -> m ()) -> [HydraNode SimpleTx m] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (HydraNode SimpleTx m -> ChainEvent SimpleTx -> m ()
forall tx (m :: * -> *). HydraNode tx m -> ChainEvent tx -> m ()
`handleChainEvent` ChainEvent SimpleTx
event)

  createAndYieldEvent :: TVar m (t (HydraNode SimpleTx m))
-> TVar m [ChainEvent SimpleTx]
-> LocalChainState m SimpleTx
-> OnChainTx SimpleTx
-> m ()
createAndYieldEvent TVar m (t (HydraNode SimpleTx m))
nodes TVar m [ChainEvent SimpleTx]
history LocalChainState m SimpleTx
localChainState OnChainTx SimpleTx
tx = do
    ChainEvent SimpleTx
chainEvent <- STM m (ChainEvent SimpleTx) -> m (ChainEvent SimpleTx)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (ChainEvent SimpleTx) -> m (ChainEvent SimpleTx))
-> STM m (ChainEvent SimpleTx) -> m (ChainEvent SimpleTx)
forall a b. (a -> b) -> a -> b
$ do
      SimpleChainState
cs <- LocalChainState m SimpleTx -> STM m (ChainStateType SimpleTx)
forall (m :: * -> *) tx.
LocalChainState m tx -> STM m (ChainStateType tx)
getLatest LocalChainState m SimpleTx
localChainState
      let cs' :: SimpleChainState
cs' = SimpleChainState -> SimpleChainState
advanceSlot SimpleChainState
cs
      LocalChainState m SimpleTx -> ChainStateType SimpleTx -> STM m ()
forall (m :: * -> *) tx.
LocalChainState m tx -> ChainStateType tx -> STM m ()
pushNew LocalChainState m SimpleTx
localChainState ChainStateType SimpleTx
SimpleChainState
cs'
      ChainEvent SimpleTx -> STM m (ChainEvent SimpleTx)
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChainEvent SimpleTx -> STM m (ChainEvent SimpleTx))
-> ChainEvent SimpleTx -> STM m (ChainEvent SimpleTx)
forall a b. (a -> b) -> a -> b
$
        Observation
          { $sel:observedTx:Observation :: OnChainTx SimpleTx
observedTx = OnChainTx SimpleTx
tx
          , $sel:newChainState:Observation :: ChainStateType SimpleTx
newChainState = ChainStateType SimpleTx
SimpleChainState
cs'
          }
    TVar m (t (HydraNode SimpleTx m))
-> TVar m [ChainEvent SimpleTx] -> ChainEvent SimpleTx -> m ()
forall {m :: * -> *} {t :: * -> *} {tx}.
(MonadSTM m, Foldable t) =>
TVar m (t (HydraNode tx m))
-> TVar m [ChainEvent tx] -> ChainEvent tx -> m ()
recordAndYieldEvent TVar m (t (HydraNode SimpleTx m))
nodes TVar m [ChainEvent SimpleTx]
history ChainEvent SimpleTx
chainEvent

  advanceSlot :: SimpleChainState -> SimpleChainState
advanceSlot SimpleChainState{ChainSlot
$sel:slot:SimpleChainState :: SimpleChainState -> ChainSlot
slot :: ChainSlot
slot} = SimpleChainState{$sel:slot:SimpleChainState :: ChainSlot
slot = ChainSlot -> ChainSlot
nextChainSlot ChainSlot
slot}

  recordAndYieldEvent :: TVar m (t (HydraNode tx m))
-> TVar m [ChainEvent tx] -> ChainEvent tx -> m ()
recordAndYieldEvent TVar m (t (HydraNode tx m))
nodes TVar m [ChainEvent tx]
history ChainEvent tx
chainEvent = do
    t (HydraNode tx m)
ns <- STM m (t (HydraNode tx m)) -> m (t (HydraNode tx m))
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (t (HydraNode tx m)) -> m (t (HydraNode tx m)))
-> STM m (t (HydraNode tx m)) -> m (t (HydraNode tx m))
forall a b. (a -> b) -> a -> b
$ do
      TVar m [ChainEvent tx]
-> ([ChainEvent tx] -> [ChainEvent tx]) -> STM m ()
forall a. TVar m a -> (a -> a) -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
TVar m a -> (a -> a) -> STM m ()
modifyTVar' TVar m [ChainEvent tx]
history (ChainEvent tx
chainEvent :)
      TVar m (t (HydraNode tx m)) -> STM m (t (HydraNode tx m))
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m (t (HydraNode tx m))
nodes
    t (HydraNode tx m) -> (HydraNode tx m -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t (HydraNode tx m)
ns ((HydraNode tx m -> m ()) -> m ())
-> (HydraNode tx m -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \HydraNode tx m
n ->
      HydraNode tx m -> ChainEvent tx -> m ()
forall tx (m :: * -> *). HydraNode tx m -> ChainEvent tx -> m ()
handleChainEvent HydraNode tx m
n ChainEvent tx
chainEvent

  rollbackAndForward :: TVar m (t (HydraNode tx m))
-> TVar m [ChainEvent tx] -> LocalChainState m tx -> a -> m ()
rollbackAndForward TVar m (t (HydraNode tx m))
nodes TVar m [ChainEvent tx]
history LocalChainState m tx
localChainState a
steps = do
    -- Split the history after given steps
    ([ChainEvent tx]
toReplay, [ChainEvent tx]
kept) <- STM m ([ChainEvent tx], [ChainEvent tx])
-> m ([ChainEvent tx], [ChainEvent tx])
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m ([ChainEvent tx], [ChainEvent tx])
 -> m ([ChainEvent tx], [ChainEvent tx]))
-> STM m ([ChainEvent tx], [ChainEvent tx])
-> m ([ChainEvent tx], [ChainEvent tx])
forall a b. (a -> b) -> a -> b
$ do
      ([ChainEvent tx]
toReplay, [ChainEvent tx]
kept) <- Int -> [ChainEvent tx] -> ([ChainEvent tx], [ChainEvent tx])
forall a. Int -> [a] -> ([a], [a])
splitAt (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
steps) ([ChainEvent tx] -> ([ChainEvent tx], [ChainEvent tx]))
-> STM m [ChainEvent tx]
-> STM m ([ChainEvent tx], [ChainEvent tx])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar m [ChainEvent tx] -> STM m [ChainEvent tx]
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m [ChainEvent tx]
history
      TVar m [ChainEvent tx] -> [ChainEvent tx] -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m [ChainEvent tx]
history [ChainEvent tx]
kept
      ([ChainEvent tx], [ChainEvent tx])
-> STM m ([ChainEvent tx], [ChainEvent tx])
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ChainEvent tx] -> [ChainEvent tx]
forall a. [a] -> [a]
reverse [ChainEvent tx]
toReplay, [ChainEvent tx]
kept)
    -- Determine the new (last kept one) chainstate
    let chainSlot :: ChainSlot
chainSlot =
          [ChainSlot] -> ChainSlot
forall a. HasCallStack => [a] -> a
List.head ([ChainSlot] -> ChainSlot) -> [ChainSlot] -> ChainSlot
forall a b. (a -> b) -> a -> b
$
            (ChainEvent tx -> ChainSlot) -> [ChainEvent tx] -> [ChainSlot]
forall a b. (a -> b) -> [a] -> [b]
map
              ( \case
                  Observation{ChainStateType tx
$sel:newChainState:Observation :: forall tx. ChainEvent tx -> ChainStateType tx
newChainState :: ChainStateType tx
newChainState} -> ChainStateType tx -> ChainSlot
forall tx. IsChainState tx => ChainStateType tx -> ChainSlot
chainStateSlot ChainStateType tx
newChainState
                  ChainEvent tx
_NoObservation -> Text -> ChainSlot
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"unexpected non-observation ChainEvent"
              )
              [ChainEvent tx]
kept
    ChainStateType tx
rolledBackChainState <- STM m (ChainStateType tx) -> m (ChainStateType tx)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (ChainStateType tx) -> m (ChainStateType tx))
-> STM m (ChainStateType tx) -> m (ChainStateType tx)
forall a b. (a -> b) -> a -> b
$ LocalChainState m tx -> ChainSlot -> STM m (ChainStateType tx)
forall (m :: * -> *) tx.
LocalChainState m tx -> ChainSlot -> STM m (ChainStateType tx)
rollback LocalChainState m tx
localChainState ChainSlot
chainSlot
    -- Yield rollback events
    t (HydraNode tx m)
ns <- TVar m (t (HydraNode tx m)) -> m (t (HydraNode tx m))
forall a. TVar m a -> m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
readTVarIO TVar m (t (HydraNode tx m))
nodes
    t (HydraNode tx m) -> (HydraNode tx m -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t (HydraNode tx m)
ns ((HydraNode tx m -> m ()) -> m ())
-> (HydraNode tx m -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \HydraNode tx m
n -> HydraNode tx m -> ChainEvent tx -> m ()
forall tx (m :: * -> *). HydraNode tx m -> ChainEvent tx -> m ()
handleChainEvent HydraNode tx m
n Rollback{ChainStateType tx
rolledBackChainState :: ChainStateType tx
$sel:rolledBackChainState:Observation :: ChainStateType tx
rolledBackChainState}
    -- Re-play the observation events
    [ChainEvent tx] -> (ChainEvent tx -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ChainEvent tx]
toReplay ((ChainEvent tx -> m ()) -> m ())
-> (ChainEvent tx -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \ChainEvent tx
ev ->
      TVar m (t (HydraNode tx m))
-> TVar m [ChainEvent tx] -> ChainEvent tx -> m ()
forall {m :: * -> *} {t :: * -> *} {tx}.
(MonadSTM m, Foldable t) =>
TVar m (t (HydraNode tx m))
-> TVar m [ChainEvent tx] -> ChainEvent tx -> m ()
recordAndYieldEvent TVar m (t (HydraNode tx m))
nodes TVar m [ChainEvent tx]
history ChainEvent tx
ev

handleChainEvent :: HydraNode tx m -> ChainEvent tx -> m ()
handleChainEvent :: forall tx (m :: * -> *). HydraNode tx m -> ChainEvent tx -> m ()
handleChainEvent HydraNode{InputQueue m (Input tx)
inputQueue :: InputQueue m (Input tx)
$sel:inputQueue:HydraNode :: forall tx (m :: * -> *). HydraNode tx m -> InputQueue m (Input tx)
inputQueue} = InputQueue m (Input tx) -> Input tx -> m ()
forall (m :: * -> *) e. InputQueue m e -> e -> m ()
enqueue InputQueue m (Input tx)
inputQueue (Input tx -> m ())
-> (ChainEvent tx -> Input tx) -> ChainEvent tx -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainEvent tx -> Input tx
forall tx. ChainEvent tx -> Input tx
ChainInput

createMockNetwork :: MonadSTM m => DraftHydraNode tx m -> TVar m [HydraNode tx m] -> Network m (Message tx)
createMockNetwork :: forall (m :: * -> *) tx.
MonadSTM m =>
DraftHydraNode tx m
-> TVar m [HydraNode tx m] -> Network m (Message tx)
createMockNetwork DraftHydraNode tx m
node TVar m [HydraNode tx m]
nodes =
  Network{Message tx -> m ()
broadcast :: Message tx -> m ()
$sel:broadcast:Network :: Message tx -> m ()
broadcast}
 where
  broadcast :: Message tx -> m ()
broadcast Message tx
msg = do
    [HydraNode tx m]
allNodes <- TVar m [HydraNode tx m] -> m [HydraNode tx m]
forall a. TVar m a -> m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
readTVarIO TVar m [HydraNode tx m]
nodes
    (HydraNode tx m -> m ()) -> [HydraNode tx m] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (HydraNode tx m -> Message tx -> m ()
`handleMessage` Message tx
msg) [HydraNode tx m]
allNodes

  handleMessage :: HydraNode tx m -> Message tx -> m ()
handleMessage HydraNode{InputQueue m (Input tx)
$sel:inputQueue:HydraNode :: forall tx (m :: * -> *). HydraNode tx m -> InputQueue m (Input tx)
inputQueue :: InputQueue m (Input tx)
inputQueue} Message tx
msg =
    InputQueue m (Input tx) -> Input tx -> m ()
forall (m :: * -> *) e. InputQueue m e -> e -> m ()
enqueue InputQueue m (Input tx)
inputQueue (Input tx -> m ())
-> (NetworkEvent (Message tx) -> Input tx)
-> NetworkEvent (Message tx)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TTL -> NetworkEvent (Message tx) -> Input tx
forall tx. TTL -> NetworkEvent (Message tx) -> Input tx
NetworkInput TTL
defaultTTL (NetworkEvent (Message tx) -> m ())
-> NetworkEvent (Message tx) -> m ()
forall a b. (a -> b) -> a -> b
$ ReceivedMessage{Party
sender :: Party
$sel:sender:ConnectivityEvent :: Party
sender, Message tx
msg :: Message tx
$sel:msg:ConnectivityEvent :: Message tx
msg}

  sender :: Party
sender = DraftHydraNode tx m -> Party
forall a. HasParty a => a -> Party
getParty DraftHydraNode tx m
node

-- | Derive an 'OnChainTx' from 'PostChainTx' to simulate a "perfect" chain.
-- NOTE: This implementation announces hard-coded contestationDeadlines. Also,
-- all heads will have the same 'headId' and 'headSeed'.
toOnChainTx :: IsTx tx => UTCTime -> PostChainTx tx -> OnChainTx tx
toOnChainTx :: forall tx. IsTx tx => UTCTime -> PostChainTx tx -> OnChainTx tx
toOnChainTx UTCTime
now = \case
  InitTx{[OnChainId]
participants :: [OnChainId]
$sel:participants:InitTx :: forall tx. PostChainTx tx -> [OnChainId]
participants, HeadParameters
headParameters :: HeadParameters
$sel:headParameters:InitTx :: forall tx. PostChainTx tx -> HeadParameters
headParameters} ->
    OnInitTx{$sel:headId:OnInitTx :: HeadId
headId = HeadId
testHeadId, headSeed :: HeadSeed
headSeed = HeadSeed
testHeadSeed, HeadParameters
headParameters :: HeadParameters
$sel:headParameters:OnInitTx :: HeadParameters
headParameters, [OnChainId]
participants :: [OnChainId]
$sel:participants:OnInitTx :: [OnChainId]
participants}
  AbortTx{} ->
    OnAbortTx{$sel:headId:OnInitTx :: HeadId
headId = HeadId
testHeadId}
  CollectComTx{HeadId
headId :: forall tx. PostChainTx tx -> HeadId
headId :: HeadId
headId} ->
    OnCollectComTx{HeadId
$sel:headId:OnInitTx :: HeadId
headId :: HeadId
headId}
  RecoverTx{HeadId
headId :: forall tx. PostChainTx tx -> HeadId
headId :: HeadId
headId, TxIdType tx
recoverTxId :: TxIdType tx
$sel:recoverTxId:InitTx :: forall tx. PostChainTx tx -> TxIdType tx
recoverTxId, UTxOType tx
recoverUTxO :: UTxOType tx
$sel:recoverUTxO:InitTx :: forall tx. PostChainTx tx -> UTxOType tx
recoverUTxO} ->
    OnRecoverTx{HeadId
$sel:headId:OnInitTx :: HeadId
headId :: HeadId
headId, $sel:recoveredTxId:OnInitTx :: TxIdType tx
recoveredTxId = TxIdType tx
recoverTxId, $sel:recoveredUTxO:OnInitTx :: UTxOType tx
recoveredUTxO = UTxOType tx
recoverUTxO}
  IncrementTx{HeadId
headId :: forall tx. PostChainTx tx -> HeadId
headId :: HeadId
headId, ConfirmedSnapshot tx
incrementingSnapshot :: ConfirmedSnapshot tx
$sel:incrementingSnapshot:InitTx :: forall tx. PostChainTx tx -> ConfirmedSnapshot tx
incrementingSnapshot, TxIdType tx
depositTxId :: TxIdType tx
$sel:depositTxId:InitTx :: forall tx. PostChainTx tx -> TxIdType tx
depositTxId} ->
    OnIncrementTx
      { HeadId
$sel:headId:OnInitTx :: HeadId
headId :: HeadId
headId
      , $sel:newVersion:OnInitTx :: SnapshotVersion
newVersion = SnapshotVersion
version SnapshotVersion -> SnapshotVersion -> SnapshotVersion
forall a. Num a => a -> a -> a
+ SnapshotVersion
1
      , TxIdType tx
$sel:depositTxId:OnInitTx :: TxIdType tx
depositTxId :: TxIdType tx
depositTxId
      }
   where
    Snapshot{SnapshotVersion
version :: SnapshotVersion
$sel:version:Snapshot :: forall tx. Snapshot tx -> SnapshotVersion
version} = ConfirmedSnapshot tx -> Snapshot tx
forall tx. ConfirmedSnapshot tx -> Snapshot tx
getSnapshot ConfirmedSnapshot tx
incrementingSnapshot
  DecrementTx{HeadId
headId :: forall tx. PostChainTx tx -> HeadId
headId :: HeadId
headId, ConfirmedSnapshot tx
decrementingSnapshot :: ConfirmedSnapshot tx
$sel:decrementingSnapshot:InitTx :: forall tx. PostChainTx tx -> ConfirmedSnapshot tx
decrementingSnapshot} ->
    OnDecrementTx
      { HeadId
$sel:headId:OnInitTx :: HeadId
headId :: HeadId
headId
      , $sel:newVersion:OnInitTx :: SnapshotVersion
newVersion = SnapshotVersion
version SnapshotVersion -> SnapshotVersion -> SnapshotVersion
forall a. Num a => a -> a -> a
+ SnapshotVersion
1
      , $sel:distributedUTxO:OnInitTx :: UTxOType tx
distributedUTxO = UTxOType tx -> Maybe (UTxOType tx) -> UTxOType tx
forall a. a -> Maybe a -> a
fromMaybe UTxOType tx
forall a. Monoid a => a
mempty Maybe (UTxOType tx)
utxoToDecommit
      }
   where
    Snapshot{SnapshotVersion
$sel:version:Snapshot :: forall tx. Snapshot tx -> SnapshotVersion
version :: SnapshotVersion
version, Maybe (UTxOType tx)
$sel:utxoToDecommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToDecommit :: Maybe (UTxOType tx)
utxoToDecommit} = ConfirmedSnapshot tx -> Snapshot tx
forall tx. ConfirmedSnapshot tx -> Snapshot tx
getSnapshot ConfirmedSnapshot tx
decrementingSnapshot
  CloseTx{ConfirmedSnapshot tx
closingSnapshot :: ConfirmedSnapshot tx
$sel:closingSnapshot:InitTx :: forall tx. PostChainTx tx -> ConfirmedSnapshot tx
closingSnapshot} ->
    OnCloseTx
      { $sel:headId:OnInitTx :: HeadId
headId = HeadId
testHeadId
      , $sel:snapshotNumber:OnInitTx :: SnapshotNumber
snapshotNumber = Snapshot tx -> SnapshotNumber
forall tx. Snapshot tx -> SnapshotNumber
number (ConfirmedSnapshot tx -> Snapshot tx
forall tx. ConfirmedSnapshot tx -> Snapshot tx
getSnapshot ConfirmedSnapshot tx
closingSnapshot)
      , $sel:contestationDeadline:OnInitTx :: UTCTime
contestationDeadline = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (ContestationPeriod -> NominalDiffTime
CP.toNominalDiffTime ContestationPeriod
defaultContestationPeriod) UTCTime
now
      }
  ContestTx{HeadId
headId :: forall tx. PostChainTx tx -> HeadId
headId :: HeadId
headId, ConfirmedSnapshot tx
contestingSnapshot :: ConfirmedSnapshot tx
$sel:contestingSnapshot:InitTx :: forall tx. PostChainTx tx -> ConfirmedSnapshot tx
contestingSnapshot} ->
    OnContestTx
      { HeadId
$sel:headId:OnInitTx :: HeadId
headId :: HeadId
headId
      , $sel:snapshotNumber:OnInitTx :: SnapshotNumber
snapshotNumber = Snapshot tx -> SnapshotNumber
forall tx. Snapshot tx -> SnapshotNumber
number (ConfirmedSnapshot tx -> Snapshot tx
forall tx. ConfirmedSnapshot tx -> Snapshot tx
getSnapshot ConfirmedSnapshot tx
contestingSnapshot)
      , $sel:contestationDeadline:OnInitTx :: UTCTime
contestationDeadline = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (ContestationPeriod -> NominalDiffTime
CP.toNominalDiffTime ContestationPeriod
defaultContestationPeriod) UTCTime
now
      }
  FanoutTx{UTxOType tx
utxo :: UTxOType tx
$sel:utxo:InitTx :: forall tx. PostChainTx tx -> UTxOType tx
utxo, Maybe (UTxOType tx)
utxoToCommit :: Maybe (UTxOType tx)
$sel:utxoToCommit:InitTx :: forall tx. PostChainTx tx -> Maybe (UTxOType tx)
utxoToCommit, Maybe (UTxOType tx)
utxoToDecommit :: Maybe (UTxOType tx)
$sel:utxoToDecommit:InitTx :: forall tx. PostChainTx tx -> Maybe (UTxOType tx)
utxoToDecommit} ->
    OnFanoutTx{$sel:headId:OnInitTx :: HeadId
headId = HeadId
testHeadId, $sel:fanoutUTxO:OnInitTx :: UTxOType tx
fanoutUTxO = UTxOType tx
utxo UTxOType tx -> UTxOType tx -> UTxOType tx
forall a. Semigroup a => a -> a -> a
<> UTxOType tx -> Maybe (UTxOType tx) -> UTxOType tx
forall a. a -> Maybe a -> a
fromMaybe UTxOType tx
forall a. Monoid a => a
mempty Maybe (UTxOType tx)
utxoToCommit UTxOType tx -> UTxOType tx -> UTxOType tx
forall a. Semigroup a => a -> a -> a
<> UTxOType tx -> Maybe (UTxOType tx) -> UTxOType tx
forall a. a -> Maybe a -> a
fromMaybe UTxOType tx
forall a. Monoid a => a
mempty Maybe (UTxOType tx)
utxoToDecommit}

newDeadlineFarEnoughFromNow :: MonadTime m => m UTCTime
newDeadlineFarEnoughFromNow :: forall (m :: * -> *). MonadTime m => m UTCTime
newDeadlineFarEnoughFromNow =
  NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (NominalDiffTime
2 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* DepositPeriod -> NominalDiffTime
DP.toNominalDiffTime DepositPeriod
defaultDepositPeriod) (UTCTime -> UTCTime) -> m UTCTime -> m UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime

nothingHappensFor ::
  (MonadTimer m, MonadThrow m, IsChainState tx) =>
  TestHydraClient tx m ->
  NominalDiffTime ->
  m ()
nothingHappensFor :: forall (m :: * -> *) tx.
(MonadTimer m, MonadThrow m, IsChainState tx) =>
TestHydraClient tx m -> NominalDiffTime -> m ()
nothingHappensFor TestHydraClient tx m
node NominalDiffTime
secs =
  DiffTime -> m (ServerOutput tx) -> m (Maybe (ServerOutput tx))
forall a. DiffTime -> m a -> m (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout (NominalDiffTime -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
secs) (TestHydraClient tx m -> m (ServerOutput tx)
forall tx (m :: * -> *).
TestHydraClient tx m -> m (ServerOutput tx)
waitForNext TestHydraClient tx m
node) m (Maybe (ServerOutput tx))
-> (Maybe (ServerOutput tx) -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe (ServerOutput tx) -> Maybe (ServerOutput tx) -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m, Eq a, Show a) =>
a -> a -> m ()
`shouldBe` Maybe (ServerOutput tx)
forall a. Maybe a
Nothing)

withHydraNode ::
  forall s a.
  SigningKey HydraKey ->
  [Party] ->
  SimulatedChainNetwork SimpleTx (IOSim s) ->
  (TestHydraClient SimpleTx (IOSim s) -> IOSim s a) ->
  IOSim s a
withHydraNode :: forall s a.
SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode SigningKey HydraKey
signingKey [Party]
otherParties SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s) -> IOSim s a
action = do
  DepositPeriod
-> SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
forall s b.
DepositPeriod
-> SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s b)
-> IOSim s b
withHydraNode' DepositPeriod
defaultDepositPeriod SigningKey HydraKey
signingKey [Party]
otherParties SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s) -> IOSim s a
action

withHydraNode' ::
  DepositPeriod ->
  SigningKey HydraKey ->
  [Party] ->
  SimulatedChainNetwork SimpleTx (IOSim s) ->
  (TestHydraClient SimpleTx (IOSim s) -> IOSim s b) ->
  IOSim s b
withHydraNode' :: forall s b.
DepositPeriod
-> SigningKey HydraKey
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s b)
-> IOSim s b
withHydraNode' DepositPeriod
dp SigningKey HydraKey
signingKey [Party]
otherParties SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s) -> IOSim s b
action = do
  TQueue (IOSim s) (ServerOutput SimpleTx)
outputs <- STM (IOSim s) (TQueue (IOSim s) (ServerOutput SimpleTx))
-> IOSim s (TQueue (IOSim s) (ServerOutput SimpleTx))
forall a. HasCallStack => STM (IOSim s) a -> IOSim s a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically STM (IOSim s) (TQueue (IOSim s) (ServerOutput SimpleTx))
forall a. STM (IOSim s) (TQueue (IOSim s) a)
forall (m :: * -> *) a. MonadSTM m => STM m (TQueue m a)
newTQueue
  TQueue (IOSim s) (ClientMessage SimpleTx)
messages <- STM (IOSim s) (TQueue (IOSim s) (ClientMessage SimpleTx))
-> IOSim s (TQueue (IOSim s) (ClientMessage SimpleTx))
forall a. HasCallStack => STM (IOSim s) a -> IOSim s a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically STM (IOSim s) (TQueue (IOSim s) (ClientMessage SimpleTx))
forall a. STM (IOSim s) (TQueue (IOSim s) a)
forall (m :: * -> *) a. MonadSTM m => STM m (TQueue m a)
newTQueue
  TVar s [ServerOutput SimpleTx]
outputHistory <- [ServerOutput SimpleTx]
-> IOSim s (TVar (IOSim s) [ServerOutput SimpleTx])
forall a. a -> IOSim s (TVar (IOSim s) a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO [ServerOutput SimpleTx]
forall a. Monoid a => a
mempty
  let initialChainState :: SimpleChainState
initialChainState = SimpleChainState{$sel:slot:SimpleChainState :: ChainSlot
slot = TTL -> ChainSlot
ChainSlot TTL
0}
  HydraNode SimpleTx (IOSim s)
node <-
    Tracer (IOSim s) (HydraNodeLog SimpleTx)
-> Ledger SimpleTx
-> ChainStateType SimpleTx
-> SigningKey HydraKey
-> [Party]
-> TQueue (IOSim s) (ServerOutput SimpleTx)
-> TQueue (IOSim s) (ClientMessage SimpleTx)
-> TVar (IOSim s) [ServerOutput SimpleTx]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> ContestationPeriod
-> DepositPeriod
-> IOSim s (HydraNode SimpleTx (IOSim s))
forall tx (m :: * -> *).
(IsTx tx, MonadDelay m, MonadAsync m, MonadLabelledSTM m,
 MonadThrow m) =>
Tracer m (HydraNodeLog tx)
-> Ledger tx
-> ChainStateType tx
-> SigningKey HydraKey
-> [Party]
-> TQueue m (ServerOutput tx)
-> TQueue m (ClientMessage tx)
-> TVar m [ServerOutput tx]
-> SimulatedChainNetwork tx m
-> ContestationPeriod
-> DepositPeriod
-> m (HydraNode tx m)
createHydraNode
      Tracer (IOSim s) (HydraNodeLog SimpleTx)
forall a s. Typeable a => Tracer (IOSim s) a
traceInIOSim
      Ledger SimpleTx
simpleLedger
      ChainStateType SimpleTx
SimpleChainState
initialChainState
      SigningKey HydraKey
signingKey
      [Party]
otherParties
      TQueue (IOSim s) (ServerOutput SimpleTx)
outputs
      TQueue (IOSim s) (ClientMessage SimpleTx)
messages
      TVar (IOSim s) [ServerOutput SimpleTx]
TVar s [ServerOutput SimpleTx]
outputHistory
      SimulatedChainNetwork SimpleTx (IOSim s)
chain
      ContestationPeriod
defaultContestationPeriod
      DepositPeriod
dp
  IOSim s () -> (Async (IOSim s) () -> IOSim s b) -> IOSim s b
forall a b.
IOSim s a -> (Async (IOSim s) a -> IOSim s b) -> IOSim s b
forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
withAsync (HydraNode SimpleTx (IOSim s) -> IOSim s ()
forall (m :: * -> *) tx.
(MonadCatch m, MonadAsync m, MonadTime m, IsChainState tx) =>
HydraNode tx m -> m ()
runHydraNode HydraNode SimpleTx (IOSim s)
node) ((Async (IOSim s) () -> IOSim s b) -> IOSim s b)
-> (Async (IOSim s) () -> IOSim s b) -> IOSim s b
forall a b. (a -> b) -> a -> b
$ \Async (IOSim s) ()
_ ->
    TestHydraClient SimpleTx (IOSim s) -> IOSim s b
action (TQueue (IOSim s) (ServerOutput SimpleTx)
-> TQueue (IOSim s) (ClientMessage SimpleTx)
-> TVar (IOSim s) [ServerOutput SimpleTx]
-> HydraNode SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
forall (m :: * -> *) tx.
MonadSTM m =>
TQueue m (ServerOutput tx)
-> TQueue m (ClientMessage tx)
-> TVar m [ServerOutput tx]
-> HydraNode tx m
-> TestHydraClient tx m
createTestHydraClient TQueue (IOSim s) (ServerOutput SimpleTx)
outputs TQueue (IOSim s) (ClientMessage SimpleTx)
messages TVar (IOSim s) [ServerOutput SimpleTx]
TVar s [ServerOutput SimpleTx]
outputHistory HydraNode SimpleTx (IOSim s)
node)

createTestHydraClient ::
  MonadSTM m =>
  TQueue m (ServerOutput tx) ->
  TQueue m (ClientMessage tx) ->
  TVar m [ServerOutput tx] ->
  HydraNode tx m ->
  TestHydraClient tx m
createTestHydraClient :: forall (m :: * -> *) tx.
MonadSTM m =>
TQueue m (ServerOutput tx)
-> TQueue m (ClientMessage tx)
-> TVar m [ServerOutput tx]
-> HydraNode tx m
-> TestHydraClient tx m
createTestHydraClient TQueue m (ServerOutput tx)
outputs TQueue m (ClientMessage tx)
messages TVar m [ServerOutput tx]
outputHistory HydraNode{InputQueue m (Input tx)
$sel:inputQueue:HydraNode :: forall tx (m :: * -> *). HydraNode tx m -> InputQueue m (Input tx)
inputQueue :: InputQueue m (Input tx)
inputQueue, NodeState tx m
nodeState :: NodeState tx m
$sel:nodeState:HydraNode :: forall tx (m :: * -> *). HydraNode tx m -> NodeState tx m
nodeState} =
  TestHydraClient
    { $sel:send:TestHydraClient :: ClientInput tx -> m ()
send = InputQueue m (Input tx) -> Input tx -> m ()
forall (m :: * -> *) e. InputQueue m e -> e -> m ()
enqueue InputQueue m (Input tx)
inputQueue (Input tx -> m ())
-> (ClientInput tx -> Input tx) -> ClientInput tx -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientInput tx -> Input tx
forall tx. ClientInput tx -> Input tx
ClientInput
    , $sel:waitForNext:TestHydraClient :: m (ServerOutput tx)
waitForNext = STM m (ServerOutput tx) -> m (ServerOutput tx)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (TQueue m (ServerOutput tx) -> STM m (ServerOutput tx)
forall a. TQueue m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TQueue m a -> STM m a
readTQueue TQueue m (ServerOutput tx)
outputs)
    , $sel:waitForNextMessage:TestHydraClient :: m (ClientMessage tx)
waitForNextMessage = STM m (ClientMessage tx) -> m (ClientMessage tx)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (TQueue m (ClientMessage tx) -> STM m (ClientMessage tx)
forall a. TQueue m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TQueue m a -> STM m a
readTQueue TQueue m (ClientMessage tx)
messages)
    , $sel:injectChainEvent:TestHydraClient :: ChainEvent tx -> m ()
injectChainEvent = InputQueue m (Input tx) -> Input tx -> m ()
forall (m :: * -> *) e. InputQueue m e -> e -> m ()
enqueue InputQueue m (Input tx)
inputQueue (Input tx -> m ())
-> (ChainEvent tx -> Input tx) -> ChainEvent tx -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainEvent tx -> Input tx
forall tx. ChainEvent tx -> Input tx
ChainInput
    , $sel:serverOutputs:TestHydraClient :: m [ServerOutput tx]
serverOutputs = [ServerOutput tx] -> [ServerOutput tx]
forall a. [a] -> [a]
reverse ([ServerOutput tx] -> [ServerOutput tx])
-> m [ServerOutput tx] -> m [ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar m [ServerOutput tx] -> m [ServerOutput tx]
forall a. TVar m a -> m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
readTVarIO TVar m [ServerOutput tx]
outputHistory
    , $sel:queryState:TestHydraClient :: m (HeadState tx)
queryState = STM m (HeadState tx) -> m (HeadState tx)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (NodeState tx m -> STM m (HeadState tx)
forall tx (m :: * -> *). NodeState tx m -> STM m (HeadState tx)
queryHeadState NodeState tx m
nodeState)
    }

createHydraNode ::
  (IsTx tx, MonadDelay m, MonadAsync m, MonadLabelledSTM m, MonadThrow m) =>
  Tracer m (HydraNodeLog tx) ->
  Ledger tx ->
  ChainStateType tx ->
  SigningKey HydraKey ->
  [Party] ->
  TQueue m (ServerOutput tx) ->
  TQueue m (ClientMessage tx) ->
  TVar m [ServerOutput tx] ->
  SimulatedChainNetwork tx m ->
  ContestationPeriod ->
  DepositPeriod ->
  m (HydraNode tx m)
createHydraNode :: forall tx (m :: * -> *).
(IsTx tx, MonadDelay m, MonadAsync m, MonadLabelledSTM m,
 MonadThrow m) =>
Tracer m (HydraNodeLog tx)
-> Ledger tx
-> ChainStateType tx
-> SigningKey HydraKey
-> [Party]
-> TQueue m (ServerOutput tx)
-> TQueue m (ClientMessage tx)
-> TVar m [ServerOutput tx]
-> SimulatedChainNetwork tx m
-> ContestationPeriod
-> DepositPeriod
-> m (HydraNode tx m)
createHydraNode Tracer m (HydraNodeLog tx)
tracer Ledger tx
ledger ChainStateType tx
chainState SigningKey HydraKey
signingKey [Party]
otherParties TQueue m (ServerOutput tx)
outputs TQueue m (ClientMessage tx)
messages TVar m [ServerOutput tx]
outputHistory SimulatedChainNetwork tx m
chain ContestationPeriod
cp DepositPeriod
dp = do
  (EventSource (StateEvent tx) m
eventSource, EventSink (StateEvent tx) m
eventSink) <- m (EventSource (StateEvent tx) m, EventSink (StateEvent tx) m)
forall (m :: * -> *) a.
MonadLabelledSTM m =>
m (EventSource a m, EventSink a m)
createMockSourceSink
  let apiSink :: EventSink (StateEvent tx) m
apiSink =
        EventSink
          { $sel:putEvent:EventSink :: HasEventId (StateEvent tx) => StateEvent tx -> m ()
putEvent = \StateEvent tx
event ->
              case StateEvent tx -> Maybe (TimedServerOutput tx)
forall tx. IsTx tx => StateEvent tx -> Maybe (TimedServerOutput tx)
mkTimedServerOutputFromStateEvent StateEvent tx
event of
                Maybe (TimedServerOutput tx)
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                Just TimedServerOutput{ServerOutput tx
output :: ServerOutput tx
$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output} -> STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
                  TQueue m (ServerOutput tx) -> ServerOutput tx -> STM m ()
forall a. TQueue m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TQueue m a -> a -> STM m ()
writeTQueue TQueue m (ServerOutput tx)
outputs ServerOutput tx
output
                  TVar m [ServerOutput tx]
-> ([ServerOutput tx] -> [ServerOutput tx]) -> STM m ()
forall a. TVar m a -> (a -> a) -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
TVar m a -> (a -> a) -> STM m ()
modifyTVar' TVar m [ServerOutput tx]
outputHistory (ServerOutput tx
output :)
          }
  -- NOTE: Not using 'hydrate' as we don't want to run the event source conduit.
  let headState :: HeadState tx
headState = IdleState tx -> HeadState tx
forall tx. IdleState tx -> HeadState tx
Idle IdleState{ChainStateType tx
chainState :: ChainStateType tx
$sel:chainState:IdleState :: ChainStateType tx
chainState}
  let chainStateHistory :: ChainStateHistory tx
chainStateHistory = ChainStateType tx -> ChainStateHistory tx
forall tx. ChainStateType tx -> ChainStateHistory tx
initHistory ChainStateType tx
chainState
  NodeState tx m
nodeState <- Maybe Word64 -> HeadState tx -> m (NodeState tx m)
forall (m :: * -> *) tx.
MonadLabelledSTM m =>
Maybe Word64 -> HeadState tx -> m (NodeState tx m)
createNodeState Maybe Word64
forall a. Maybe a
Nothing HeadState tx
headState
  InputQueue m (Input tx)
inputQueue <- m (InputQueue m (Input tx))
forall (m :: * -> *) e.
(MonadDelay m, MonadAsync m, MonadLabelledSTM m) =>
m (InputQueue m e)
createInputQueue
  HydraNode tx m
node <-
    SimulatedChainNetwork tx m
-> DraftHydraNode tx m -> m (HydraNode tx m)
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> DraftHydraNode tx m -> m (HydraNode tx m)
connectNode
      SimulatedChainNetwork tx m
chain
      DraftHydraNode
        { Tracer m (HydraNodeLog tx)
tracer :: Tracer m (HydraNodeLog tx)
$sel:tracer:DraftHydraNode :: Tracer m (HydraNodeLog tx)
tracer
        , Environment
env :: Environment
$sel:env:DraftHydraNode :: Environment
env
        , Ledger tx
ledger :: Ledger tx
$sel:ledger:DraftHydraNode :: Ledger tx
ledger
        , NodeState tx m
nodeState :: NodeState tx m
$sel:nodeState:DraftHydraNode :: NodeState tx m
nodeState
        , InputQueue m (Input tx)
inputQueue :: InputQueue m (Input tx)
$sel:inputQueue:DraftHydraNode :: InputQueue m (Input tx)
inputQueue
        , EventSource (StateEvent tx) m
eventSource :: EventSource (StateEvent tx) m
$sel:eventSource:DraftHydraNode :: EventSource (StateEvent tx) m
eventSource
        , $sel:eventSinks:DraftHydraNode :: [EventSink (StateEvent tx) m]
eventSinks = [EventSink (StateEvent tx) m
apiSink, EventSink (StateEvent tx) m
eventSink]
        , ChainStateHistory tx
chainStateHistory :: ChainStateHistory tx
$sel:chainStateHistory:DraftHydraNode :: ChainStateHistory tx
chainStateHistory
        }
  HydraNode tx m -> m (HydraNode tx m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HydraNode tx m -> m (HydraNode tx m))
-> HydraNode tx m -> m (HydraNode tx m)
forall a b. (a -> b) -> a -> b
$
    HydraNode tx m
node
      { server =
          Server
            { sendMessage = atomically . writeTQueue messages
            }
      }
 where
  env :: Environment
env =
    Environment
      { Party
party :: Party
$sel:party:Environment :: Party
party
      , SigningKey HydraKey
signingKey :: SigningKey HydraKey
$sel:signingKey:Environment :: SigningKey HydraKey
signingKey
      , [Party]
otherParties :: [Party]
$sel:otherParties:Environment :: [Party]
otherParties
      , $sel:contestationPeriod:Environment :: ContestationPeriod
contestationPeriod = ContestationPeriod
cp
      , [OnChainId]
participants :: [OnChainId]
$sel:participants:Environment :: [OnChainId]
participants
      , $sel:depositPeriod:Environment :: DepositPeriod
depositPeriod = DepositPeriod
dp
      }
  party :: Party
party = SigningKey HydraKey -> Party
deriveParty SigningKey HydraKey
signingKey

  -- NOTE: We use the hydra-keys as on-chain identities directly. This is fine
  -- as this is a simulated network.
  participants :: [OnChainId]
participants = Party -> OnChainId
deriveOnChainId (Party -> OnChainId) -> [Party] -> [OnChainId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Party
party Party -> [Party] -> [Party]
forall a. a -> [a] -> [a]
: [Party]
otherParties)

openHead ::
  SimulatedChainNetwork SimpleTx (IOSim s) ->
  TestHydraClient SimpleTx (IOSim s) ->
  IOSim s ()
openHead :: forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 = do
  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Init
  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> [Party] -> ServerOutput SimpleTx
forall tx. HeadId -> [Party] -> ServerOutput tx
HeadIsInitializing HeadId
testHeadId ([Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice])
  SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId -> Party -> UTxOType SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> Party -> UTxOType tx -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Party
alice (Integer -> UTxOType SimpleTx
utxoRef Integer
1)
  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsOpen{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:NetworkConnected :: UTxOType SimpleTx
utxo = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1]}

openHead2 ::
  SimulatedChainNetwork SimpleTx (IOSim s) ->
  TestHydraClient SimpleTx (IOSim s) ->
  TestHydraClient SimpleTx (IOSim s) ->
  IOSim s ()
openHead2 :: forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead2 SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2 = do
  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Init
  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> [Party] -> ServerOutput SimpleTx
forall tx. HeadId -> [Party] -> ServerOutput tx
HeadIsInitializing HeadId
testHeadId ([Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice, Item [Party]
Party
bob])
  SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId -> Party -> UTxOType SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> Party -> UTxOType tx -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Party
alice (Integer -> UTxOType SimpleTx
utxoRef Integer
1)
  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> Party -> UTxOType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> Party -> UTxOType tx -> ServerOutput tx
Committed HeadId
testHeadId Party
alice (Integer -> UTxOType SimpleTx
utxoRef Integer
1)
  SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId -> Party -> UTxOType SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> Party -> UTxOType tx -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId Party
bob (Integer -> UTxOType SimpleTx
utxoRef Integer
2)
  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> Party -> UTxOType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> Party -> UTxOType tx -> ServerOutput tx
Committed HeadId
testHeadId Party
bob (Integer -> UTxOType SimpleTx
utxoRef Integer
2)
  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsOpen{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:NetworkConnected :: UTxOType SimpleTx
utxo = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1, Integer
2]}

assertHeadIsClosed :: (HasCallStack, MonadThrow m) => ServerOutput tx -> m ()
assertHeadIsClosed :: forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m) =>
ServerOutput tx -> m ()
assertHeadIsClosed = \case
  HeadIsClosed{} -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  ServerOutput tx
_ -> String -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure String
"expected HeadIsClosed"

assertHeadIsClosedWith :: (HasCallStack, MonadThrow m) => SnapshotNumber -> ServerOutput tx -> m ()
assertHeadIsClosedWith :: forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m) =>
SnapshotNumber -> ServerOutput tx -> m ()
assertHeadIsClosedWith SnapshotNumber
expectedSnapshotNumber = \case
  HeadIsClosed{SnapshotNumber
$sel:snapshotNumber:NetworkConnected :: forall tx. ServerOutput tx -> SnapshotNumber
snapshotNumber :: SnapshotNumber
snapshotNumber} -> do
    SnapshotNumber
snapshotNumber SnapshotNumber -> SnapshotNumber -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m, Eq a, Show a) =>
a -> a -> m ()
`shouldBe` SnapshotNumber
expectedSnapshotNumber
  ServerOutput tx
_ -> String -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure String
"expected HeadIsClosed"

-- | Provide a quick and dirty to way to label stuff from a signing key
shortLabel :: SigningKey HydraKey -> String
shortLabel :: SigningKey HydraKey -> String
shortLabel SigningKey HydraKey
s =
  Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
8 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
List.words (SigningKey HydraKey -> String
forall b a. (Show a, IsString b) => a -> b
show SigningKey HydraKey
s) [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
2

-- | Get the head 'UTxO' from open 'HeadState'.
getHeadUTxO :: IsTx tx => HeadState tx -> Maybe (UTxOType tx)
getHeadUTxO :: forall tx. IsTx tx => HeadState tx -> Maybe (UTxOType tx)
getHeadUTxO = \case
  Open OpenState{$sel:coordinatedHeadState:OpenState :: forall tx. OpenState tx -> CoordinatedHeadState tx
coordinatedHeadState = CoordinatedHeadState{UTxOType tx
localUTxO :: UTxOType tx
$sel:localUTxO:CoordinatedHeadState :: forall tx. CoordinatedHeadState tx -> UTxOType tx
localUTxO}} -> UTxOType tx -> Maybe (UTxOType tx)
forall a. a -> Maybe a
Just UTxOType tx
localUTxO
  Initial InitialState{Committed tx
committed :: Committed tx
$sel:committed:InitialState :: forall tx. InitialState tx -> Committed tx
committed} -> UTxOType tx -> Maybe (UTxOType tx)
forall a. a -> Maybe a
Just (UTxOType tx -> Maybe (UTxOType tx))
-> UTxOType tx -> Maybe (UTxOType tx)
forall a b. (a -> b) -> a -> b
$ Committed tx -> UTxOType tx
forall m. Monoid m => Map Party m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Committed tx
committed
  HeadState tx
_ -> Maybe (UTxOType tx)
forall a. Maybe a
Nothing