{-# 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,
  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 (..))
import Hydra.API.ServerOutput (DecommitInvalidReason (..), ServerOutput (..))
import Hydra.Cardano.Api (ChainPoint (..), SigningKey, SlotNo (SlotNo), Tx)
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.Chain.Direct.State (ChainStateAt (..))
import Hydra.Events.FileBased (eventPairFromPersistenceIncremental)
import Hydra.HeadLogic (
  Effect (..),
  HeadState (..),
  Input (..),
  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, hydrate, queryHeadState, runHydraNode, waitDelay)
import Hydra.Node.InputQueue (InputQueue (enqueue))
import Hydra.NodeSpec (createPersistenceInMemory)
import Hydra.Tx.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod), toNominalDiffTime)
import Hydra.Tx.Crypto (HydraKey, aggregate, sign)
import Hydra.Tx.Environment (Environment (..))
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.Util (shouldBe, shouldNotBe, shouldRunInSim, 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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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)
-> (Party, UTxOType SimpleTx) -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m -> (Party, UTxOType tx) -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain (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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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)
-> (Party, UTxOType SimpleTx) -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m -> (Party, UTxOType tx) -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain (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:PeerConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:PeerConnected :: 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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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)
-> (Party, UTxOType SimpleTx) -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m -> (Party, UTxOType tx) -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain (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:PeerConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:PeerConnected :: 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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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)
-> (Party, UTxOType SimpleTx) -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m -> (Party, UTxOType tx) -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain (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:PeerConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:PeerConnected :: 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:PeerConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:PeerConnected :: UTxOType SimpleTx
utxo = Integer -> UTxOType SimpleTx
utxoRef Integer
1}

  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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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)
-> (Party, UTxOType SimpleTx) -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m -> (Party, UTxOType tx) -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain (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:PeerConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:PeerConnected :: UTxOType SimpleTx
utxo = Integer -> UTxOType SimpleTx
utxoRef Integer
1})

              SimulatedChainNetwork SimpleTx (IOSim s)
-> (Party, UTxOType SimpleTx) -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m -> (Party, UTxOType tx) -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain (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:PeerConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:PeerConnected :: 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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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)
-> (Party, UTxOType SimpleTx) -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m -> (Party, UTxOType tx) -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain (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:PeerConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:PeerConnected :: 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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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)
-> (Party, UTxOType SimpleTx) -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m -> (Party, UTxOType tx) -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain (Party
alice, Integer -> UTxOType SimpleTx
utxoRef Integer
1)
              SimulatedChainNetwork SimpleTx (IOSim s)
-> (Party, UTxOType SimpleTx) -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m -> (Party, UTxOType tx) -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain (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:PeerConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:PeerConnected :: 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

              TestHydraClient SimpleTx (IOSim s)
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall (m :: * -> *) tx a.
MonadThrow m =>
TestHydraClient tx m -> (ServerOutput tx -> Maybe a) -> m a
waitMatch TestHydraClient SimpleTx (IOSim s)
n1 ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                CommandFailed{} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
True
                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
"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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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 (m :: * -> *) tx a.
MonadThrow m =>
TestHydraClient tx m -> (ServerOutput tx -> Maybe a) -> m a
waitMatch 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:PeerConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, [Party]
parties :: [Party]
$sel:parties:PeerConnected :: 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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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)
-> (Party, UTxOType SimpleTx) -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m -> (Party, UTxOType tx) -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain (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)
              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
GetUTxO

              [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 -> UTxOType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> UTxOType tx -> ServerOutput tx
GetUTxOResponse HeadId
testHeadId ([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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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 ()
openHead 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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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 ()
openHead 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 -> SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> tx -> ServerOutput tx
TxValid HeadId
testHeadId (Integer -> SimpleTx
aValidTx Integer
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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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 ()
openHead 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 (SimpleTx -> ClientInput SimpleTx)
-> SimpleTx -> ClientInput SimpleTx
forall a b. (a -> b) -> a -> b
$ 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 -> SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> tx -> ServerOutput tx
TxValid HeadId
testHeadId (Integer -> SimpleTx
aValidTx Integer
42)

                let snapshot :: Snapshot SimpleTx
snapshot = HeadId
-> SnapshotVersion
-> SnapshotNumber
-> [TxIdType SimpleTx]
-> UTxOType SimpleTx
-> Maybe (UTxOType SimpleTx)
-> Snapshot SimpleTx
forall tx.
HeadId
-> SnapshotVersion
-> SnapshotNumber
-> [TxIdType tx]
-> UTxOType tx
-> Maybe (UTxOType tx)
-> Snapshot tx
Snapshot HeadId
testHeadId SnapshotVersion
0 SnapshotNumber
1 [TxIdType SimpleTx
42] ([Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1, Integer
2, Integer
42]) 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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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 ()
openHead 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 -> Bool) -> IOSim s ()
forall tx (m :: * -> *).
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Bool) -> m ()
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Bool) -> IOSim s ())
-> (ServerOutput SimpleTx -> Bool) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                  SnapshotConfirmed{$sel:snapshot:PeerConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{SnapshotNumber
number :: SnapshotNumber
$sel:number:Snapshot :: forall tx. Snapshot tx -> SnapshotNumber
number, [TxIdType SimpleTx]
confirmed :: [TxIdType SimpleTx]
$sel:confirmed:Snapshot :: forall tx. Snapshot tx -> [TxIdType tx]
confirmed}} ->
                    SnapshotNumber
number SnapshotNumber -> SnapshotNumber -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotNumber
1 Bool -> Bool -> Bool
&& [Integer]
[TxIdType SimpleTx]
confirmed [Integer] -> [Integer] -> Bool
forall a. Eq a => a -> a -> Bool
== [Integer
40]
                  ServerOutput SimpleTx
_ -> Bool
False

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

                -- 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 -> Bool) -> IOSim s ()
forall tx (m :: * -> *).
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Bool) -> m ()
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Bool) -> IOSim s ())
-> (ServerOutput SimpleTx -> Bool) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                  SnapshotConfirmed{$sel:snapshot:PeerConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{SnapshotNumber
$sel:number:Snapshot :: forall tx. Snapshot tx -> SnapshotNumber
number :: SnapshotNumber
number, [TxIdType SimpleTx]
$sel:confirmed:Snapshot :: forall tx. Snapshot tx -> [TxIdType tx]
confirmed :: [TxIdType SimpleTx]
confirmed}} ->
                    SnapshotNumber
number SnapshotNumber -> SnapshotNumber -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotNumber
3 Bool -> Bool -> Bool
&& [Integer]
[TxIdType SimpleTx]
confirmed [Integer] -> [Integer] -> Bool
forall a. Eq a => a -> a -> Bool
== [Integer
44]
                  ServerOutput SimpleTx
_ -> Bool
False

      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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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 ()
openHead 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 -> SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> tx -> ServerOutput tx
TxValid HeadId
testHeadId 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
$ do
                  let snapshot :: Snapshot SimpleTx
snapshot = SnapshotNumber
-> SnapshotVersion
-> [TxIdType SimpleTx]
-> UTxOType SimpleTx
-> Snapshot SimpleTx
forall tx.
Monoid (UTxOType tx) =>
SnapshotNumber
-> SnapshotVersion -> [TxIdType tx] -> UTxOType tx -> Snapshot tx
testSnapshot SnapshotNumber
1 SnapshotVersion
0 [TxIdType SimpleTx
1] ([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 -> SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> tx -> ServerOutput tx
TxValid HeadId
testHeadId SimpleTx
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
$ do
                  let snapshot :: Snapshot SimpleTx
snapshot = SnapshotNumber
-> SnapshotVersion
-> [TxIdType SimpleTx]
-> UTxOType SimpleTx
-> Snapshot SimpleTx
forall tx.
Monoid (UTxOType tx) =>
SnapshotNumber
-> SnapshotVersion -> [TxIdType tx] -> UTxOType tx -> Snapshot tx
testSnapshot SnapshotNumber
2 SnapshotVersion
0 [TxIdType SimpleTx
2] ([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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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 ()
openHead 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
1 (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
$ Natural -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
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 -> Bool) -> IOSim s ()
forall tx (m :: * -> *).
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Bool) -> m ()
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Bool) -> IOSim s ())
-> (ServerOutput SimpleTx -> Bool) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                  TxInvalid{SimpleTx
transaction :: SimpleTx
$sel:transaction:PeerConnected :: forall tx. ServerOutput tx -> tx
transaction} -> SimpleTx
transaction SimpleTx -> SimpleTx -> Bool
forall a. Eq a => a -> a -> Bool
== SimpleTx
secondTx
                  ServerOutput SimpleTx
_ -> Bool
False

                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 -> SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> tx -> ServerOutput tx
TxValid HeadId
testHeadId SimpleTx
firstTx

      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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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 ()
openHead 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
-> [TxIdType SimpleTx]
-> UTxOType SimpleTx
-> Snapshot SimpleTx
forall tx.
Monoid (UTxOType tx) =>
SnapshotNumber
-> SnapshotVersion -> [TxIdType tx] -> UTxOType tx -> Snapshot tx
testSnapshot SnapshotNumber
1 SnapshotVersion
0 [TxIdType SimpleTx
1] ([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 -> Bool) -> IOSim s ()
forall tx (m :: * -> *).
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Bool) -> m ()
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Bool) -> IOSim s ())
-> (ServerOutput SimpleTx -> Bool) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                  TxInvalid{SimpleTx
$sel:transaction:PeerConnected :: forall tx. ServerOutput tx -> tx
transaction :: SimpleTx
transaction} -> SimpleTx
transaction SimpleTx -> SimpleTx -> Bool
forall a. Eq a => a -> a -> Bool
== SimpleTx
tx''
                  ServerOutput SimpleTx
_ -> Bool
False

      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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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 ()
openHead 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
-> [TxIdType SimpleTx]
-> UTxOType SimpleTx
-> Snapshot SimpleTx
forall tx.
Monoid (UTxOType tx) =>
SnapshotNumber
-> SnapshotVersion -> [TxIdType tx] -> UTxOType tx -> Snapshot tx
testSnapshot SnapshotNumber
1 SnapshotVersion
0 [TxIdType SimpleTx
42] ([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

                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
GetUTxO

                [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 -> UTxOType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> UTxOType tx -> ServerOutput tx
GetUTxOResponse HeadId
testHeadId ([Integer] -> UTxOType SimpleTx
utxoRefs [Integer
2, Integer
42])

      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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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 ()
openHead 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:PeerConnected :: HeadId
headId = HeadId
testHeadId, SimpleTx
decommitTx :: SimpleTx
$sel:decommitTx:PeerConnected :: SimpleTx
decommitTx, $sel:utxoToDecommit:PeerConnected :: 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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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 ()
openHead 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:PeerConnected :: HeadId
headId = HeadId
testHeadId, SimpleTx
$sel:decommitTx:PeerConnected :: SimpleTx
decommitTx :: SimpleTx
decommitTx, $sel:utxoToDecommit:PeerConnected :: UTxOType SimpleTx
utxoToDecommit = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
42]}

                [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Bool) -> IOSim s ()
forall tx (m :: * -> *).
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Bool) -> m ()
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1] ((ServerOutput SimpleTx -> Bool) -> IOSim s ())
-> (ServerOutput SimpleTx -> Bool) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                  \case
                    SnapshotConfirmed{$sel:snapshot:PeerConnected :: 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}} ->
                      Bool
-> (Set SimpleTxOut -> Bool) -> Maybe (Set SimpleTxOut) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Key (Set SimpleTxOut)
42 `member`) Maybe (Set SimpleTxOut)
Maybe (UTxOType SimpleTx)
utxoToDecommit
                    ServerOutput SimpleTx
_ -> Bool
False

                [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 -> UTxOType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> TxIdType tx -> UTxOType tx -> ServerOutput tx
DecommitApproved HeadId
testHeadId (SimpleTx -> TxIdType SimpleTx
forall tx. IsTx tx => tx -> TxIdType tx
txId SimpleTx
decommitTx) ([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
$ HeadId -> TxIdType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> TxIdType tx -> ServerOutput tx
DecommitFinalized HeadId
testHeadId (SimpleTx -> TxIdType SimpleTx
forall tx. IsTx tx => tx -> TxIdType tx
txId 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
GetUTxO
                [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Bool) -> IOSim s ()
forall tx (m :: * -> *).
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Bool) -> m ()
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1] ((ServerOutput SimpleTx -> Bool) -> IOSim s ())
-> (ServerOutput SimpleTx -> Bool) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                  \case
                    GetUTxOResponse{HeadId
$sel:headId:PeerConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, UTxOType SimpleTx
$sel:utxo:PeerConnected :: forall tx. ServerOutput tx -> UTxOType tx
utxo :: UTxOType SimpleTx
utxo} -> HeadId
headId HeadId -> HeadId -> Bool
forall a. Eq a => a -> a -> Bool
== HeadId
testHeadId Bool -> Bool -> Bool
&& Bool -> Bool
not (Key (Set SimpleTxOut) -> Set SimpleTxOut -> Bool
forall t. StaticMap t => Key t -> t -> Bool
member Key (Set SimpleTxOut)
42 Set SimpleTxOut
UTxOType SimpleTx
utxo)
                    ServerOutput SimpleTx
_ -> Bool
False

      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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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 ()
openHead 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:PeerConnected :: HeadId
headId = HeadId
testHeadId, $sel:decommitTx:PeerConnected :: SimpleTx
decommitTx = SimpleTx
decommitTx1, $sel:utxoToDecommit:PeerConnected :: 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:PeerConnected :: HeadId
headId = HeadId
testHeadId
                    , $sel:decommitTx:PeerConnected :: SimpleTx
decommitTx = SimpleTx
decommitTx2
                    , $sel:decommitInvalidReason:PeerConnected :: 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:PeerConnected :: HeadId
headId = HeadId
testHeadId, $sel:decommitTxId:PeerConnected :: TxIdType SimpleTx
decommitTxId = SimpleTx -> TxIdType SimpleTx
forall tx. IsTx tx => tx -> TxIdType tx
txId SimpleTx
decommitTx1}

                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:PeerConnected :: HeadId
headId = HeadId
testHeadId, $sel:decommitTxId:PeerConnected :: TxIdType SimpleTx
decommitTxId = SimpleTx -> TxIdType SimpleTx
forall tx. IsTx tx => tx -> TxIdType tx
txId SimpleTx
decommitTx2, $sel:utxoToDecommit:PeerConnected :: 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:PeerConnected :: HeadId
headId = HeadId
testHeadId, $sel:decommitTxId:PeerConnected :: TxIdType SimpleTx
decommitTxId = SimpleTx -> TxIdType SimpleTx
forall tx. IsTx tx => tx -> TxIdType tx
txId SimpleTx
decommitTx2}

      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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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 ()
openHead 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:PeerConnected :: HeadId
headId = HeadId
testHeadId, SimpleTx
$sel:decommitTx:PeerConnected :: SimpleTx
decommitTx :: SimpleTx
decommitTx, $sel:utxoToDecommit:PeerConnected :: 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:PeerConnected :: HeadId
headId = HeadId
testHeadId, $sel:decommitTxId:PeerConnected :: TxIdType SimpleTx
decommitTxId = Integer
TxIdType SimpleTx
1, $sel:utxoToDecommit:PeerConnected :: 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 -> Bool) -> IOSim s ()
forall tx (m :: * -> *).
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Bool) -> m ()
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Bool) -> IOSim s ())
-> (ServerOutput SimpleTx -> Bool) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                  SnapshotConfirmed{$sel:snapshot:PeerConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{[TxIdType SimpleTx]
$sel:confirmed:Snapshot :: forall tx. Snapshot tx -> [TxIdType tx]
confirmed :: [TxIdType SimpleTx]
confirmed}} -> Integer
2 Integer -> [Integer] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Integer]
[TxIdType SimpleTx]
confirmed
                  ServerOutput SimpleTx
_ -> Bool
False

                [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:PeerConnected :: HeadId
headId = HeadId
testHeadId, $sel:decommitTxId:PeerConnected :: TxIdType SimpleTx
decommitTxId = Integer
TxIdType SimpleTx
1}

    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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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 ()
openHead 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
              [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:PeerConnected :: 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 -> Maybe ()) -> IOSim s ()
forall (m :: * -> *) tx a.
MonadThrow m =>
TestHydraClient tx m -> (ServerOutput tx -> Maybe a) -> m a
waitMatch TestHydraClient SimpleTx (IOSim s)
n2 ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                HeadIsContested{HeadId
$sel:headId:PeerConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, SnapshotNumber
snapshotNumber :: SnapshotNumber
$sel:snapshotNumber:PeerConnected :: 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
$ HeadId
headId HeadId -> HeadId -> Bool
forall a. Eq a => a -> a -> Bool
== HeadId
testHeadId Bool -> Bool -> Bool
&& 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
$ HeadIsFinalized{$sel:headId:PeerConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:PeerConnected :: 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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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 ()
openHead 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:PeerConnected :: HeadId
headId = HeadId
testHeadId
                  , $sel:decommitTxId:PeerConnected :: TxIdType SimpleTx
decommitTxId = SimpleTx -> TxIdType SimpleTx
forall tx. IsTx tx => tx -> TxIdType tx
txId SimpleTx
decommitTx
                  , $sel:utxoToDecommit:PeerConnected :: 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:PeerConnected :: 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:PeerConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:PeerConnected :: 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 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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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 ()
openHead 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:PeerConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:PeerConnected :: 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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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 ()
openHead 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 -> Bool) -> IOSim s ()
forall tx (m :: * -> *).
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Bool) -> m ()
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Bool) -> IOSim s ())
-> (ServerOutput SimpleTx -> Bool) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                SnapshotConfirmed{$sel:snapshot:PeerConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{SnapshotNumber
$sel:number:Snapshot :: forall tx. Snapshot tx -> SnapshotNumber
number :: SnapshotNumber
number}} -> SnapshotNumber
number SnapshotNumber -> SnapshotNumber -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotNumber
1
                ServerOutput SimpleTx
_ -> Bool
False

              -- 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 = Natural -> ChainSlot
ChainSlot Natural
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 = Natural -> ChainSlot
ChainSlot Natural
0}}

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

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

  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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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)
-> (Party, UTxOType SimpleTx) -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m -> (Party, UTxOType tx) -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain (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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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])

          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 -> Word32 -> Effect SimpleTx -> HydraNodeLog SimpleTx
forall tx.
Party -> Word64 -> Word32 -> Effect tx -> HydraNodeLog tx
BeginEffect Party
alice Word64
2 Word32
0 (ServerOutput SimpleTx -> Effect SimpleTx
forall tx. ServerOutput tx -> Effect tx
ClientEffect (ServerOutput SimpleTx -> Effect SimpleTx)
-> ServerOutput SimpleTx -> Effect SimpleTx
forall a b. (a -> b) -> a -> b
$ HeadId -> [Party] -> ServerOutput SimpleTx
forall tx. HeadId -> [Party] -> ServerOutput tx
HeadIsInitializing HeadId
testHeadId ([Party] -> ServerOutput SimpleTx)
-> [Party] -> ServerOutput SimpleTx
forall a b. (a -> b) -> a -> b
$ [Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice])]
      [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
2 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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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) -> Natural -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m -> Natural -> m ()
rollbackAndForward SimulatedChainNetwork SimpleTx (IOSim s)
chain Natural
1
            -- We expect the node to still work and let us commit
            SimulatedChainNetwork SimpleTx (IOSim s)
-> (Party, UTxOType SimpleTx) -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m -> (Party, UTxOType tx) -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain (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 :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
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)
-> (Party, UTxOType SimpleTx) -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m -> (Party, UTxOType tx) -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain (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:PeerConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:PeerConnected :: 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) -> Natural -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m -> Natural -> m ()
rollbackAndForward SimulatedChainNetwork SimpleTx (IOSim s)
chain Natural
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 -> SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> tx -> ServerOutput tx
TxValid HeadId
testHeadId (Integer -> SimpleTx
aValidTx Integer
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 -> Bool) -> m ()
forall tx (m :: * -> *).
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Bool) -> m ()
waitUntilMatch [TestHydraClient tx m]
nodes (ServerOutput tx -> ServerOutput tx -> Bool
forall a. Eq a => a -> a -> Bool
== ServerOutput tx
expected)

-- | Wait for some output to match some predicate /eventually/. 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) =>
  [TestHydraClient tx m] ->
  (ServerOutput tx -> Bool) ->
  m ()
waitUntilMatch :: forall tx (m :: * -> *).
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Bool) -> m ()
waitUntilMatch [TestHydraClient tx m]
nodes ServerOutput tx -> Bool
predicate = do
  TVar m [ServerOutput tx]
seenMsgs <- [ServerOutput tx] -> m (TVar m [ServerOutput tx])
forall a. a -> m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO []
  DiffTime -> m () -> m (Maybe ())
forall a. DiffTime -> m a -> m (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
oneMonth ([TestHydraClient tx m] -> (TestHydraClient tx m -> m ()) -> m ()
forall (f :: * -> *) (m :: * -> *) a b.
(Foldable f, MonadAsync m) =>
f a -> (a -> m b) -> m ()
forConcurrently_ [TestHydraClient tx m]
nodes ((TestHydraClient tx m -> m ()) -> m ())
-> (TestHydraClient tx m -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ TVar m [ServerOutput tx] -> TestHydraClient tx m -> m ()
match TVar m [ServerOutput tx]
seenMsgs) m (Maybe ()) -> (Maybe () -> 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
>>= \case
    Just ()
x -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
x
    Maybe ()
Nothing -> do
      [ServerOutput tx]
msgs <- 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]
seenMsgs
      String -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure (String -> m ()) -> String -> m ()
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 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 (ServerOutput tx -> Text
forall b a. (Show a, IsString b) => a -> b
show (ServerOutput tx -> Text) -> [ServerOutput tx] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ServerOutput tx]
msgs)
            ]
 where
  match :: TVar m [ServerOutput tx] -> TestHydraClient tx m -> m ()
match TVar m [ServerOutput tx]
seenMsgs TestHydraClient tx m
n = do
    ServerOutput tx
msg <- TestHydraClient tx m -> m (ServerOutput tx)
forall tx (m :: * -> *).
TestHydraClient tx m -> m (ServerOutput tx)
waitForNext TestHydraClient tx m
n
    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 [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]
seenMsgs (ServerOutput tx
msg :))
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ServerOutput tx -> Bool
predicate ServerOutput tx
msg) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      TVar m [ServerOutput tx] -> TestHydraClient tx m -> m ()
match TVar m [ServerOutput tx]
seenMsgs 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

-- | Wait for an output matching the predicate and extracting some value. This
-- will loop forever until a match has been found.
waitMatch ::
  MonadThrow m =>
  TestHydraClient tx m ->
  (ServerOutput tx -> Maybe a) ->
  m a
waitMatch :: forall (m :: * -> *) tx a.
MonadThrow m =>
TestHydraClient tx m -> (ServerOutput tx -> Maybe a) -> m a
waitMatch TestHydraClient tx m
node ServerOutput tx -> Maybe a
predicate =
  m a
go
 where
  go :: m a
go = do
    ServerOutput tx
next <- TestHydraClient tx m -> m (ServerOutput tx)
forall tx (m :: * -> *).
TestHydraClient tx m -> m (ServerOutput tx)
waitForNext TestHydraClient tx m
node
    m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m a
go a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerOutput tx -> Maybe a
predicate ServerOutput tx
next)

-- 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 -> 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 -> Natural -> m ()
rollbackAndForward :: Natural -> m ()
  , forall tx (m :: * -> *).
SimulatedChainNetwork tx m -> (Party, UTxOType tx) -> m ()
simulateCommit :: (Party, UTxOType tx) -> m ()
  , 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 = \DraftHydraNode tx m
_ -> Text -> 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 :: Natural -> m ()
rollbackAndForward = \Natural
_ -> Text -> m ()
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"rollbackAndForward"
    , $sel:simulateCommit:SimulatedChainNetwork :: (Party, UTxOType tx) -> m ()
simulateCommit = \(Party, UTxOType tx)
_ -> Text -> m ()
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"simulateCommit"
    , $sel:closeWithInitialSnapshot:SimulatedChainNetwork :: (Party, UTxOType tx) -> m ()
closeWithInitialSnapshot = \(Party
_, UTxOType tx
_) -> Text -> 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) =>
  (SimulatedChainNetwork SimpleTx m -> m ()) ->
  m ()
withSimulatedChainAndNetwork :: forall (m :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m) =>
(SimulatedChainNetwork SimpleTx m -> m ()) -> m ()
withSimulatedChainAndNetwork SimulatedChainNetwork SimpleTx m -> m ()
action = do
  SimulatedChainNetwork SimpleTx m
chain <- ChainStateType SimpleTx -> m (SimulatedChainNetwork SimpleTx m)
forall (m :: * -> *) tx.
(MonadTime m, MonadDelay m, MonadAsync m, IsChainStateTest tx) =>
ChainStateType tx -> m (SimulatedChainNetwork tx m)
simulatedChainAndNetwork SimpleChainState{$sel:slot:SimpleChainState :: ChainSlot
slot = Natural -> ChainSlot
ChainSlot Natural
0}
  SimulatedChainNetwork SimpleTx m -> m ()
action SimulatedChainNetwork SimpleTx m
chain
  Async m () -> m ()
forall a. Async m a -> m ()
forall (m :: * -> *) a. MonadAsync m => Async m a -> m ()
cancel (Async m () -> m ()) -> Async m () -> m ()
forall a b. (a -> b) -> a -> b
$ SimulatedChainNetwork SimpleTx m -> Async m ()
forall tx (m :: * -> *). SimulatedChainNetwork tx m -> Async m ()
tickThread SimulatedChainNetwork SimpleTx m
chain

-- | Class to manipulate the chain state by advancing it's slot in
-- 'simulatedChainAndNetwork'.
class IsChainState a => IsChainStateTest a where
  advanceSlot :: ChainStateType a -> ChainStateType a

instance IsChainStateTest SimpleTx where
  advanceSlot :: ChainStateType SimpleTx -> ChainStateType SimpleTx
advanceSlot SimpleChainState{ChainSlot
$sel:slot:SimpleChainState :: SimpleChainState -> ChainSlot
slot :: ChainSlot
slot} = SimpleChainState{$sel:slot:SimpleChainState :: ChainSlot
slot = ChainSlot -> ChainSlot
nextChainSlot ChainSlot
slot}

instance IsChainStateTest Tx where
  advanceSlot :: ChainStateType Tx -> ChainStateType Tx
advanceSlot cs :: ChainStateType Tx
cs@ChainStateAt{Maybe ChainPoint
recordedAt :: Maybe ChainPoint
$sel:recordedAt:ChainStateAt :: ChainStateAt -> Maybe ChainPoint
recordedAt} =
    let newChainPoint :: ChainPoint
newChainPoint = case Maybe ChainPoint
recordedAt of
          Just (ChainPoint (SlotNo Word64
slotNo) Hash BlockHeader
bh) ->
            SlotNo -> Hash BlockHeader -> ChainPoint
ChainPoint (Word64 -> SlotNo
SlotNo Word64
slotNo SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
+ SlotNo
1) Hash BlockHeader
bh
          Maybe ChainPoint
_NothingOrGenesis ->
            SlotNo -> Hash BlockHeader -> ChainPoint
ChainPoint (Word64 -> SlotNo
SlotNo Word64
1) (Text -> Hash BlockHeader
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"should not use block header hash in tests")
     in ChainStateType Tx
cs{recordedAt = Just newChainPoint}

-- | 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 tx.
  (MonadTime m, MonadDelay m, MonadAsync m, IsChainStateTest tx) =>
  ChainStateType tx ->
  m (SimulatedChainNetwork tx m)
simulatedChainAndNetwork :: forall (m :: * -> *) tx.
(MonadTime m, MonadDelay m, MonadAsync m, IsChainStateTest tx) =>
ChainStateType tx -> m (SimulatedChainNetwork tx m)
simulatedChainAndNetwork ChainStateType tx
initialChainState = do
  TVar m [ChainEvent tx]
history <- [ChainEvent tx] -> m (TVar m [ChainEvent tx])
forall a. a -> m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO []
  TVar m [HydraNode tx m]
nodes <- [HydraNode tx m] -> m (TVar m [HydraNode tx m])
forall a. a -> m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO []
  LocalChainState m tx
localChainState <- ChainStateHistory tx -> m (LocalChainState m tx)
forall (m :: * -> *) tx.
(MonadSTM m, IsChainState tx) =>
ChainStateHistory tx -> m (LocalChainState m tx)
newLocalChainState (ChainStateType tx -> ChainStateHistory tx
forall tx. ChainStateType tx -> ChainStateHistory tx
initHistory ChainStateType tx
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 tx m] -> LocalChainState m tx -> m ()
simulateTicks TVar m [HydraNode tx m]
nodes LocalChainState m tx
localChainState
  SimulatedChainNetwork tx m -> m (SimulatedChainNetwork tx m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimulatedChainNetwork tx m -> m (SimulatedChainNetwork tx m))
-> SimulatedChainNetwork tx m -> m (SimulatedChainNetwork tx m)
forall a b. (a -> b) -> a -> b
$
    SimulatedChainNetwork
      { $sel:connectNode:SimulatedChainNetwork :: DraftHydraNode tx m -> m (HydraNode tx m)
connectNode = \DraftHydraNode tx m
draftNode -> do
          let mockChain :: Chain tx m
mockChain =
                Chain
                  { $sel:postTx:Chain :: MonadThrow m => PostChainTx tx -> m ()
postTx = \PostChainTx tx
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 tx m]
-> TVar m [ChainEvent tx]
-> LocalChainState m tx
-> OnChainTx tx
-> m ()
forall {m :: * -> *} {tx} {t :: * -> *}.
(MonadSTM m, IsChainStateTest tx, Foldable t) =>
TVar m (t (HydraNode tx m))
-> TVar m [ChainEvent tx]
-> LocalChainState m tx
-> OnChainTx tx
-> m ()
createAndYieldEvent TVar m [HydraNode tx m]
nodes TVar m [ChainEvent tx]
history LocalChainState m tx
localChainState (OnChainTx tx -> m ()) -> OnChainTx tx -> m ()
forall a b. (a -> b) -> a -> b
$ UTCTime -> PostChainTx tx -> OnChainTx tx
forall tx. IsTx tx => UTCTime -> PostChainTx tx -> OnChainTx tx
toOnChainTx UTCTime
now PostChainTx tx
tx
                  , $sel:draftCommitTx:Chain :: MonadThrow m =>
HeadId -> CommitBlueprintTx tx -> m (Either (PostTxError tx) tx)
draftCommitTx = \HeadId
_ -> Text -> CommitBlueprintTx tx -> m (Either (PostTxError tx) tx)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"unexpected call to draftCommitTx"
                  , $sel:submitTx:Chain :: MonadThrow m => tx -> m ()
submitTx = \tx
_ -> Text -> m ()
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"unexpected call to submitTx"
                  }
              mockNetwork :: Network m (Message tx)
mockNetwork = DraftHydraNode tx m
-> TVar m [HydraNode tx m] -> Network m (Message tx)
forall (m :: * -> *) tx.
MonadSTM m =>
DraftHydraNode tx m
-> TVar m [HydraNode tx m] -> Network m (Message tx)
createMockNetwork DraftHydraNode tx m
draftNode TVar m [HydraNode tx m]
nodes
              mockServer :: Server tx m
mockServer = Server{$sel:sendOutput:Server :: ServerOutput tx -> m ()
sendOutput = m () -> ServerOutput tx -> m ()
forall a b. a -> b -> a
const (m () -> ServerOutput tx -> m ())
-> m () -> ServerOutput 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 tx m
node <- Chain tx m
-> Network m (Message tx)
-> Server tx m
-> DraftHydraNode tx m
-> m (HydraNode tx 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 tx m
mockChain Network m (Message tx)
mockNetwork Server tx m
forall {tx}. Server tx m
mockServer DraftHydraNode tx 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 tx m]
-> ([HydraNode tx m] -> [HydraNode tx 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 tx m]
nodes (HydraNode tx m
node :)
          HydraNode tx m -> m (HydraNode tx m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HydraNode tx m
node
      , Async m ()
$sel:tickThread:SimulatedChainNetwork :: Async m ()
tickThread :: Async m ()
tickThread
      , $sel:rollbackAndForward:SimulatedChainNetwork :: Natural -> m ()
rollbackAndForward = TVar m [HydraNode tx m]
-> TVar m [ChainEvent tx]
-> LocalChainState m tx
-> Natural
-> 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 tx m]
nodes TVar m [ChainEvent tx]
history LocalChainState m tx
localChainState
      , $sel:simulateCommit:SimulatedChainNetwork :: (Party, UTxOType tx) -> m ()
simulateCommit = \(Party
party, UTxOType tx
committed) ->
          TVar m [HydraNode tx m]
-> TVar m [ChainEvent tx]
-> LocalChainState m tx
-> OnChainTx tx
-> m ()
forall {m :: * -> *} {tx} {t :: * -> *}.
(MonadSTM m, IsChainStateTest tx, Foldable t) =>
TVar m (t (HydraNode tx m))
-> TVar m [ChainEvent tx]
-> LocalChainState m tx
-> OnChainTx tx
-> m ()
createAndYieldEvent TVar m [HydraNode tx m]
nodes TVar m [ChainEvent tx]
history LocalChainState m tx
localChainState (OnChainTx tx -> m ()) -> OnChainTx tx -> m ()
forall a b. (a -> b) -> a -> b
$ OnCommitTx{$sel:headId:OnInitTx :: HeadId
headId = HeadId
testHeadId, Party
party :: Party
$sel:party:OnInitTx :: Party
party, UTxOType tx
committed :: UTxOType tx
$sel:committed:OnInitTx :: UTxOType tx
committed}
      , $sel:closeWithInitialSnapshot:SimulatedChainNetwork :: (Party, UTxOType tx) -> m ()
closeWithInitialSnapshot = Text -> (Party, UTxOType tx) -> 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 tx m] -> LocalChainState m tx -> m ()
simulateTicks TVar m [HydraNode tx m]
nodes LocalChainState m tx
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 tx
event <- STM m (ChainEvent tx) -> m (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) -> m (ChainEvent tx))
-> STM m (ChainEvent tx) -> m (ChainEvent tx)
forall a b. (a -> b) -> a -> b
$ do
      ChainStateType tx
cs <- LocalChainState m tx -> STM m (ChainStateType tx)
forall (m :: * -> *) tx.
LocalChainState m tx -> STM m (ChainStateType tx)
getLatest LocalChainState m tx
localChainState
      let chainSlot :: ChainSlot
chainSlot = ChainStateType tx -> ChainSlot
forall tx. IsChainState tx => ChainStateType tx -> ChainSlot
chainStateSlot ChainStateType tx
cs
      ChainEvent tx -> STM m (ChainEvent tx)
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChainEvent tx -> STM m (ChainEvent tx))
-> ChainEvent tx -> STM m (ChainEvent tx)
forall a b. (a -> b) -> a -> b
$ UTCTime -> ChainSlot -> ChainEvent tx
forall tx. UTCTime -> ChainSlot -> ChainEvent tx
Tick UTCTime
now ChainSlot
chainSlot
    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 m [HydraNode tx m] -> ([HydraNode tx 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 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 -> ChainEvent tx -> m ()
forall tx (m :: * -> *). HydraNode tx m -> ChainEvent tx -> m ()
`handleChainEvent` ChainEvent tx
event)

  createAndYieldEvent :: TVar m (t (HydraNode tx m))
-> TVar m [ChainEvent tx]
-> LocalChainState m tx
-> OnChainTx tx
-> m ()
createAndYieldEvent TVar m (t (HydraNode tx m))
nodes TVar m [ChainEvent tx]
history LocalChainState m tx
localChainState OnChainTx tx
tx = do
    ChainEvent tx
chainEvent <- STM m (ChainEvent tx) -> m (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) -> m (ChainEvent tx))
-> STM m (ChainEvent tx) -> m (ChainEvent tx)
forall a b. (a -> b) -> a -> b
$ do
      ChainStateType tx
cs <- LocalChainState m tx -> STM m (ChainStateType tx)
forall (m :: * -> *) tx.
LocalChainState m tx -> STM m (ChainStateType tx)
getLatest LocalChainState m tx
localChainState
      let cs' :: ChainStateType tx
cs' = ChainStateType tx -> ChainStateType tx
forall a.
IsChainStateTest a =>
ChainStateType a -> ChainStateType a
advanceSlot ChainStateType tx
cs
      LocalChainState m tx -> ChainStateType tx -> STM m ()
forall (m :: * -> *) tx.
LocalChainState m tx -> ChainStateType tx -> STM m ()
pushNew LocalChainState m tx
localChainState ChainStateType tx
cs'
      ChainEvent tx -> STM m (ChainEvent tx)
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChainEvent tx -> STM m (ChainEvent tx))
-> ChainEvent tx -> STM m (ChainEvent tx)
forall a b. (a -> b) -> a -> b
$
        Observation
          { $sel:observedTx:Observation :: OnChainTx tx
observedTx = OnChainTx tx
tx
          , $sel:newChainState:Observation :: ChainStateType tx
newChainState = ChainStateType tx
cs'
          }
    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
chainEvent

  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
. Natural -> NetworkEvent (Message tx) -> Input tx
forall tx. Natural -> NetworkEvent (Message tx) -> Input tx
NetworkInput Natural
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}
  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:distributedOutputs:OnInitTx :: [TxOutType tx]
distributedOutputs = [TxOutType tx]
-> (UTxOType tx -> [TxOutType tx])
-> Maybe (UTxOType tx)
-> [TxOutType tx]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [TxOutType tx]
forall a. Monoid a => a
mempty UTxOType tx -> [TxOutType tx]
forall tx. IsTx tx => UTxOType tx -> [TxOutType tx]
outputsOfUTxO Maybe (UTxOType tx)
utxoToDecommit
      }
   where
    Snapshot{SnapshotVersion
version :: SnapshotVersion
$sel:version:Snapshot :: forall tx. Snapshot tx -> 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
toNominalDiffTime ContestationPeriod
testContestationPeriod) 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
toNominalDiffTime ContestationPeriod
testContestationPeriod) UTCTime
now
      }
  FanoutTx{} ->
    OnFanoutTx{$sel:headId:OnInitTx :: HeadId
headId = HeadId
testHeadId}

testContestationPeriod :: ContestationPeriod
testContestationPeriod :: ContestationPeriod
testContestationPeriod = Natural -> ContestationPeriod
UnsafeContestationPeriod Natural
10

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
  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
  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 = Natural -> ChainSlot
ChainSlot Natural
0}
  HydraNode SimpleTx (IOSim s)
node <- Tracer (IOSim s) (HydraNodeLog SimpleTx)
-> Ledger SimpleTx
-> ChainStateType SimpleTx
-> SigningKey HydraKey
-> [Party]
-> TQueue (IOSim s) (ServerOutput SimpleTx)
-> TVar (IOSim s) [ServerOutput SimpleTx]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> ContestationPeriod
-> IOSim s (HydraNode SimpleTx (IOSim s))
forall (m :: * -> *) tx.
(MonadDelay m, MonadAsync m, MonadLabelledSTM m, IsChainState tx,
 MonadThrow m) =>
Tracer m (HydraNodeLog tx)
-> Ledger tx
-> ChainStateType tx
-> SigningKey HydraKey
-> [Party]
-> TQueue m (ServerOutput tx)
-> TVar m [ServerOutput tx]
-> SimulatedChainNetwork tx m
-> ContestationPeriod
-> m (HydraNode tx m)
createHydraNode Tracer (IOSim s) (HydraNodeLog SimpleTx)
forall a s. Typeable a => Tracer (IOSim s) a
traceInIOSim Ledger SimpleTx
simpleLedger SimpleChainState
ChainStateType SimpleTx
initialChainState SigningKey HydraKey
signingKey [Party]
otherParties TQueue (IOSim s) (ServerOutput SimpleTx)
outputs TVar (IOSim s) [ServerOutput SimpleTx]
TVar s [ServerOutput SimpleTx]
outputHistory SimulatedChainNetwork SimpleTx (IOSim s)
chain ContestationPeriod
testContestationPeriod
  IOSim s () -> (Async (IOSim s) () -> IOSim s a) -> IOSim s a
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, IsChainState tx) =>
HydraNode tx m -> m ()
runHydraNode HydraNode SimpleTx (IOSim s)
node) ((Async (IOSim s) () -> IOSim s a) -> IOSim s a)
-> (Async (IOSim s) () -> IOSim s a) -> IOSim s a
forall a b. (a -> b) -> a -> b
$ \Async (IOSim s) ()
_ ->
    TestHydraClient SimpleTx (IOSim s) -> IOSim s a
action (TQueue (IOSim s) (ServerOutput SimpleTx)
-> TVar (IOSim s) [ServerOutput SimpleTx]
-> HydraNode SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
forall (m :: * -> *) tx.
MonadSTM m =>
TQueue m (ServerOutput tx)
-> TVar m [ServerOutput tx]
-> HydraNode tx m
-> TestHydraClient tx m
createTestHydraClient TQueue (IOSim s) (ServerOutput SimpleTx)
outputs TVar (IOSim s) [ServerOutput SimpleTx]
TVar s [ServerOutput SimpleTx]
outputHistory HydraNode SimpleTx (IOSim s)
node)

createTestHydraClient ::
  MonadSTM m =>
  TQueue m (ServerOutput tx) ->
  TVar m [ServerOutput tx] ->
  HydraNode tx m ->
  TestHydraClient tx m
createTestHydraClient :: forall (m :: * -> *) tx.
MonadSTM m =>
TQueue m (ServerOutput tx)
-> TVar m [ServerOutput tx]
-> HydraNode tx m
-> TestHydraClient tx m
createTestHydraClient TQueue m (ServerOutput tx)
outputs 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: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 ::
  (MonadDelay m, MonadAsync m, MonadLabelledSTM m, IsChainState tx, MonadThrow m) =>
  Tracer m (HydraNodeLog tx) ->
  Ledger tx ->
  ChainStateType tx ->
  SigningKey HydraKey ->
  [Party] ->
  TQueue m (ServerOutput tx) ->
  TVar m [ServerOutput tx] ->
  SimulatedChainNetwork tx m ->
  ContestationPeriod ->
  m (HydraNode tx m)
createHydraNode :: forall (m :: * -> *) tx.
(MonadDelay m, MonadAsync m, MonadLabelledSTM m, IsChainState tx,
 MonadThrow m) =>
Tracer m (HydraNodeLog tx)
-> Ledger tx
-> ChainStateType tx
-> SigningKey HydraKey
-> [Party]
-> TQueue m (ServerOutput tx)
-> TVar m [ServerOutput tx]
-> SimulatedChainNetwork tx m
-> ContestationPeriod
-> 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 TVar m [ServerOutput tx]
outputHistory SimulatedChainNetwork tx m
chain ContestationPeriod
cp = do
  PersistenceIncremental (PersistedStateChange tx) m
persistence <- m (PersistenceIncremental (PersistedStateChange tx) m)
forall (m :: * -> *) a.
MonadLabelledSTM m =>
m (PersistenceIncremental a m)
createPersistenceInMemory
  (EventSource (StateEvent tx) m
eventSource, EventSink (StateEvent tx) m
eventSink) <- PersistenceIncremental (PersistedStateChange tx) m
-> m (EventSource (StateEvent tx) m, EventSink (StateEvent tx) m)
forall tx (m :: * -> *).
(IsChainState tx, MonadSTM m) =>
PersistenceIncremental (PersistedStateChange tx) m
-> m (EventSource (StateEvent tx) m, EventSink (StateEvent tx) m)
eventPairFromPersistenceIncremental PersistenceIncremental (PersistedStateChange tx) m
persistence
  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 tx m -> m (HydraNode tx m))
-> m (DraftHydraNode tx m) -> m (HydraNode tx m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Tracer m (HydraNodeLog tx)
-> Environment
-> Ledger tx
-> ChainStateType tx
-> EventSource (StateEvent tx) m
-> [EventSink (StateEvent tx) m]
-> m (DraftHydraNode tx m)
forall (m :: * -> *) tx.
(MonadDelay m, MonadLabelledSTM m, MonadAsync m, MonadThrow m,
 IsChainState tx) =>
Tracer m (HydraNodeLog tx)
-> Environment
-> Ledger tx
-> ChainStateType tx
-> EventSource (StateEvent tx) m
-> [EventSink (StateEvent tx) m]
-> m (DraftHydraNode tx m)
hydrate Tracer m (HydraNodeLog tx)
tracer Environment
env Ledger tx
ledger ChainStateType tx
chainState EventSource (StateEvent tx) m
eventSource [EventSink (StateEvent tx) m
eventSink]
  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
            { sendOutput = \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 (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
out
                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
out :)
            }
      }
 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
      }
  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) ->
  TestHydraClient SimpleTx (IOSim s) ->
  IOSim s ()
openHead :: forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
-> IOSim s ()
openHead 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)
-> (Party, UTxOType SimpleTx) -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m -> (Party, UTxOType tx) -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain (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)
-> (Party, UTxOType SimpleTx) -> IOSim s ()
forall tx (m :: * -> *).
SimulatedChainNetwork tx m -> (Party, UTxOType tx) -> m ()
simulateCommit SimulatedChainNetwork SimpleTx (IOSim s)
chain (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:PeerConnected :: HeadId
headId = HeadId
testHeadId, $sel:utxo:PeerConnected :: UTxOType SimpleTx
utxo = [Integer] -> UTxOType SimpleTx
utxoRefs [Integer
1, Integer
2]}

matchFanout :: PostChainTx tx -> Bool
matchFanout :: forall tx. PostChainTx tx -> Bool
matchFanout = \case
  FanoutTx{} -> Bool
True
  PostChainTx tx
_ -> Bool
False

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:PeerConnected :: 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