{-# LANGUAGE DuplicateRecordFields #-}

module Hydra.BehaviorSpec where

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

import Control.Concurrent.Class.MonadSTM (
  modifyTVar,
  modifyTVar',
  newTVarIO,
  readTQueue,
  readTVarIO,
  retry,
  stateTVar,
  writeTQueue,
  writeTVar,
 )
import Control.Monad.Class.MonadAsync (async, cancel, forConcurrently)
import Control.Monad.IOSim (IOSim, runSimTrace, selectTraceEventsDynamic)
import Data.List.NonEmpty qualified as NE
import Hydra.API.ClientInput
import Hydra.API.Server (Server (..), mkTimedServerOutputFromStateEvent, updateSeenSnapshot)
import Hydra.API.ServerOutput (ClientMessage (..), DecommitInvalidReason (..), ServerOutput (..), TimedServerOutput (..))
import Hydra.Cardano.Api (SigningKey)
import Hydra.Chain (
  Chain (..),
  ChainEvent (..),
  OnChainTx (..),
  PostChainTx (..),
  initHistory,
 )
import Hydra.Chain.ChainState (ChainSlot (ChainSlot), ChainStateType, IsChainState, chainStatePoint, chainStateSlot)
import Hydra.Chain.Direct.Handlers (LocalChainState, getLatest, newLocalChainState, pushNew, rollback)
import Hydra.Events (mkEventSink)
import Hydra.Events.Rotation (EventStore (..))
import Hydra.HeadLogic (CoordinatedHeadState (..), Effect (..), HeadState (..), Input (..), OpenState (..))
import Hydra.HeadLogic.StateEvent (StateEvent (..))
import Hydra.HeadLogicSpec (testSnapshot)
import Hydra.Ledger (Ledger)
import Hydra.Ledger.Simple (SimpleChainState (..), SimpleTx (..), simpleLedger)
import Hydra.Logging (Tracer)
import Hydra.Network (Network (..))
import Hydra.Network.Message (Message (..))
import Hydra.Node (
  DraftHydraNode (..),
  HydraNode (..),
  HydraNodeLog (..),
  NodeStateHandler (..),
  connect,
  createNodeStateHandler,
  defaultTxTTL,
  mkNetworkInput,
  queryNodeState,
  runHydraNode,
  waitDelay,
 )
import Hydra.Node.Environment (Environment (..))
import Hydra.Node.InputQueue (InputQueue (enqueue), createInputQueue)
import Hydra.Node.State (NodeState (..), initNodeState)
import Hydra.Node.UnsyncedPeriod (defaultUnsyncedPeriodFor)
import Hydra.NodeSpec (createMockEventStore)
import Hydra.Options (defaultContestationPeriod, defaultDepositActivation, defaultDepositPeriod)
import Hydra.Tx (HeadId)
import Hydra.Tx.ContestationPeriod (ContestationPeriod)
import Hydra.Tx.ContestationPeriod qualified as CP
import Hydra.Tx.Crypto (HydraKey, aggregate, getVerificationKey, sign)
import Hydra.Tx.DepositPeriod (DepositPeriod (..))
import Hydra.Tx.DepositPeriod qualified as DP
import Hydra.Tx.IsTx (IsTx (..))
import Hydra.Tx.Party (Party (..), deriveParty)
import Hydra.Tx.Snapshot (ConfirmedSnapshot, Snapshot (..), SnapshotNumber, getSnapshot)
import Test.Hydra.Ledger (nextChainSlot)
import Test.Hydra.Ledger.Simple (aValidTx, utxoRef, utxoRefs)
import Test.Hydra.Tx.Fixture (
  alice,
  aliceSk,
  bob,
  bobSk,
  carol,
  carolSk,
  deriveOnChainId,
  testHeadId,
  testHeadSeed,
 )
import Test.QuickCheck (chooseEnum, counterexample, forAll, getNegative, ioProperty)
import Test.Util (
  shouldBe,
  shouldRunInSim,
  shouldSatisfy,
  traceInIOSim,
 )

spec :: Spec
spec :: Spec
spec = Spec -> Spec
forall a. SpecWith a -> SpecWith a
parallel (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
  [Char] -> Spec -> Spec
forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe [Char]
"Sanity tests of test suite" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"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
10 (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

  [Char] -> Spec -> Spec
forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe [Char]
"Single participant Head" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"accepts Init command" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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

    [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"can close an open head" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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,
 MonadLabelledSTM 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
HeadIsOpen HeadId
testHeadId ([Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice])
            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

    [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"does not fanout automatically" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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,
 MonadLabelledSTM 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
HeadIsOpen HeadId
testHeadId ([Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice])
            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,
 MonadLabelledSTM 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
100000

    [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"does finalize head after contestation period upon command" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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,
 MonadLabelledSTM 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
HeadIsOpen HeadId
testHeadId ([Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice])
            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,
 MonadLabelledSTM 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,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:finalizedUTxO:NetworkConnected :: UTxOType SimpleTx
finalizedUTxO = Set SimpleTxOut
UTxOType SimpleTx
forall a. Monoid a => a
mempty}

  -- XXX: Restructure test suites as it makes more sense to speak about
  -- features rather than head structure
  [Char] -> Spec -> Spec
forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe [Char]
"Two participant Head" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"ignores head initialization of other head" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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 ->
            Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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,
 MonadLabelledSTM 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
HeadIsOpen HeadId
testHeadId ([Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice])
              -- We expect bob to ignore alice's head which he is not part of
              -- although bob's configuration would includes alice as a
              -- peerconfigured)
              [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                IgnoredHeadInitializing{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, [Party]
parties :: [Party]
$sel:parties:NetworkConnected :: forall tx. ServerOutput tx -> [Party]
parties} ->
                  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ HeadId
headId HeadId -> HeadId -> Bool
forall a. Eq a => a -> a -> Bool
== HeadId
testHeadId Bool -> Bool -> Bool
&& [Party]
parties [Party] -> [Party] -> Bool
forall a. Eq a => a -> a -> Bool
== [Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice]
                ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

    [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"outputs committed utxo when client requests it" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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 ->
            Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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,
 MonadLabelledSTM 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
HeadIsOpen HeadId
testHeadId ([Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice, Item [Party]
Party
bob])

              UTCTime
deadline <- IOSim s UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
newDeadlineFarEnoughFromNow
              SimpleId
depositId <- SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId
-> UTxOType SimpleTx
-> UTCTime
-> IOSim s (TxIdType SimpleTx)
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> UTxOType tx -> UTCTime -> m (TxIdType tx)
simulateDeposit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId (SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
500) UTCTime
deadline
              [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                CommitFinalized{TxIdType SimpleTx
depositTxId :: TxIdType SimpleTx
$sel:depositTxId:NetworkConnected :: forall tx. ServerOutput tx -> TxIdType tx
depositTxId} | SimpleId
TxIdType SimpleTx
depositTxId SimpleId -> SimpleId -> Bool
forall a. Eq a => a -> a -> Bool
== SimpleId
depositId -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
                ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

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

    -- Reproduces the version-race using a slow network.
    -- DecommitFinalized arrives at ALL nodes BEFORE the ReqSn
    -- echo. When the stale ReqSn(ver=0) echo arrives, both
    -- nodes already have version=1 → ReqSvNumberInvalid → snapshot stuck.
    [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"snapshot does not get stuck on version race with slow network" (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
$
        DiffTime
-> DiffTime
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
DiffTime
-> DiffTime -> (SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndSlowNetwork DiffTime
25 DiffTime
0 ((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 ->
          Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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 ->
            Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
              UTCTime
deadline <- IOSim s UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
newDeadlineFarEnoughFromNow
              SimpleId
depositId <- SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId
-> UTxOType SimpleTx
-> UTCTime
-> IOSim s (TxIdType SimpleTx)
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> UTxOType tx -> UTCTime -> m (TxIdType tx)
simulateDeposit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId (SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
500) UTCTime
deadline
              [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                CommitFinalized{TxIdType SimpleTx
$sel:depositTxId:NetworkConnected :: forall tx. ServerOutput tx -> TxIdType tx
depositTxId :: TxIdType SimpleTx
depositTxId} | SimpleId
TxIdType SimpleTx
depositTxId SimpleId -> SimpleId -> Bool
forall a. Eq a => a -> a -> Bool
== SimpleId
depositId -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
                ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing
              -- Send a decommit and an L2 tx so there is pending work that
              -- triggers ReqSn(ver=0) immediately after the decommit snapshot
              -- confirms. With networkDelay=25s, DecommitFinalized arrives
              -- 5 seconds before the ReqSn echo — reproducing the race.
              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 (SimpleId -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx SimpleId
300 (SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
500) (SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
5000)))
              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 (SimpleId -> SimpleTx
aValidTx SimpleId
999))
              -- Wait for decommit snapshot to confirm
              [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{$sel:utxoToDecommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToDecommit = Just UTxOType SimpleTx
_}} -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
                ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

              TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx (SimpleId -> SimpleTx
aValidTx SimpleId
8888))
              -- The next snapshot must confirm with version=2 (deposit bumped
              -- 0→1, decommit bumps 1→2). Without the fix the head is
              -- permanently stuck: the stale ReqSn(ver=1) is rejected and
              -- the leader stays in RequestedSnapshot, blocking retries.
              [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{$sel:version:Snapshot :: forall tx. Snapshot tx -> SnapshotVersion
version = SnapshotVersion
2}} -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
                ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

    -- Reproduces the version-race for CommitFinalized using a slow network.
    -- After the deposit snapshot confirms (ver=0), maybeRequestNextSnapshot
    -- fires ReqSn(ver=0, sn=2) immediately for pending L2 txs. Then
    -- CommitFinalized bumps version to 1 before the echo returns (25s).
    -- The stale ReqSn(ver=0) is rejected with ReqSvNumberInvalid and nobody
    -- re-triggers ReqSn(ver=1) → head permanently stuck without the fix.
    [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"snapshot does not get stuck on CommitFinalized version race with slow network" (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
$
        DiffTime
-> DiffTime
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
DiffTime
-> DiffTime -> (SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndSlowNetwork DiffTime
25 DiffTime
0 ((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 ->
          -- Use a short depositPeriod (1s) so the deposit activates on the
          -- first chain tick (blockTime=20s), before tx 999 is snapshotted
          -- (ReqTx echo arrives at networkDelay=25s). This ensures tx 999 is
          -- still pending in localTxs when the deposit snapshot confirms.
          DepositPeriod
-> Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s b.
DepositPeriod
-> Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s b)
-> IOSim s b
withHydraNode' (NominalDiffTime -> DepositPeriod
DepositPeriod NominalDiffTime
1) Secret (SigningKey HydraKey)
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 ->
            DepositPeriod
-> Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s b.
DepositPeriod
-> Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s b)
-> IOSim s b
withHydraNode' (NominalDiffTime -> DepositPeriod
DepositPeriod NominalDiffTime
1) Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
              UTCTime
deadline <- IOSim s UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
newDeadlineFarEnoughFromNow
              -- Submit a deposit and a pending L2 tx so there is pending work
              -- when the deposit snapshot confirms (triggering immediate ReqSn).
              IOSim s SimpleId -> IOSim s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IOSim s SimpleId -> IOSim s ()) -> IOSim s SimpleId -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId
-> UTxOType SimpleTx
-> UTCTime
-> IOSim s (TxIdType SimpleTx)
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> UTxOType tx -> UTCTime -> m (TxIdType tx)
simulateDeposit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId (SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
500) UTCTime
deadline
              TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx (SimpleId -> SimpleTx
aValidTx SimpleId
999))
              -- Wait for the deposit snapshot to confirm (version still 0 at
              -- this point — CommitFinalized fires after posting to chain).
              [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{$sel:utxoToCommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToCommit = Just UTxOType SimpleTx
_}} -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
                ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing
              -- After the deposit snapshot confirms, the leader sends
              -- ReqSn(ver=0, sn=2) for tx 999. CommitFinalized then arrives
              -- and bumps version to 1. The stale ReqSn(ver=0) echo is
              -- rejected. Without the fix the head gets permanently stuck
              -- as nobody re-triggers ReqSn(ver=1).
              [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{$sel:version:Snapshot :: forall tx. Snapshot tx -> SnapshotVersion
version = SnapshotVersion
1}} -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
                ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

    [Char] -> Spec -> Spec
forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe [Char]
"in an open head" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"sees the head closed by other nodes" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
            Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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 ->
              Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 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

      [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"valid new transactions are seen by all parties" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
            Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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 ->
              Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 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 (SimpleId -> SimpleTx
aValidTx SimpleId
42))
                [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> TxIdType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> TxIdType tx -> ServerOutput tx
TxValid HeadId
testHeadId SimpleId
TxIdType SimpleTx
42

      [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"valid new transactions get snapshotted" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
            Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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 ->
              Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2

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

                let snapshot :: Snapshot SimpleTx
snapshot = SnapshotNumber
-> SnapshotVersion
-> [SimpleTx]
-> UTxOType SimpleTx
-> Snapshot SimpleTx
forall tx.
IsTx tx =>
SnapshotNumber
-> SnapshotVersion -> [tx] -> UTxOType tx -> Snapshot tx
testSnapshot SnapshotNumber
1 SnapshotVersion
0 [SimpleTx
tx] ([SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
42])
                    sigs :: MultiSignature (Snapshot SimpleTx)
sigs = [Signature (Snapshot SimpleTx)]
-> MultiSignature (Snapshot SimpleTx)
forall a. [Signature a] -> MultiSignature a
aggregate [Secret (SigningKey HydraKey)
-> Snapshot SimpleTx -> Signature (Snapshot SimpleTx)
forall a.
SignableRepresentation a =>
Secret (SigningKey HydraKey) -> a -> Signature a
sign Secret (SigningKey HydraKey)
aliceSk Snapshot SimpleTx
snapshot, Secret (SigningKey HydraKey)
-> Snapshot SimpleTx -> Signature (Snapshot SimpleTx)
forall a.
SignableRepresentation a =>
Secret (SigningKey HydraKey) -> a -> Signature a
sign Secret (SigningKey HydraKey)
bobSk Snapshot SimpleTx
snapshot]
                [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 MonadLabelledSTM 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

      [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"snapshots are created as long as transactions to snapshot exist" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
          (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
            Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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 ->
              Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 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
$ SimpleId -> SimpleTx
aValidTx SimpleId
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
$ SimpleId -> SimpleTx
aValidTx SimpleId
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
$ SimpleId -> SimpleTx
aValidTx SimpleId
42)

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

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

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

      [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"depending transactions stay pending and are confirmed in order" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
          (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
            Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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
              Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                SimulatedChainNetwork SimpleTx (IOSim s)
-> [TestHydraClient SimpleTx (IOSim s)]
-> UTxOType SimpleTx
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> [TestHydraClient SimpleTx (IOSim s)]
-> UTxOType SimpleTx
-> IOSim s ()
depositHead SimulatedChainNetwork SimpleTx (IOSim s)
chain [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (UTxOType SimpleTx -> IOSim s ())
-> UTxOType SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ [SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
1, SimpleId
2]

                let firstTx :: SimpleTx
firstTx = SimpleId -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx SimpleId
1 (SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
1) (SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
3)
                let secondTx :: SimpleTx
secondTx = SimpleId -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx SimpleId
2 (SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
3) (SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
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,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> TxIdType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> TxIdType tx -> ServerOutput tx
TxValid HeadId
testHeadId SimpleId
TxIdType SimpleTx
1
                [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ do
                  let snapshot :: Snapshot SimpleTx
snapshot = SnapshotNumber
-> SnapshotVersion
-> [SimpleTx]
-> UTxOType SimpleTx
-> Snapshot SimpleTx
forall tx.
IsTx tx =>
SnapshotNumber
-> SnapshotVersion -> [tx] -> UTxOType tx -> Snapshot tx
testSnapshot SnapshotNumber
2 SnapshotVersion
1 [SimpleTx
firstTx] ([SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
2, SimpleId
3])
                      sigs :: MultiSignature (Snapshot SimpleTx)
sigs = [Signature (Snapshot SimpleTx)]
-> MultiSignature (Snapshot SimpleTx)
forall a. [Signature a] -> MultiSignature a
aggregate [Secret (SigningKey HydraKey)
-> Snapshot SimpleTx -> Signature (Snapshot SimpleTx)
forall a.
SignableRepresentation a =>
Secret (SigningKey HydraKey) -> a -> Signature a
sign Secret (SigningKey HydraKey)
aliceSk Snapshot SimpleTx
snapshot, Secret (SigningKey HydraKey)
-> Snapshot SimpleTx -> Signature (Snapshot SimpleTx)
forall a.
SignableRepresentation a =>
Secret (SigningKey HydraKey) -> a -> Signature a
sign Secret (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,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> TxIdType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> TxIdType tx -> ServerOutput tx
TxValid HeadId
testHeadId SimpleId
TxIdType SimpleTx
2
                [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ do
                  let snapshot :: Snapshot SimpleTx
snapshot = SnapshotNumber
-> SnapshotVersion
-> [SimpleTx]
-> UTxOType SimpleTx
-> Snapshot SimpleTx
forall tx.
IsTx tx =>
SnapshotNumber
-> SnapshotVersion -> [tx] -> UTxOType tx -> Snapshot tx
testSnapshot SnapshotNumber
3 SnapshotVersion
1 [SimpleTx
secondTx] ([SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
2, SimpleId
4])
                      sigs :: MultiSignature (Snapshot SimpleTx)
sigs = [Signature (Snapshot SimpleTx)]
-> MultiSignature (Snapshot SimpleTx)
forall a. [Signature a] -> MultiSignature a
aggregate [Secret (SigningKey HydraKey)
-> Snapshot SimpleTx -> Signature (Snapshot SimpleTx)
forall a.
SignableRepresentation a =>
Secret (SigningKey HydraKey) -> a -> Signature a
sign Secret (SigningKey HydraKey)
aliceSk Snapshot SimpleTx
snapshot, Secret (SigningKey HydraKey)
-> Snapshot SimpleTx -> Signature (Snapshot SimpleTx)
forall a.
SignableRepresentation a =>
Secret (SigningKey HydraKey) -> a -> Signature a
sign Secret (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

      [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"depending transactions expire if not applicable in time" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
          (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
            Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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
              Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                SimulatedChainNetwork SimpleTx (IOSim s)
-> [TestHydraClient SimpleTx (IOSim s)]
-> UTxOType SimpleTx
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> [TestHydraClient SimpleTx (IOSim s)]
-> UTxOType SimpleTx
-> IOSim s ()
depositHead SimulatedChainNetwork SimpleTx (IOSim s)
chain [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (UTxOType SimpleTx -> IOSim s ())
-> UTxOType SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ [SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
1, SimpleId
2]

                let firstTx :: SimpleTx
firstTx = SimpleId -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx SimpleId
1 (SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
1) (SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
3)
                let secondTx :: SimpleTx
secondTx = SimpleId -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx SimpleId
2 (SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
3) (SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
4)
                -- Expect secondTx to be valid, but not applicable and stay pending
                TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx SimpleTx
secondTx)
                -- If we wait too long, secondTx will expire
                DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay (DiffTime -> IOSim s ()) -> DiffTime -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ TTL -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral TTL
defaultTxTTL DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
waitDelay DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
1
                [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                  TxInvalid{SimpleTx
transaction :: SimpleTx
$sel:transaction:NetworkConnected :: forall tx. ServerOutput tx -> tx
transaction} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ SimpleTx
transaction SimpleTx -> SimpleTx -> Bool
forall a. Eq a => a -> a -> Bool
== SimpleTx
secondTx
                  ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

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

      [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"sending two conflicting transactions should lead one being confirmed and one expired" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
          (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
            Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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
              Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                SimulatedChainNetwork SimpleTx (IOSim s)
-> [TestHydraClient SimpleTx (IOSim s)]
-> UTxOType SimpleTx
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> [TestHydraClient SimpleTx (IOSim s)]
-> UTxOType SimpleTx
-> IOSim s ()
depositHead SimulatedChainNetwork SimpleTx (IOSim s)
chain [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (UTxOType SimpleTx -> IOSim s ())
-> UTxOType SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ [SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
1, SimpleId
2]

                let tx' :: SimpleTx
tx' =
                      SimpleTx
                        { $sel:txSimpleId:SimpleTx :: SimpleId
txSimpleId = SimpleId
1
                        , $sel:txInputs:SimpleTx :: UTxOType SimpleTx
txInputs = SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
1
                        , $sel:txOutputs:SimpleTx :: UTxOType SimpleTx
txOutputs = SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
10
                        }
                    tx'' :: SimpleTx
tx'' =
                      SimpleTx
                        { $sel:txSimpleId:SimpleTx :: SimpleId
txSimpleId = SimpleId
2
                        , $sel:txInputs:SimpleTx :: UTxOType SimpleTx
txInputs = SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
1
                        , $sel:txOutputs:SimpleTx :: UTxOType SimpleTx
txOutputs = SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
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,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ do
                  let snapshot :: Snapshot SimpleTx
snapshot = SnapshotNumber
-> SnapshotVersion
-> [SimpleTx]
-> UTxOType SimpleTx
-> Snapshot SimpleTx
forall tx.
IsTx tx =>
SnapshotNumber
-> SnapshotVersion -> [tx] -> UTxOType tx -> Snapshot tx
testSnapshot SnapshotNumber
2 SnapshotVersion
1 [SimpleTx
tx'] ([SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
2, SimpleId
10])
                      sigs :: MultiSignature (Snapshot SimpleTx)
sigs = [Signature (Snapshot SimpleTx)]
-> MultiSignature (Snapshot SimpleTx)
forall a. [Signature a] -> MultiSignature a
aggregate [Secret (SigningKey HydraKey)
-> Snapshot SimpleTx -> Signature (Snapshot SimpleTx)
forall a.
SignableRepresentation a =>
Secret (SigningKey HydraKey) -> a -> Signature a
sign Secret (SigningKey HydraKey)
aliceSk Snapshot SimpleTx
snapshot, Secret (SigningKey HydraKey)
-> Snapshot SimpleTx -> Signature (Snapshot SimpleTx)
forall a.
SignableRepresentation a =>
Secret (SigningKey HydraKey) -> a -> Signature a
sign Secret (SigningKey HydraKey)
bobSk Snapshot SimpleTx
snapshot]
                  HeadId
-> Snapshot SimpleTx
-> MultiSignature (Snapshot SimpleTx)
-> ServerOutput SimpleTx
forall tx.
HeadId
-> Snapshot tx -> MultiSignature (Snapshot tx) -> ServerOutput tx
SnapshotConfirmed HeadId
testHeadId Snapshot SimpleTx
snapshot MultiSignature (Snapshot SimpleTx)
sigs
                [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                  TxInvalid{SimpleTx
$sel:transaction:NetworkConnected :: forall tx. ServerOutput tx -> tx
transaction :: SimpleTx
transaction} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ SimpleTx
transaction SimpleTx -> SimpleTx -> Bool
forall a. Eq a => a -> a -> Bool
== SimpleTx
tx''
                  ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

      [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"outputs utxo from confirmed snapshot when client requests it" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
        (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
            Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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 ->
              Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                SimulatedChainNetwork SimpleTx (IOSim s)
-> [TestHydraClient SimpleTx (IOSim s)]
-> UTxOType SimpleTx
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> [TestHydraClient SimpleTx (IOSim s)]
-> UTxOType SimpleTx
-> IOSim s ()
depositHead SimulatedChainNetwork SimpleTx (IOSim s)
chain [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (UTxOType SimpleTx -> IOSim s ())
-> UTxOType SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ [SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
1, SimpleId
2]

                let newTx :: SimpleTx
newTx = (SimpleId -> SimpleTx
aValidTx SimpleId
42){txInputs = utxoRefs [1]}
                TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx SimpleTx
newTx)

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

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

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

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

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

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

        [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"commit snapshot only approved when deadline not too soon" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain -> do
              -- NOTE: All nodes in a head share the same deposit period.
              let dp :: DepositPeriod
dp = DepositPeriod
defaultDepositPeriod
              DepositPeriod
-> Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s b.
DepositPeriod
-> Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s b)
-> IOSim s b
withHydraNode' DepositPeriod
dp Secret (SigningKey HydraKey)
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 ->
                DepositPeriod
-> Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s b.
DepositPeriod
-> Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s b)
-> IOSim s b
withHydraNode' DepositPeriod
dp Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                  -- NOTE: The deadline is too soon relative to the deposit period.
                  UTCTime
deadline <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
600 (UTCTime -> UTCTime) -> IOSim s UTCTime -> IOSim s UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOSim s UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
                  SimpleId
txid <- SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId
-> UTxOType SimpleTx
-> UTCTime
-> IOSim s (TxIdType SimpleTx)
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> UTxOType tx -> UTCTime -> m (TxIdType tx)
simulateDeposit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId (SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
123) UTCTime
deadline
                  [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                    CommitRecorded{UTxOType SimpleTx
utxoToCommit :: UTxOType SimpleTx
$sel:utxoToCommit:NetworkConnected :: forall tx. ServerOutput tx -> UTxOType tx
utxoToCommit} ->
                      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Key (Set SimpleTxOut)
123 Key (Set SimpleTxOut) -> Set SimpleTxOut -> Bool
forall t. StaticMap t => Key t -> t -> Bool
`member` Set SimpleTxOut
UTxOType SimpleTx
utxoToCommit)
                    ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing
                  [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                    DepositExpired{TxIdType SimpleTx
$sel:depositTxId:NetworkConnected :: forall tx. ServerOutput tx -> TxIdType tx
depositTxId :: TxIdType SimpleTx
depositTxId} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ SimpleId
TxIdType SimpleTx
depositTxId SimpleId -> SimpleId -> Bool
forall a. Eq a => a -> a -> Bool
== SimpleId
txid
                    ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

        [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"deposits are only processed after settled" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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) -> IOSim s ()
forall s. TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead TestHydraClient SimpleTx (IOSim s)
n1
                UTCTime
deadline <- IOSim s UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
newDeadlineFarEnoughFromNow
                SimpleId
depositTxId <- SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId
-> UTxOType SimpleTx
-> UTCTime
-> IOSim s (TxIdType SimpleTx)
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> UTxOType tx -> UTCTime -> m (TxIdType tx)
simulateDeposit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId (SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
123) UTCTime
deadline
                [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                  CommitRecorded{TxIdType SimpleTx
pendingDeposit :: TxIdType SimpleTx
$sel:pendingDeposit:NetworkConnected :: forall tx. ServerOutput tx -> TxIdType tx
pendingDeposit} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (SimpleId
TxIdType SimpleTx
pendingDeposit SimpleId -> SimpleId -> Bool
forall a. Eq a => a -> a -> Bool
== SimpleId
depositTxId)
                  ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing
                -- No approval yet, as the deposit is not settled
                let waitForApproval :: IOSim s ()
waitForApproval = [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                      CommitApproved{UTxOType SimpleTx
$sel:utxoToCommit:NetworkConnected :: forall tx. ServerOutput tx -> UTxOType tx
utxoToCommit :: UTxOType SimpleTx
utxoToCommit} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Set SimpleTxOut
UTxOType SimpleTx
utxoToCommit Set SimpleTxOut -> Set SimpleTxOut -> Bool
forall a. Eq a => a -> a -> Bool
== SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
123)
                      ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing
                DiffTime -> IOSim s () -> IOSim s (Maybe ())
forall a. DiffTime -> IOSim s a -> IOSim s (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 -> DiffTime) -> NominalDiffTime -> DiffTime
forall a b. (a -> b) -> a -> b
$ DepositPeriod -> NominalDiffTime
DP.toNominalDiffTime DepositPeriod
defaultDepositPeriod) IOSim s ()
waitForApproval IOSim s (Maybe ()) -> (Maybe () -> 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
>>= \case
                  Maybe ()
Nothing -> () -> IOSim s ()
forall a. a -> IOSim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                  Just ()
_ -> [Char] -> IOSim s ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
[Char] -> m a
failure [Char]
"Deposit was approved before deadline expired"
                -- Now it should get approved
                IOSim s ()
waitForApproval

        [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"commit snapshot only approved when deposit settled" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain -> do
              -- NOTE: All nodes in a head share the same deposit period.
              let dp :: DepositPeriod
dp = DepositPeriod
defaultDepositPeriod
              DepositPeriod
-> Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s b.
DepositPeriod
-> Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s b)
-> IOSim s b
withHydraNode' DepositPeriod
dp Secret (SigningKey HydraKey)
aliceSk [Party
bob] SimulatedChainNetwork SimpleTx (IOSim s)
chain ((TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ())
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \TestHydraClient SimpleTx (IOSim s)
n1 ->
                DepositPeriod
-> Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s b.
DepositPeriod
-> Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s b)
-> IOSim s b
withHydraNode' DepositPeriod
dp Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                  UTCTime
deadline <- IOSim s UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
newDeadlineFarEnoughFromNow
                  SimpleId
txid <- SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId
-> UTxOType SimpleTx
-> UTCTime
-> IOSim s (TxIdType SimpleTx)
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> UTxOType tx -> UTCTime -> m (TxIdType tx)
simulateDeposit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId (SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
123) UTCTime
deadline
                  [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                    CommitRecorded{TxIdType SimpleTx
$sel:pendingDeposit:NetworkConnected :: forall tx. ServerOutput tx -> TxIdType tx
pendingDeposit :: TxIdType SimpleTx
pendingDeposit} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (SimpleId
TxIdType SimpleTx
pendingDeposit SimpleId -> SimpleId -> Bool
forall a. Eq a => a -> a -> Bool
== SimpleId
txid)
                    ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing
                  -- No approval yet, as the deposit is not settled
                  let waitForApproval :: IOSim s ()
waitForApproval = [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                        CommitApproved{UTxOType SimpleTx
$sel:utxoToCommit:NetworkConnected :: forall tx. ServerOutput tx -> UTxOType tx
utxoToCommit :: UTxOType SimpleTx
utxoToCommit} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Set SimpleTxOut
UTxOType SimpleTx
utxoToCommit Set SimpleTxOut -> Set SimpleTxOut -> Bool
forall a. Eq a => a -> a -> Bool
== SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
123)
                        ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing
                  DiffTime -> IOSim s () -> IOSim s (Maybe ())
forall a. DiffTime -> IOSim s a -> IOSim s (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 -> DiffTime) -> NominalDiffTime -> DiffTime
forall a b. (a -> b) -> a -> b
$ DepositPeriod -> NominalDiffTime
DP.toNominalDiffTime DepositPeriod
dp) IOSim s ()
waitForApproval IOSim s (Maybe ()) -> (Maybe () -> 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
>>= \case
                    Maybe ()
Nothing -> () -> IOSim s ()
forall a. a -> IOSim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                    Just ()
_ -> [Char] -> IOSim s ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
[Char] -> m a
failure [Char]
"Deposit was approved before the deposit period passed"
                  -- Now it should get approved
                  IOSim s ()
waitForApproval

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

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

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

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

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

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

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

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

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

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

        -- XXX: This could be a single node test
        [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"multiple commits and decommits in sequence" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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
                Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                  SimulatedChainNetwork SimpleTx (IOSim s)
-> [TestHydraClient SimpleTx (IOSim s)]
-> UTxOType SimpleTx
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> [TestHydraClient SimpleTx (IOSim s)]
-> UTxOType SimpleTx
-> IOSim s ()
depositHead SimulatedChainNetwork SimpleTx (IOSim s)
chain [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (UTxOType SimpleTx -> IOSim s ())
-> UTxOType SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ [SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
11, SimpleId
22]

                  let decommitTx :: SimpleTx
decommitTx = SimpleId -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx SimpleId
1 (SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
11) (SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
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,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                    DecommitRequested{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, SimpleTx
decommitTx :: SimpleTx
$sel:decommitTx:NetworkConnected :: SimpleTx
decommitTx, $sel:utxoToDecommit:NetworkConnected :: UTxOType SimpleTx
utxoToDecommit = [SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
42]}

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

                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ DecommitApproved{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:decommitTxId:NetworkConnected :: TxIdType SimpleTx
decommitTxId = SimpleTx -> TxIdType SimpleTx
forall tx. IsTx tx => tx -> TxIdType tx
txId SimpleTx
decommitTx, $sel:utxoToDecommit:NetworkConnected :: UTxOType SimpleTx
utxoToDecommit = SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
42}
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ DecommitFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:distributedUTxO:NetworkConnected :: UTxOType SimpleTx
distributedUTxO = SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
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,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ ReadyToFanout{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId}
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 ClientInput SimpleTx
forall tx. ClientInput tx
Fanout
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:finalizedUTxO:NetworkConnected :: UTxOType SimpleTx
finalizedUTxO = [SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
22]}

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

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

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

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

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

      [Char] -> Spec -> Spec
forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe [Char]
"Decommit" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
        [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"can request decommit" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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 ->
                Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2

                  let decommitTx :: SimpleTx
decommitTx = SimpleId -> SimpleTx
aValidTx SimpleId
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,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                    DecommitRequested{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, SimpleTx
$sel:decommitTx:NetworkConnected :: SimpleTx
decommitTx :: SimpleTx
decommitTx, $sel:utxoToDecommit:NetworkConnected :: UTxOType SimpleTx
utxoToDecommit = [SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
42]}

        [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"requested decommits get approved" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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 ->
                Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                  let decommitTx :: SimpleTx
decommitTx = SimpleId -> SimpleTx
aValidTx SimpleId
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,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                    DecommitRequested{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, SimpleTx
$sel:decommitTx:NetworkConnected :: SimpleTx
decommitTx :: SimpleTx
decommitTx, $sel:utxoToDecommit:NetworkConnected :: UTxOType SimpleTx
utxoToDecommit = [SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
42]}

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

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

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

        [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"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
$
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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 ->
                Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                  let decommitTx1 :: SimpleTx
decommitTx1 = SimpleId -> SimpleTx
aValidTx SimpleId
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,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                    DecommitRequested{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:decommitTx:NetworkConnected :: SimpleTx
decommitTx = SimpleTx
decommitTx1, $sel:utxoToDecommit:NetworkConnected :: UTxOType SimpleTx
utxoToDecommit = [SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
42]}

                  let decommitTx2 :: SimpleTx
decommitTx2 = SimpleId -> SimpleTx
aValidTx SimpleId
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,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                    DecommitInvalid
                      { $sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId
                      , $sel:decommitTx:NetworkConnected :: SimpleTx
decommitTx = SimpleTx
decommitTx2
                      , $sel:decommitInvalidReason:NetworkConnected :: DecommitInvalidReason SimpleTx
decommitInvalidReason = DecommitAlreadyInFlight{$sel:otherDecommitTxId:DecommitTxInvalid :: TxIdType SimpleTx
otherDecommitTxId = SimpleTx -> TxIdType SimpleTx
forall tx. IsTx tx => tx -> TxIdType tx
txId SimpleTx
decommitTx1}
                      }

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

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

        [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"can process transactions while decommit pending" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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 ->
                Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2

                  let decommitTx :: SimpleTx
decommitTx = SimpleId -> SimpleTx
aValidTx SimpleId
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,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                    DecommitRequested{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, SimpleTx
$sel:decommitTx:NetworkConnected :: SimpleTx
decommitTx :: SimpleTx
decommitTx, $sel:utxoToDecommit:NetworkConnected :: UTxOType SimpleTx
utxoToDecommit = [SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
42]}
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                    DecommitApproved{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:decommitTxId:NetworkConnected :: TxIdType SimpleTx
decommitTxId = SimpleId
TxIdType SimpleTx
42, $sel:utxoToDecommit:NetworkConnected :: UTxOType SimpleTx
utxoToDecommit = [SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
42]}

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

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

        [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"can fanout with decommit in flight" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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
                Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                  let decommitTx :: SimpleTx
decommitTx = SimpleId -> SimpleTx
aValidTx SimpleId
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})
                  -- Close while the decommit is still in flight
                  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,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ ReadyToFanout{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId}
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Fanout
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:finalizedUTxO:NetworkConnected :: UTxOType SimpleTx
finalizedUTxO = [SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
42]}

        [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"can fanout after a decommit" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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
                Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                  let decommitTx :: SimpleTx
decommitTx = SimpleId -> SimpleTx
aValidTx SimpleId
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,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                    DecommitApproved
                      { $sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId
                      , $sel:decommitTxId:NetworkConnected :: TxIdType SimpleTx
decommitTxId = SimpleTx -> TxIdType SimpleTx
forall tx. IsTx tx => tx -> TxIdType tx
txId SimpleTx
decommitTx
                      , $sel:utxoToDecommit:NetworkConnected :: UTxOType SimpleTx
utxoToDecommit = [SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
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,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ ReadyToFanout{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId}
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Fanout
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:finalizedUTxO:NetworkConnected :: UTxOType SimpleTx
finalizedUTxO = Set SimpleTxOut
UTxOType SimpleTx
forall a. Monoid a => a
mempty}

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

      [Char] -> Spec -> Spec
forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe [Char]
"Side load snapshot" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
        [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"head remains functional after side-loading a snapshot" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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 ->
                Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                  -- Produce confirmed snapshot sn=1 with tx 42 included.
                  let tx :: SimpleTx
tx = SimpleId -> SimpleTx
aValidTx SimpleId
42
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx SimpleTx
tx)
                  [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                    SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{SnapshotNumber
$sel:number:Snapshot :: forall tx. Snapshot tx -> SnapshotNumber
number :: SnapshotNumber
number}} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ SnapshotNumber
number SnapshotNumber -> SnapshotNumber -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotNumber
1
                    ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing
                  -- Capture sn=1 and immediately side-load it on all nodes,
                  -- resetting local state back to the confirmed snapshot.
                  ConfirmedSnapshot SimpleTx
snapshot1 <- TestHydraClient SimpleTx (IOSim s)
-> IOSim s (ConfirmedSnapshot SimpleTx)
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m) =>
TestHydraClient tx m -> m (ConfirmedSnapshot tx)
getConfirmedSnapshotFromNode TestHydraClient SimpleTx (IOSim s)
n1
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (ConfirmedSnapshot SimpleTx -> ClientInput SimpleTx
forall tx. ConfirmedSnapshot tx -> ClientInput tx
SideLoadSnapshot ConfirmedSnapshot SimpleTx
snapshot1)
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 (ConfirmedSnapshot SimpleTx -> ClientInput SimpleTx
forall tx. ConfirmedSnapshot tx -> ClientInput tx
SideLoadSnapshot ConfirmedSnapshot SimpleTx
snapshot1)
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 MonadLabelledSTM 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
$ SnapshotSideLoaded{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:snapshotNumber:NetworkConnected :: SnapshotNumber
snapshotNumber = SnapshotNumber
1}
                  -- After sideload the head must still be functional: a new
                  -- transaction can be submitted and confirmed by all parties.
                  let tx2 :: SimpleTx
tx2 = SimpleId -> SimpleTx
aValidTx SimpleId
88
                  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
tx2)
                  [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                    SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{SnapshotNumber
$sel:number:Snapshot :: forall tx. Snapshot tx -> SnapshotNumber
number :: SnapshotNumber
number}} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ SnapshotNumber
number SnapshotNumber -> SnapshotNumber -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotNumber
2
                    ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

        [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"side-loaded deposit snapshot allows spending the deposited UTxO" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
          -- NOTE: This is a regression test: after a deposit is confirmed and
          -- its on-chain increment finalized, side-loading the deposit snapshot
          -- must restore localUTxO to include the deposited funds. The deposit
          -- snapshot has utxo=⦰ and utxoToCommit={11}, so naive sideload using
          -- only snapshot.utxo leaves localUTxO=⦰, making any tx spending the
          -- deposited input invalid.
          (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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 ->
                Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
                  -- Deposit utxoRef 11 and wait for the on-chain increment to
                  -- finalize. Confirmed snapshot is now sn=1, sv=0,
                  -- utxo={}, utxoToCommit={11}, and version=1 on-chain.
                  SimulatedChainNetwork SimpleTx (IOSim s)
-> [TestHydraClient SimpleTx (IOSim s)]
-> UTxOType SimpleTx
-> IOSim s ()
forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> [TestHydraClient SimpleTx (IOSim s)]
-> UTxOType SimpleTx
-> IOSim s ()
depositHead SimulatedChainNetwork SimpleTx (IOSim s)
chain [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (UTxOType SimpleTx -> IOSim s ())
-> UTxOType SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ [SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
11]
                  -- Capture the deposit snapshot (sn=1) before submitting any
                  -- further transactions.
                  ConfirmedSnapshot SimpleTx
depositSnapshot <- TestHydraClient SimpleTx (IOSim s)
-> IOSim s (ConfirmedSnapshot SimpleTx)
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m) =>
TestHydraClient tx m -> m (ConfirmedSnapshot tx)
getConfirmedSnapshotFromNode TestHydraClient SimpleTx (IOSim s)
n1
                  -- Side-load the deposit snapshot on all nodes, resetting
                  -- confirmed snapshot and local state.
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (ConfirmedSnapshot SimpleTx -> ClientInput SimpleTx
forall tx. ConfirmedSnapshot tx -> ClientInput tx
SideLoadSnapshot ConfirmedSnapshot SimpleTx
depositSnapshot)
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 (ConfirmedSnapshot SimpleTx -> ClientInput SimpleTx
forall tx. ConfirmedSnapshot tx -> ClientInput tx
SideLoadSnapshot ConfirmedSnapshot SimpleTx
depositSnapshot)
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 MonadLabelledSTM 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
$ SnapshotSideLoaded{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:snapshotNumber:NetworkConnected :: SnapshotNumber
snapshotNumber = SnapshotNumber
1}
                  -- A tx spending from the deposited utxoRef 11 must be valid
                  -- after sideload. Without the fix, localUTxO would be ⦰ and
                  -- this would be TxInvalid with BadInputsUTxO.
                  let spendDeposit :: SimpleTx
spendDeposit = SimpleTx{$sel:txSimpleId:SimpleTx :: SimpleId
txSimpleId = SimpleId
42, $sel:txInputs:SimpleTx :: UTxOType SimpleTx
txInputs = [SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
11], $sel:txOutputs:SimpleTx :: UTxOType SimpleTx
txOutputs = [SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
42]}
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx SimpleTx
spendDeposit)
                  [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> TxIdType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> TxIdType tx -> ServerOutput tx
TxValid HeadId
testHeadId SimpleId
TxIdType SimpleTx
42
                  -- Both nodes should reach a new confirmed snapshot.
                  [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                    SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{SnapshotNumber
$sel:number:Snapshot :: forall tx. Snapshot tx -> SnapshotNumber
number :: SnapshotNumber
number}} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ SnapshotNumber
number SnapshotNumber -> SnapshotNumber -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotNumber
2
                    ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

    [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"can be finalized by all parties after contestation period" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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 ->
            Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 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,
 MonadLabelledSTM 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,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:finalizedUTxO:NetworkConnected :: UTxOType SimpleTx
finalizedUTxO = Set SimpleTxOut
UTxOType SimpleTx
forall a. Monoid a => a
mempty}

    [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"selective partial fanout keeps the head open; other parties do not steamroll the remainder" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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 ->
            Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2
              -- Create UTxO [1, 2] in the head so the partial fanout test is meaningful.
              -- aValidTx has empty inputs, so it's valid even against empty initial UTxO.
              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 (SimpleId -> SimpleTx
aValidTx SimpleId
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 (SimpleId -> SimpleTx
aValidTx SimpleId
2))
              [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{UTxOType SimpleTx
utxo :: UTxOType SimpleTx
$sel:utxo:Snapshot :: forall tx. Snapshot tx -> UTxOType tx
utxo}} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Set SimpleTxOut
UTxOType SimpleTx
utxo Set SimpleTxOut -> Set SimpleTxOut -> Bool
forall a. Eq a => a -> a -> Bool
== [SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
1, SimpleId
2]
                ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing
              TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Close
              [TestHydraClient SimpleTx (IOSim s)]
-> (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,
 MonadLabelledSTM 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
              -- n1 selectively fans out only UTxO 1. The head must stay open with
              -- UTxO 2 remaining; crucially n2 (which did not initiate) must NOT
              -- auto-drain the remainder.
              TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (UTxOType SimpleTx -> ClientInput SimpleTx
forall tx. UTxOType tx -> ClientInput tx
PartialFanout (SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
1))
              [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                HeadPartiallyFannedOut{UTxOType SimpleTx
remainingUTxO :: UTxOType SimpleTx
$sel:remainingUTxO:NetworkConnected :: forall tx. ServerOutput tx -> UTxOType tx
remainingUTxO} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Set SimpleTxOut
UTxOType SimpleTx
remainingUTxO Set SimpleTxOut -> Set SimpleTxOut -> Bool
forall a. Eq a => a -> a -> Bool
== [SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
2]
                ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing
              -- n1 then fans out the rest, which finalizes the head with all UTxO.
              TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (UTxOType SimpleTx -> ClientInput SimpleTx
forall tx. UTxOType tx -> ClientInput tx
PartialFanout (SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
2))
              [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:finalizedUTxO:NetworkConnected :: UTxOType SimpleTx
finalizedUTxO = [SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
1, SimpleId
2]}

    [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"selective partial fanout can be continued by a different party" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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 ->
            Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 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 (SimpleId -> SimpleTx
aValidTx SimpleId
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 (SimpleId -> SimpleTx
aValidTx SimpleId
2))
              [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{UTxOType SimpleTx
$sel:utxo:Snapshot :: forall tx. Snapshot tx -> UTxOType tx
utxo :: UTxOType SimpleTx
utxo}} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Set SimpleTxOut
UTxOType SimpleTx
utxo Set SimpleTxOut -> Set SimpleTxOut -> Bool
forall a. Eq a => a -> a -> Bool
== [SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
1, SimpleId
2]
                ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing
              TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Close
              [TestHydraClient SimpleTx (IOSim s)]
-> (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,
 MonadLabelledSTM 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
              -- n1 starts the selective fanout (distributing UTxO 1)...
              TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 (UTxOType SimpleTx -> ClientInput SimpleTx
forall tx. UTxOType tx -> ClientInput tx
PartialFanout (SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
1))
              [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                HeadPartiallyFannedOut{UTxOType SimpleTx
$sel:remainingUTxO:NetworkConnected :: forall tx. ServerOutput tx -> UTxOType tx
remainingUTxO :: UTxOType SimpleTx
remainingUTxO} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Set SimpleTxOut
UTxOType SimpleTx
remainingUTxO Set SimpleTxOut -> Set SimpleTxOut -> Bool
forall a. Eq a => a -> a -> Bool
== [SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
2]
                ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing
              -- ...but n2 (a different party) drives the next step. Any party in
              -- FanoutProgress may continue the fanout; observers only wait.
              TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n2 (UTxOType SimpleTx -> ClientInput SimpleTx
forall tx. UTxOType tx -> ClientInput tx
PartialFanout (SimpleId -> UTxOType SimpleTx
utxoRef SimpleId
2))
              [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsFinalized{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:finalizedUTxO:NetworkConnected :: UTxOType SimpleTx
finalizedUTxO = [SimpleId] -> UTxOType SimpleTx
utxoRefs [SimpleId
1, SimpleId
2]}

    [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"contest automatically when detecting closing with old snapshot" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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 ->
            Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 TestHydraClient SimpleTx (IOSim s)
n1 TestHydraClient SimpleTx (IOSim s)
n2

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

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

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

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

  [Char] -> Spec -> Spec
forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe [Char]
"Hydra Node Logging" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"traces processing of events" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
      let result :: SimTrace ()
result = (forall s. IOSim s ()) -> SimTrace ()
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace ((forall s. IOSim s ()) -> SimTrace ())
-> (forall s. IOSim s ()) -> SimTrace ()
forall a b. (a -> b) -> a -> b
$ do
            (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
              Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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,
 MonadLabelledSTM 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
HeadIsOpen 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 -> Input SimpleTx -> HydraNodeLog SimpleTx
forall tx. Party -> Word64 -> Input tx -> HydraNodeLog tx
BeginInput Party
alice Word64
1 (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
1]

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

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

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

  [Char] -> Spec -> Spec
forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe [Char]
"rolling back & forward does not make the node crash" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"does work for rollbacks past init" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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,
 MonadLabelledSTM 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
HeadIsOpen HeadId
testHeadId ([Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice])
            -- We expect the Init to be rolled back and forward again
            SimulatedChainNetwork SimpleTx (IOSim s) -> TTL -> IOSim s ()
forall tx (m :: * -> *). SimulatedChainNetwork tx m -> TTL -> m ()
rollbackAndForward SimulatedChainNetwork SimpleTx (IOSim s)
chain TTL
1
            -- We expect the node to be open again and let us close
            TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
n1 ClientInput SimpleTx
forall tx. ClientInput tx
Close
            [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
n1] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ())
-> (ServerOutput SimpleTx -> Bool)
-> ServerOutput SimpleTx
-> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeadId -> ServerOutput SimpleTx -> Bool
forall tx. HeadId -> ServerOutput tx -> Bool
headIsClosed HeadId
testHeadId

    [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"does work for rollbacks past open" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain ->
          Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (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,
 MonadLabelledSTM 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
HeadIsOpen HeadId
testHeadId ([Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice])
            -- We expect the Init (which now opens the head directly) to be
            -- rolled back and forward again
            SimulatedChainNetwork SimpleTx (IOSim s) -> TTL -> IOSim s ()
forall tx (m :: * -> *). SimulatedChainNetwork tx m -> TTL -> m ()
rollbackAndForward SimulatedChainNetwork SimpleTx (IOSim s)
chain TTL
1
            -- We expect the node to still work and let us 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 (SimpleId -> SimpleTx
aValidTx SimpleId
42))
            [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadId -> TxIdType SimpleTx -> ServerOutput SimpleTx
forall tx. HeadId -> TxIdType tx -> ServerOutput tx
TxValid HeadId
testHeadId SimpleId
TxIdType SimpleTx
42

  -- Regression test reproducing the demo bug: alice goes offline, alice-mirror
  -- signs on her behalf (snapshot 2 confirms), then alice-mirror also goes
  -- offline. Alice restarts with only her stale state (snapshot 1) and cannot
  -- sign the pending ReqSn(3) because seenSn=1 ≠ sn-1=2.
  --
  -- Leader rotation with bob sending Init (parties = [bob, alice, carol]):
  --   sn=1 → bob, sn=2 → alice (alice-mirror acts as alice), sn=3 → carol
  --
  -- Note that this is effectively a Known Problem, that we're going to
  -- consider solvable by using the snapshot sideload functionality; i.e. just
  -- bring alice and alice-mirror to the correct snapshot manually.
  [Char] -> Spec -> Spec
forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe [Char]
"node restart and snapshot recovery" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
xit [Char]
"emits SnapshotConfirmed to bob when alice reconnects and signs the pending snapshot" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
      (forall s. IOSim s ()) -> IO ()
forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim ((forall s. IOSim s ()) -> IO ())
-> (forall s. IOSim s ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork ((SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
 -> IOSim s ())
-> (SimulatedChainNetwork SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \SimulatedChainNetwork SimpleTx (IOSim s)
chain -> do
          TVar s [ChainEvent SimpleTx]
chainHistoryRef <- [ChainEvent SimpleTx]
-> IOSim s (TVar (IOSim s) [ChainEvent SimpleTx])
forall a. a -> IOSim s (TVar (IOSim s) a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO []
          TVar s (Maybe (ConfirmedSnapshot SimpleTx))
confirmedSnap1Ref <- Maybe (ConfirmedSnapshot SimpleTx)
-> IOSim s (TVar (IOSim s) (Maybe (ConfirmedSnapshot SimpleTx)))
forall a. a -> IOSim s (TVar (IOSim s) a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO (Maybe (ConfirmedSnapshot SimpleTx)
forall a. Maybe a
Nothing :: Maybe (ConfirmedSnapshot SimpleTx))

          Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (SigningKey HydraKey)
carolSk [Party
alice, 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)
nCarol ->
            Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (SigningKey HydraKey)
bobSk [Party
alice, Party
carol] 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)
nBob -> do
              -- alice-mirror: second node with aliceSk, acts as alice when alice is offline
              Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (SigningKey HydraKey)
aliceSk [Party
bob, Party
carol] 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)
nAliceMirror -> do
                Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (SigningKey HydraKey)
aliceSk [Party
bob, Party
carol] 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)
nAlice -> do
                  -- Bob sends Init → parties = [bob, alice, carol]
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
nBob 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,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
nAlice, TestHydraClient SimpleTx (IOSim s)
nAliceMirror, TestHydraClient SimpleTx (IOSim s)
nBob, TestHydraClient SimpleTx (IOSim s)
nCarol] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                    HeadIsOpen{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:parties:NetworkConnected :: [Party]
parties = [Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
bob, Item [Party]
Party
alice, Item [Party]
Party
carol]}

                  -- Snapshot 1: bob is leader (sn=1, (0) mod 3 = 0 = bob's index)
                  let tx1 :: SimpleTx
tx1 = SimpleId -> SimpleTx
aValidTx SimpleId
42
                  TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
nBob (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx SimpleTx
tx1)
                  [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
nAlice, TestHydraClient SimpleTx (IOSim s)
nAliceMirror, TestHydraClient SimpleTx (IOSim s)
nBob, TestHydraClient SimpleTx (IOSim s)
nCarol] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                    SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{SnapshotNumber
$sel:number:Snapshot :: forall tx. Snapshot tx -> SnapshotNumber
number :: SnapshotNumber
number}} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (SnapshotNumber
number SnapshotNumber -> SnapshotNumber -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotNumber
1)
                    ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

                  -- Capture chain history and alice's confirmed state before going offline
                  [ChainEvent SimpleTx]
hist <- SimulatedChainNetwork SimpleTx (IOSim s)
-> IOSim s [ChainEvent SimpleTx]
forall tx (m :: * -> *).
SimulatedChainNetwork tx m -> m [ChainEvent tx]
getChainHistory SimulatedChainNetwork SimpleTx (IOSim s)
chain
                  STM (IOSim s) () -> IOSim s ()
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) () -> IOSim s ()) -> STM (IOSim s) () -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ TVar (IOSim s) [ChainEvent SimpleTx]
-> [ChainEvent SimpleTx] -> STM (IOSim s) ()
forall a. TVar (IOSim s) a -> a -> STM (IOSim s) ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar (IOSim s) [ChainEvent SimpleTx]
TVar s [ChainEvent SimpleTx]
chainHistoryRef [ChainEvent SimpleTx]
hist
                  ConfirmedSnapshot SimpleTx
snap1 <- TestHydraClient SimpleTx (IOSim s)
-> IOSim s (ConfirmedSnapshot SimpleTx)
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m) =>
TestHydraClient tx m -> m (ConfirmedSnapshot tx)
getConfirmedSnapshotFromNode TestHydraClient SimpleTx (IOSim s)
nAlice
                  STM (IOSim s) () -> IOSim s ()
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) () -> IOSim s ()) -> STM (IOSim s) () -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ TVar (IOSim s) (Maybe (ConfirmedSnapshot SimpleTx))
-> Maybe (ConfirmedSnapshot SimpleTx) -> STM (IOSim s) ()
forall a. TVar (IOSim s) a -> a -> STM (IOSim s) ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar (IOSim s) (Maybe (ConfirmedSnapshot SimpleTx))
TVar s (Maybe (ConfirmedSnapshot SimpleTx))
confirmedSnap1Ref (ConfirmedSnapshot SimpleTx -> Maybe (ConfirmedSnapshot SimpleTx)
forall a. a -> Maybe a
Just ConfirmedSnapshot SimpleTx
snap1)
                -- Alice exits here — she is now "offline"; alice-mirror still running

                -- Snapshot 2: alice is leader (sn=2, (1) mod 3 = 1 = alice's index).
                -- alice-mirror acts as alice and signs on her behalf.
                let tx2 :: SimpleTx
tx2 = SimpleId -> SimpleTx
aValidTx SimpleId
43
                TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
nBob (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx SimpleTx
tx2)
                [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
nAliceMirror, TestHydraClient SimpleTx (IOSim s)
nBob, TestHydraClient SimpleTx (IOSim s)
nCarol] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                  SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{SnapshotNumber
$sel:number:Snapshot :: forall tx. Snapshot tx -> SnapshotNumber
number :: SnapshotNumber
number}} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (SnapshotNumber
number SnapshotNumber -> SnapshotNumber -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotNumber
2)
                  ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing
              -- Alice-mirror exits here — both alice instances are now offline

              -- Snapshot 3: carol is leader (sn=3, (2) mod 3 = 2 = carol's index).
              -- Only bob + carol can sign; snapshot is stuck without alice.
              let tx3 :: SimpleTx
tx3 = SimpleId -> SimpleTx
aValidTx SimpleId
44
              TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
nBob (SimpleTx -> ClientInput SimpleTx
forall tx. tx -> ClientInput tx
NewTx SimpleTx
tx3)

              -- Alice restarts: she only has her own stale state (snapshot 1).
              -- She missed snapshot 2 which alice-mirror confirmed.
              [ChainEvent SimpleTx]
chainHistory <- TVar (IOSim s) [ChainEvent SimpleTx]
-> IOSim s [ChainEvent SimpleTx]
forall a. TVar (IOSim s) a -> IOSim s a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
readTVarIO TVar (IOSim s) [ChainEvent SimpleTx]
TVar s [ChainEvent SimpleTx]
chainHistoryRef
              Just ConfirmedSnapshot SimpleTx
confirmedSnap1 <- TVar (IOSim s) (Maybe (ConfirmedSnapshot SimpleTx))
-> IOSim s (Maybe (ConfirmedSnapshot SimpleTx))
forall a. TVar (IOSim s) a -> IOSim s a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
readTVarIO TVar (IOSim s) (Maybe (ConfirmedSnapshot SimpleTx))
TVar s (Maybe (ConfirmedSnapshot SimpleTx))
confirmedSnap1Ref

              Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s ())
-> IOSim s ()
forall s a.
Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s a)
-> IOSim s a
withHydraNode Secret (SigningKey HydraKey)
aliceSk [Party
bob, Party
carol] 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)
nAliceNew -> do
                -- Replay chain events to bring new alice from Idle → Open
                (ChainEvent SimpleTx -> IOSim s ())
-> [ChainEvent SimpleTx] -> IOSim s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (TestHydraClient SimpleTx (IOSim s)
-> ChainEvent SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ChainEvent tx -> m ()
injectChainEvent TestHydraClient SimpleTx (IOSim s)
nAliceNew) [ChainEvent SimpleTx]
chainHistory
                [TestHydraClient SimpleTx (IOSim s)]
-> ServerOutput SimpleTx -> IOSim s ()
forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
nAliceNew] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
                  HeadIsOpen{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:parties:NetworkConnected :: [Party]
parties = [Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
bob, Item [Party]
Party
alice, Item [Party]
Party
carol]}

                -- Side-load alice's last known snapshot (snapshot 1 — stale!).
                -- She doesn't know about snapshot 2, which alice-mirror confirmed.
                TestHydraClient SimpleTx (IOSim s)
-> ClientInput SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> ClientInput tx -> m ()
send TestHydraClient SimpleTx (IOSim s)
nAliceNew (ConfirmedSnapshot SimpleTx -> ClientInput SimpleTx
forall tx. ConfirmedSnapshot tx -> ClientInput tx
SideLoadSnapshot ConfirmedSnapshot SimpleTx
confirmedSnap1)
                [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
nAliceNew] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                  SnapshotSideLoaded{SnapshotNumber
$sel:snapshotNumber:NetworkConnected :: forall tx. ServerOutput tx -> SnapshotNumber
snapshotNumber :: SnapshotNumber
snapshotNumber} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (SnapshotNumber
snapshotNumber SnapshotNumber -> SnapshotNumber -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotNumber
1)
                  ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

                -- Inject the pending ReqSn from carol (leader for sn=3).
                -- Alice has seenSn=1, but sn=3 requires seenSn=2 → ReqSnNumberInvalid.
                -- She cannot sign → snapshot 3 stays pending → bob never sees
                -- SnapshotConfirmed(3).
                TestHydraClient SimpleTx (IOSim s)
-> Party -> Message SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> Party -> Message tx -> m ()
injectNetworkInput TestHydraClient SimpleTx (IOSim s)
nAliceNew Party
carol (SimpleTx -> Message SimpleTx
forall tx. tx -> Message tx
ReqTx SimpleTx
tx3)
                TestHydraClient SimpleTx (IOSim s)
-> Party -> Message SimpleTx -> IOSim s ()
forall tx (m :: * -> *).
TestHydraClient tx m -> Party -> Message tx -> m ()
injectNetworkInput TestHydraClient SimpleTx (IOSim s)
nAliceNew Party
carol (SnapshotVersion
-> SnapshotNumber
-> [TxIdType SimpleTx]
-> Maybe SimpleTx
-> Maybe (TxIdType SimpleTx)
-> Message SimpleTx
forall tx.
SnapshotVersion
-> SnapshotNumber
-> [TxIdType tx]
-> Maybe tx
-> Maybe (TxIdType tx)
-> Message tx
ReqSn SnapshotVersion
0 SnapshotNumber
3 [SimpleId
TxIdType SimpleTx
44] Maybe SimpleTx
forall a. Maybe a
Nothing Maybe SimpleId
Maybe (TxIdType SimpleTx)
forall a. Maybe a
Nothing)

                -- BUG: bob should see SnapshotConfirmed for snapshot 3 but never does,
                -- because alice can't sign a snapshot that skips over snapshot 2.
                [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)
nBob] ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \case
                  SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{SnapshotNumber
$sel:number:Snapshot :: forall tx. Snapshot tx -> SnapshotNumber
number :: SnapshotNumber
number}} -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (SnapshotNumber
number SnapshotNumber -> SnapshotNumber -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotNumber
3)
                  ServerOutput SimpleTx
_ -> Maybe ()
forall a. Maybe a
Nothing

-- | 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, MonadLabelledSTM m, IsChainState tx) =>
  [TestHydraClient tx m] ->
  ServerOutput tx ->
  m ()
waitUntil :: forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m, MonadAsync m, MonadTimer m,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient tx m]
nodes ServerOutput tx
expected =
  [TestHydraClient tx m] -> (ServerOutput tx -> Maybe ()) -> m ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient tx m]
nodes ((ServerOutput tx -> Maybe ()) -> m ())
-> (ServerOutput tx -> Maybe ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ())
-> (ServerOutput tx -> Bool) -> ServerOutput tx -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ServerOutput tx
expected ==)

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

  threeDays :: DiffTime
threeDays = 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
3

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

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

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

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

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

-- | With-pattern wrapper around 'simulatedChainAndNetwork' which does 'cancel'
-- the 'tickThread'. Also, this will fix tx to 'SimpleTx' so that it can pick an
-- initial chain state to play back to our test nodes.
-- NOTE: The simulated network has a block time of 20 (simulated) seconds.
withSimulatedChainAndNetwork ::
  (MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m, MonadLabelledSTM m) =>
  (SimulatedChainNetwork SimpleTx m -> m a) ->
  m a
withSimulatedChainAndNetwork :: forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
(SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndNetwork = DiffTime
-> DiffTime -> (SimulatedChainNetwork SimpleTx m -> m a) -> m a
forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
DiffTime
-> DiffTime -> (SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndSlowNetwork DiffTime
0 DiffTime
0

-- | Simulated chain and network where the network and/or chain observations
-- can be delivered with a configurable delay. Handy to reproduce race
-- conditions related to message ordering.
withSimulatedChainAndSlowNetwork ::
  (MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m, MonadLabelledSTM m) =>
  -- | Network message delay
  DiffTime ->
  -- | Chain observation delay
  DiffTime ->
  (SimulatedChainNetwork SimpleTx m -> m a) ->
  m a
withSimulatedChainAndSlowNetwork :: forall (m :: * -> *) a.
(MonadTime m, MonadDelay m, MonadAsync m, MonadThrow m,
 MonadLabelledSTM m) =>
DiffTime
-> DiffTime -> (SimulatedChainNetwork SimpleTx m -> m a) -> m a
withSimulatedChainAndSlowNetwork DiffTime
networkDelay DiffTime
chainDelay =
  m (SimulatedChainNetwork SimpleTx m)
-> (SimulatedChainNetwork SimpleTx m -> m ())
-> (SimulatedChainNetwork SimpleTx m -> m a)
-> m a
forall a b c. m a -> (a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadThrow m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
    ((DraftHydraNode SimpleTx m
 -> TVar m [HydraNode SimpleTx m] -> Network m (Message SimpleTx))
-> DiffTime
-> ChainStateType SimpleTx
-> m (SimulatedChainNetwork SimpleTx m)
forall (m :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m, MonadLabelledSTM m) =>
(DraftHydraNode SimpleTx m
 -> TVar m [HydraNode SimpleTx m] -> Network m (Message SimpleTx))
-> DiffTime
-> ChainStateType SimpleTx
-> m (SimulatedChainNetwork SimpleTx m)
simulatedChainAndNetworkUsing (DiffTime
-> DraftHydraNode SimpleTx m
-> TVar m [HydraNode SimpleTx m]
-> Network m (Message SimpleTx)
forall (m :: * -> *) tx.
(MonadAsync m, MonadDelay m) =>
DiffTime
-> DraftHydraNode tx m
-> TVar m [HydraNode tx m]
-> Network m (Message tx)
createMockNetworkWithDelay DiffTime
networkDelay) DiffTime
chainDelay ChainStateType SimpleTx
SimpleChainState
initialChainState)
    (Async m () -> m ()
forall a. Async m a -> m ()
forall (m :: * -> *) a. MonadAsync m => Async m a -> m ()
cancel (Async m () -> m ())
-> (SimulatedChainNetwork SimpleTx m -> Async m ())
-> SimulatedChainNetwork SimpleTx m
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimulatedChainNetwork SimpleTx m -> Async m ()
forall tx (m :: * -> *). SimulatedChainNetwork tx m -> Async m ()
tickThread)
 where
  initialChainState :: SimpleChainState
initialChainState = SimpleChainState{$sel:slot:SimpleChainState :: ChainSlot
slot = TTL -> ChainSlot
ChainSlot TTL
0}

-- | Like 'simulatedChainAndNetwork' but accepts a custom network factory and
-- an optional chain observation delay. When 'chainDelay' > 0, each chain event
-- is delivered to nodes asynchronously after that delay, allowing tests to
-- reproduce races where nodes observe the same on-chain event at different times.
simulatedChainAndNetworkUsing ::
  forall m.
  (MonadTime m, MonadDelay m, MonadAsync m, MonadLabelledSTM m) =>
  (DraftHydraNode SimpleTx m -> TVar m [HydraNode SimpleTx m] -> Network m (Message SimpleTx)) ->
  DiffTime ->
  ChainStateType SimpleTx ->
  m (SimulatedChainNetwork SimpleTx m)
simulatedChainAndNetworkUsing :: forall (m :: * -> *).
(MonadTime m, MonadDelay m, MonadAsync m, MonadLabelledSTM m) =>
(DraftHydraNode SimpleTx m
 -> TVar m [HydraNode SimpleTx m] -> Network m (Message SimpleTx))
-> DiffTime
-> ChainStateType SimpleTx
-> m (SimulatedChainNetwork SimpleTx m)
simulatedChainAndNetworkUsing DraftHydraNode SimpleTx m
-> TVar m [HydraNode SimpleTx m] -> Network m (Message SimpleTx)
networkCallback DiffTime
chainDelay ChainStateType SimpleTx
initialChainState = do
  TVar m [ChainEvent SimpleTx]
history <- [Char] -> [ChainEvent SimpleTx] -> m (TVar m [ChainEvent SimpleTx])
forall (m :: * -> *) a.
MonadLabelledSTM m =>
[Char] -> a -> m (TVar m a)
newLabelledTVarIO [Char]
"sim-chain-history" []
  TVar m [HydraNode SimpleTx m]
nodes <- [Char]
-> [HydraNode SimpleTx m] -> m (TVar m [HydraNode SimpleTx m])
forall (m :: * -> *) a.
MonadLabelledSTM m =>
[Char] -> a -> m (TVar m a)
newLabelledTVarIO [Char]
"sim-chain-nodes" []
  TVar m SimpleId
nextTxId <- [Char] -> SimpleId -> m (TVar m SimpleId)
forall (m :: * -> *) a.
MonadLabelledSTM m =>
[Char] -> a -> m (TVar m a)
newLabelledTVarIO [Char]
"sim-chain-next-txid" SimpleId
10000
  LocalChainState m SimpleTx
localChainState <- ChainStateHistory SimpleTx -> m (LocalChainState m SimpleTx)
forall (m :: * -> *) tx.
(IsChainState tx, MonadLabelledSTM m) =>
ChainStateHistory tx -> m (LocalChainState m tx)
newLocalChainState (ChainStateType SimpleTx -> ChainStateHistory SimpleTx
forall tx.
IsChainState tx =>
ChainStateType tx -> ChainStateHistory tx
initHistory ChainStateType SimpleTx
initialChainState)
  Async m ()
tickThread <- [Char] -> m () -> m (Async m ())
forall (m :: * -> *) a.
MonadAsync m =>
[Char] -> m a -> m (Async m a)
asyncLabelled [Char]
"sim-chain-tick" (m () -> m (Async m ())) -> m () -> m (Async m ())
forall a b. (a -> b) -> a -> b
$ TVar m [HydraNode SimpleTx m] -> LocalChainState m SimpleTx -> m ()
simulateTicks TVar m [HydraNode SimpleTx m]
nodes LocalChainState m SimpleTx
localChainState
  SimulatedChainNetwork SimpleTx m
-> m (SimulatedChainNetwork SimpleTx m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimulatedChainNetwork SimpleTx m
 -> m (SimulatedChainNetwork SimpleTx m))
-> SimulatedChainNetwork SimpleTx m
-> m (SimulatedChainNetwork SimpleTx m)
forall a b. (a -> b) -> a -> b
$
    SimulatedChainNetwork
      { $sel:connectNode:SimulatedChainNetwork :: DraftHydraNode SimpleTx m -> m (HydraNode SimpleTx m)
connectNode = \DraftHydraNode SimpleTx m
draftNode -> do
          let mockChain :: Chain SimpleTx m
mockChain =
                Chain
                  { $sel:postTx:Chain :: MonadThrow m => PostChainTx SimpleTx -> m ()
postTx = \PostChainTx SimpleTx
tx -> do
                      UTCTime
now <- m UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
                      -- Only observe "after one block"
                      m (Async m ()) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Async m ()) -> m ())
-> (m () -> m (Async m ())) -> m () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m () -> m (Async m ())
forall (m :: * -> *) a.
MonadAsync m =>
[Char] -> m a -> m (Async m a)
asyncLabelled [Char]
"sim-chain-post-tx" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
                        DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
blockTime
                        TVar m [HydraNode SimpleTx m]
-> TVar m [ChainEvent SimpleTx]
-> LocalChainState m SimpleTx
-> OnChainTx SimpleTx
-> m ()
createAndYieldEvent TVar m [HydraNode SimpleTx m]
nodes TVar m [ChainEvent SimpleTx]
history LocalChainState m SimpleTx
localChainState (OnChainTx SimpleTx -> m ()) -> OnChainTx SimpleTx -> m ()
forall a b. (a -> b) -> a -> b
$ UTCTime -> PostChainTx SimpleTx -> OnChainTx SimpleTx
forall tx. IsTx tx => UTCTime -> PostChainTx tx -> OnChainTx tx
toOnChainTx UTCTime
now PostChainTx SimpleTx
tx
                  , $sel:draftDepositTx:Chain :: MonadThrow m =>
HeadId
-> PParams LedgerEra
-> ConfirmedSnapshot SimpleTx
-> CommitBlueprintTx SimpleTx
-> UTCTime
-> Maybe AddressInEra
-> m (Either (PostTxError SimpleTx) SimpleTx)
draftDepositTx = \HeadId
_ -> Text
-> PParams ConwayEra
-> ConfirmedSnapshot SimpleTx
-> CommitBlueprintTx SimpleTx
-> UTCTime
-> Maybe AddressInEra
-> m (Either (PostTxError SimpleTx) SimpleTx)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"unexpected call to draftDepositTx"
                  , $sel:submitTx:Chain :: MonadThrow m => SimpleTx -> m ()
submitTx = \SimpleTx
_ -> Text -> m ()
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"unexpected call to submitTx"
                  , $sel:checkNonADAAssets:Chain :: ConfirmedSnapshot SimpleTx -> Either Value ()
checkNonADAAssets = \ConfirmedSnapshot SimpleTx
_ -> Text -> Either Value ()
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"unexpected call to checkNonADAAssets"
                  }
              mockNetwork :: Network m (Message SimpleTx)
mockNetwork = DraftHydraNode SimpleTx m
-> TVar m [HydraNode SimpleTx m] -> Network m (Message SimpleTx)
networkCallback DraftHydraNode SimpleTx m
draftNode TVar m [HydraNode SimpleTx m]
nodes
              mockServer :: Server tx m
              mockServer :: forall tx. Server tx m
mockServer = Server{$sel:sendMessage:Server :: ClientMessage tx -> m ()
sendMessage = m () -> ClientMessage tx -> m ()
forall a b. a -> b -> a
const (m () -> ClientMessage tx -> m ())
-> m () -> ClientMessage tx -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()}
          HydraNode SimpleTx m
node <- Chain SimpleTx m
-> Network m (Message SimpleTx)
-> Server SimpleTx m
-> DraftHydraNode SimpleTx m
-> m (HydraNode SimpleTx m)
forall (m :: * -> *) tx.
Monad m =>
Chain tx m
-> Network m (Message tx)
-> Server tx m
-> DraftHydraNode tx m
-> m (HydraNode tx m)
connect Chain SimpleTx m
mockChain Network m (Message SimpleTx)
mockNetwork Server SimpleTx m
forall tx. Server tx m
mockServer DraftHydraNode SimpleTx m
draftNode
          STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ TVar m [HydraNode SimpleTx m]
-> ([HydraNode SimpleTx m] -> [HydraNode SimpleTx m]) -> STM m ()
forall a. TVar m a -> (a -> a) -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
TVar m a -> (a -> a) -> STM m ()
modifyTVar TVar m [HydraNode SimpleTx m]
nodes (HydraNode SimpleTx m
node :)
          HydraNode SimpleTx m -> m (HydraNode SimpleTx m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HydraNode SimpleTx m
node
      , Async m ()
$sel:tickThread:SimulatedChainNetwork :: Async m ()
tickThread :: Async m ()
tickThread
      , $sel:rollbackAndForward:SimulatedChainNetwork :: TTL -> m ()
rollbackAndForward = TVar m [HydraNode SimpleTx m]
-> TVar m [ChainEvent SimpleTx]
-> LocalChainState m SimpleTx
-> TTL
-> m ()
forall tx.
IsChainState tx =>
TVar m [HydraNode tx m]
-> TVar m [ChainEvent tx] -> LocalChainState m tx -> TTL -> m ()
rollbackAndForward TVar m [HydraNode SimpleTx m]
nodes TVar m [ChainEvent SimpleTx]
history LocalChainState m SimpleTx
localChainState
      , $sel:simulateDeposit:SimulatedChainNetwork :: HeadId -> UTxOType SimpleTx -> UTCTime -> m (TxIdType SimpleTx)
simulateDeposit = \HeadId
headId UTxOType SimpleTx
toDeposit UTCTime
deadline -> do
          UTCTime
created <- m UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
          SimpleId
depositTxId <- STM m SimpleId -> m SimpleId
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m SimpleId -> m SimpleId) -> STM m SimpleId -> m SimpleId
forall a b. (a -> b) -> a -> b
$ TVar m SimpleId
-> (SimpleId -> (SimpleId, SimpleId)) -> STM m SimpleId
forall s a. TVar m s -> (s -> (a, s)) -> STM m a
forall (m :: * -> *) s a.
MonadSTM m =>
TVar m s -> (s -> (a, s)) -> STM m a
stateTVar TVar m SimpleId
nextTxId (\SimpleId
i -> (SimpleId
i, SimpleId
i SimpleId -> SimpleId -> SimpleId
forall a. Num a => a -> a -> a
+ SimpleId
1))
          TVar m [HydraNode SimpleTx m]
-> TVar m [ChainEvent SimpleTx]
-> LocalChainState m SimpleTx
-> OnChainTx SimpleTx
-> m ()
createAndYieldEvent TVar m [HydraNode SimpleTx m]
nodes TVar m [ChainEvent SimpleTx]
history LocalChainState m SimpleTx
localChainState (OnChainTx SimpleTx -> m ()) -> OnChainTx SimpleTx -> m ()
forall a b. (a -> b) -> a -> b
$
            OnDepositTx{HeadId
headId :: HeadId
$sel:headId:OnInitTx :: HeadId
headId, $sel:deposited:OnInitTx :: UTxOType SimpleTx
deposited = UTxOType SimpleTx
toDeposit, UTCTime
created :: UTCTime
$sel:created:OnInitTx :: UTCTime
created, UTCTime
deadline :: UTCTime
$sel:deadline:OnInitTx :: UTCTime
deadline, SimpleId
TxIdType SimpleTx
depositTxId :: SimpleId
$sel:depositTxId:OnInitTx :: TxIdType SimpleTx
depositTxId}
          SimpleId -> m SimpleId
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SimpleId
depositTxId
      , $sel:closeWithInitialSnapshot:SimulatedChainNetwork :: Party -> m ()
closeWithInitialSnapshot = Text -> Party -> m ()
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"unexpected call to closeWithInitialSnapshot"
      , $sel:getChainHistory:SimulatedChainNetwork :: m [ChainEvent SimpleTx]
getChainHistory = [ChainEvent SimpleTx] -> [ChainEvent SimpleTx]
forall a. [a] -> [a]
reverse ([ChainEvent SimpleTx] -> [ChainEvent SimpleTx])
-> m [ChainEvent SimpleTx] -> m [ChainEvent SimpleTx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar m [ChainEvent SimpleTx] -> m [ChainEvent SimpleTx]
forall a. TVar m a -> m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
readTVarIO TVar m [ChainEvent SimpleTx]
history
      }
 where
  -- seconds
  blockTime :: DiffTime
blockTime = DiffTime
20

  simulateTicks :: TVar m [HydraNode SimpleTx m] -> LocalChainState m SimpleTx -> m ()
simulateTicks TVar m [HydraNode SimpleTx m]
nodes LocalChainState m SimpleTx
localChainState = m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
blockTime
    UTCTime
now <- m UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
    ChainEvent SimpleTx
event <- STM m (ChainEvent SimpleTx) -> m (ChainEvent SimpleTx)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (ChainEvent SimpleTx) -> m (ChainEvent SimpleTx))
-> STM m (ChainEvent SimpleTx) -> m (ChainEvent SimpleTx)
forall a b. (a -> b) -> a -> b
$ do
      SimpleChainState
cs <- LocalChainState m SimpleTx -> STM m (ChainStateType SimpleTx)
forall (m :: * -> *) tx.
LocalChainState m tx -> STM m (ChainStateType tx)
getLatest LocalChainState m SimpleTx
localChainState
      -- XXX: This chain state (its point) does not correspond to 'now'
      ChainEvent SimpleTx -> STM m (ChainEvent SimpleTx)
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChainEvent SimpleTx -> STM m (ChainEvent SimpleTx))
-> ChainEvent SimpleTx -> STM m (ChainEvent SimpleTx)
forall a b. (a -> b) -> a -> b
$ UTCTime -> ChainPointType SimpleTx -> ChainEvent SimpleTx
forall tx. UTCTime -> ChainPointType tx -> ChainEvent tx
Tick UTCTime
now (ChainStateType SimpleTx -> ChainPointType SimpleTx
forall tx.
IsChainState tx =>
ChainStateType tx -> ChainPointType tx
chainStatePoint ChainStateType SimpleTx
SimpleChainState
cs)
    TVar m [HydraNode SimpleTx m] -> m [HydraNode SimpleTx m]
forall a. TVar m a -> m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
readTVarIO TVar m [HydraNode SimpleTx m]
nodes m [HydraNode SimpleTx m]
-> ([HydraNode SimpleTx m] -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (HydraNode SimpleTx m -> m ()) -> [HydraNode SimpleTx m] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (HydraNode SimpleTx m -> ChainEvent SimpleTx -> m ()
forall tx (m :: * -> *). HydraNode tx m -> ChainEvent tx -> m ()
`handleChainEvent` ChainEvent SimpleTx
event)

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

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

  recordAndYieldEvent ::
    TVar m [HydraNode tx m] ->
    TVar m [ChainEvent tx] ->
    ChainEvent tx ->
    m ()
  recordAndYieldEvent :: forall tx.
TVar m [HydraNode tx m]
-> TVar m [ChainEvent tx] -> ChainEvent tx -> m ()
recordAndYieldEvent TVar m [HydraNode tx m]
nodes TVar m [ChainEvent tx]
history ChainEvent tx
chainEvent = do
    [HydraNode tx m]
ns <- STM m [HydraNode tx m] -> m [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 [HydraNode tx m] -> m [HydraNode tx m])
-> STM m [HydraNode tx m] -> m [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 [HydraNode tx m] -> STM m [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 [HydraNode tx m]
nodes
    [HydraNode tx m] -> (HydraNode tx m -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [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 ->
      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
. [Char] -> m () -> m (Async m ())
forall (m :: * -> *) a.
MonadAsync m =>
[Char] -> m a -> m (Async m a)
asyncLabelled [Char]
"sim-chain-event" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
chainDelay
        HydraNode tx m -> ChainEvent tx -> m ()
forall tx (m :: * -> *). HydraNode tx m -> ChainEvent tx -> m ()
handleChainEvent HydraNode tx m
n ChainEvent tx
chainEvent

  rollbackAndForward ::
    IsChainState tx =>
    TVar m [HydraNode tx m] ->
    TVar m [ChainEvent tx] ->
    LocalChainState m tx ->
    Natural ->
    m ()
  rollbackAndForward :: forall tx.
IsChainState tx =>
TVar m [HydraNode tx m]
-> TVar m [ChainEvent tx] -> LocalChainState m tx -> TTL -> m ()
rollbackAndForward TVar m [HydraNode tx m]
nodes TVar m [ChainEvent tx]
history LocalChainState m tx
localChainState TTL
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 (TTL -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral TTL
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
-> (NonEmpty ChainSlot -> ChainSlot)
-> Maybe (NonEmpty ChainSlot)
-> ChainSlot
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (TTL -> ChainSlot
ChainSlot TTL
0) NonEmpty ChainSlot -> ChainSlot
forall a. NonEmpty a -> a
NE.head (Maybe (NonEmpty ChainSlot) -> ChainSlot)
-> Maybe (NonEmpty ChainSlot) -> ChainSlot
forall a b. (a -> b) -> a -> b
$
            [ChainSlot] -> Maybe (NonEmpty ChainSlot)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([ChainSlot] -> Maybe (NonEmpty ChainSlot))
-> [ChainSlot] -> Maybe (NonEmpty 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
    [HydraNode tx m]
ns <- 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
    UTCTime
chainTime <- m UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
    [HydraNode tx m] -> (HydraNode tx m -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [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{UTCTime
chainTime :: UTCTime
$sel:chainTime:Observation :: UTCTime
chainTime, 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 [HydraNode tx m]
-> TVar m [ChainEvent tx] -> ChainEvent tx -> m ()
forall tx.
TVar m [HydraNode tx m]
-> TVar m [ChainEvent tx] -> ChainEvent tx -> m ()
recordAndYieldEvent TVar m [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

-- | Delivers messages asynchronously after a
-- configurable delay. When the delay exceeds the chain's block time (20s),
-- on-chain events arrive at nodes before network echoes, reproducing
-- version-race conditions seen in production.
createMockNetworkWithDelay ::
  (MonadAsync m, MonadDelay m) =>
  DiffTime ->
  DraftHydraNode tx m ->
  TVar m [HydraNode tx m] ->
  Network m (Message tx)
createMockNetworkWithDelay :: forall (m :: * -> *) tx.
(MonadAsync m, MonadDelay m) =>
DiffTime
-> DraftHydraNode tx m
-> TVar m [HydraNode tx m]
-> Network m (Message tx)
createMockNetworkWithDelay DiffTime
networkDelay 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] -> (HydraNode tx m -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [HydraNode tx m]
allNodes ((HydraNode tx m -> m ()) -> m ())
-> (HydraNode tx m -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \HydraNode{InputQueue m (Input tx)
$sel:inputQueue:HydraNode :: forall tx (m :: * -> *). HydraNode tx m -> InputQueue m (Input tx)
inputQueue :: InputQueue m (Input tx)
inputQueue} ->
      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
networkDelay
        InputQueue m (Input tx) -> Input tx -> m ()
forall (m :: * -> *) e. InputQueue m e -> e -> m ()
enqueue InputQueue m (Input tx)
inputQueue (Input tx -> m ()) -> Input tx -> m ()
forall a b. (a -> b) -> a -> b
$ Party -> Message tx -> Input tx
forall tx. Party -> Message tx -> Input tx
mkNetworkInput Party
sender Message tx
msg

  DraftHydraNode{$sel:env:DraftHydraNode :: forall tx (m :: * -> *). DraftHydraNode tx m -> Environment
env = Environment{$sel:party:Environment :: Environment -> Party
party = Party
sender}} = 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}
  RecoverTx{HeadId
headId :: forall tx. PostChainTx tx -> HeadId
headId :: HeadId
headId, TxIdType tx
recoverTxId :: TxIdType tx
$sel:recoverTxId:InitTx :: forall tx. PostChainTx tx -> TxIdType tx
recoverTxId, UTxOType tx
recoverUTxO :: UTxOType tx
$sel:recoverUTxO:InitTx :: forall tx. PostChainTx tx -> UTxOType tx
recoverUTxO} ->
    OnRecoverTx{HeadId
$sel:headId:OnInitTx :: HeadId
headId :: HeadId
headId, $sel:recoveredTxId:OnInitTx :: TxIdType tx
recoveredTxId = TxIdType tx
recoverTxId, $sel:recoveredUTxO:OnInitTx :: UTxOType tx
recoveredUTxO = UTxOType tx
recoverUTxO}
  IncrementTx{HeadId
headId :: forall tx. PostChainTx tx -> HeadId
headId :: HeadId
headId, ConfirmedSnapshot tx
incrementingSnapshot :: ConfirmedSnapshot tx
$sel:incrementingSnapshot:InitTx :: forall tx. PostChainTx tx -> ConfirmedSnapshot tx
incrementingSnapshot, TxIdType tx
depositTxId :: TxIdType tx
$sel:depositTxId:InitTx :: forall tx. PostChainTx tx -> TxIdType tx
depositTxId} ->
    OnIncrementTx
      { HeadId
$sel:headId:OnInitTx :: HeadId
headId :: HeadId
headId
      , $sel:newVersion:OnInitTx :: SnapshotVersion
newVersion = SnapshotVersion
version SnapshotVersion -> SnapshotVersion -> SnapshotVersion
forall a. Num a => a -> a -> a
+ SnapshotVersion
1
      , TxIdType tx
$sel:depositTxId:OnInitTx :: TxIdType tx
depositTxId :: TxIdType tx
depositTxId
      }
   where
    Snapshot{SnapshotVersion
$sel:version:Snapshot :: forall tx. Snapshot tx -> SnapshotVersion
version :: SnapshotVersion
version} = ConfirmedSnapshot tx -> Snapshot tx
forall tx. IsTx tx => ConfirmedSnapshot tx -> Snapshot tx
getSnapshot ConfirmedSnapshot tx
incrementingSnapshot
  DecrementTx{HeadId
headId :: forall tx. PostChainTx tx -> HeadId
headId :: HeadId
headId, ConfirmedSnapshot tx
decrementingSnapshot :: ConfirmedSnapshot tx
$sel:decrementingSnapshot:InitTx :: forall tx. PostChainTx tx -> ConfirmedSnapshot tx
decrementingSnapshot} ->
    OnDecrementTx
      { HeadId
$sel:headId:OnInitTx :: HeadId
headId :: HeadId
headId
      , $sel:newVersion:OnInitTx :: SnapshotVersion
newVersion = SnapshotVersion
version SnapshotVersion -> SnapshotVersion -> SnapshotVersion
forall a. Num a => a -> a -> a
+ SnapshotVersion
1
      , $sel:distributedUTxO:OnInitTx :: UTxOType tx
distributedUTxO = UTxOType tx -> Maybe (UTxOType tx) -> UTxOType tx
forall a. a -> Maybe a -> a
fromMaybe UTxOType tx
forall a. Monoid a => a
mempty Maybe (UTxOType tx)
utxoToDecommit
      }
   where
    Snapshot{SnapshotVersion
$sel:version:Snapshot :: forall tx. Snapshot tx -> SnapshotVersion
version :: SnapshotVersion
version, Maybe (UTxOType tx)
$sel:utxoToDecommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToDecommit :: Maybe (UTxOType tx)
utxoToDecommit} = ConfirmedSnapshot tx -> Snapshot tx
forall tx. IsTx 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. IsTx tx => ConfirmedSnapshot tx -> Snapshot tx
getSnapshot ConfirmedSnapshot tx
closingSnapshot)
      , $sel:contestationDeadline:OnInitTx :: UTCTime
contestationDeadline = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (ContestationPeriod -> NominalDiffTime
CP.toNominalDiffTime ContestationPeriod
defaultContestationPeriod) UTCTime
now
      }
  ContestTx{HeadId
headId :: forall tx. PostChainTx tx -> HeadId
headId :: HeadId
headId, ConfirmedSnapshot tx
contestingSnapshot :: ConfirmedSnapshot tx
$sel:contestingSnapshot:InitTx :: forall tx. PostChainTx tx -> ConfirmedSnapshot tx
contestingSnapshot} ->
    OnContestTx
      { HeadId
$sel:headId:OnInitTx :: HeadId
headId :: HeadId
headId
      , $sel:snapshotNumber:OnInitTx :: SnapshotNumber
snapshotNumber = Snapshot tx -> SnapshotNumber
forall tx. Snapshot tx -> SnapshotNumber
number (ConfirmedSnapshot tx -> Snapshot tx
forall tx. IsTx tx => ConfirmedSnapshot tx -> Snapshot tx
getSnapshot ConfirmedSnapshot tx
contestingSnapshot)
      , $sel:contestationDeadline:OnInitTx :: UTCTime
contestationDeadline = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (ContestationPeriod -> NominalDiffTime
CP.toNominalDiffTime ContestationPeriod
defaultContestationPeriod) UTCTime
now
      }
  FanoutTx{UTxOType tx
utxo :: UTxOType tx
$sel:utxo:InitTx :: forall tx. PostChainTx tx -> UTxOType tx
utxo, Maybe (UTxOType tx)
utxoToCommit :: Maybe (UTxOType tx)
$sel:utxoToCommit:InitTx :: forall tx. PostChainTx tx -> Maybe (UTxOType tx)
utxoToCommit, Maybe (UTxOType tx)
utxoToDecommit :: Maybe (UTxOType tx)
$sel:utxoToDecommit:InitTx :: forall tx. PostChainTx tx -> Maybe (UTxOType tx)
utxoToDecommit} ->
    OnFanoutTx{$sel:headId:OnInitTx :: HeadId
headId = HeadId
testHeadId, $sel:fanoutUTxO:OnInitTx :: UTxOType tx
fanoutUTxO = UTxOType tx
utxo UTxOType tx -> UTxOType tx -> UTxOType tx
forall a. Semigroup a => a -> a -> a
<> UTxOType tx -> Maybe (UTxOType tx) -> UTxOType tx
forall a. a -> Maybe a -> a
fromMaybe UTxOType tx
forall a. Monoid a => a
mempty Maybe (UTxOType tx)
utxoToCommit UTxOType tx -> UTxOType tx -> UTxOType tx
forall a. Semigroup a => a -> a -> a
<> UTxOType tx -> Maybe (UTxOType tx) -> UTxOType tx
forall a. a -> Maybe a -> a
fromMaybe UTxOType tx
forall a. Monoid a => a
mempty Maybe (UTxOType tx)
utxoToDecommit}
  PartialFanoutTx{UTxOType tx
utxoToDistribute :: UTxOType tx
$sel:utxoToDistribute:InitTx :: forall tx. PostChainTx tx -> UTxOType tx
utxoToDistribute} ->
    OnPartialFanoutTx{$sel:headId:OnInitTx :: HeadId
headId = HeadId
testHeadId, $sel:distributedOutputs:OnInitTx :: UTxOType tx
distributedOutputs = UTxOType tx
utxoToDistribute}
  FinalPartialFanoutTx{UTxOType tx
$sel:utxoToDistribute:InitTx :: forall tx. PostChainTx tx -> UTxOType tx
utxoToDistribute :: UTxOType tx
utxoToDistribute} ->
    OnFanoutTx{$sel:headId:OnInitTx :: HeadId
headId = HeadId
testHeadId, $sel:fanoutUTxO:OnInitTx :: UTxOType tx
fanoutUTxO = UTxOType tx
utxoToDistribute}

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

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

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

withHydraNode' ::
  DepositPeriod ->
  Secret (SigningKey HydraKey) ->
  [Party] ->
  SimulatedChainNetwork SimpleTx (IOSim s) ->
  (TestHydraClient SimpleTx (IOSim s) -> IOSim s b) ->
  IOSim s b
withHydraNode' :: forall s b.
DepositPeriod
-> Secret (SigningKey HydraKey)
-> [Party]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> (TestHydraClient SimpleTx (IOSim s) -> IOSim s b)
-> IOSim s b
withHydraNode' DepositPeriod
dp Secret (SigningKey HydraKey)
signingKey [Party]
otherParties SimulatedChainNetwork SimpleTx (IOSim s)
chain TestHydraClient SimpleTx (IOSim s) -> IOSim s b
action = do
  TQueueDefault (IOSim s) (ServerOutput SimpleTx)
outputs <- [Char] -> IOSim s (TQueue (IOSim s) (ServerOutput SimpleTx))
forall (m :: * -> *) a.
MonadLabelledSTM m =>
[Char] -> m (TQueue m a)
newLabelledTQueueIO [Char]
"hydra-node-outputs"
  TQueueDefault (IOSim s) (ClientMessage SimpleTx)
messages <- [Char] -> IOSim s (TQueue (IOSim s) (ClientMessage SimpleTx))
forall (m :: * -> *) a.
MonadLabelledSTM m =>
[Char] -> m (TQueue m a)
newLabelledTQueueIO [Char]
"hydra-node-messages"
  TVar s [ServerOutput SimpleTx]
outputHistory <- [Char]
-> [ServerOutput SimpleTx]
-> IOSim s (TVar (IOSim s) [ServerOutput SimpleTx])
forall (m :: * -> *) a.
MonadLabelledSTM m =>
[Char] -> a -> m (TVar m a)
newLabelledTVarIO [Char]
"hydra-node-output-history" [ServerOutput SimpleTx]
forall a. Monoid a => a
mempty
  let initialChainState :: SimpleChainState
initialChainState = SimpleChainState{$sel:slot:SimpleChainState :: ChainSlot
slot = TTL -> ChainSlot
ChainSlot TTL
0}
  node :: HydraNode SimpleTx (IOSim s)
node@HydraNode{$sel:nodeStateHandler:HydraNode :: forall tx (m :: * -> *). HydraNode tx m -> NodeStateHandler tx m
nodeStateHandler = NodeStateHandler{STM (IOSim s) (NodeState SimpleTx)
$sel:queryNodeState:NodeStateHandler :: forall tx (m :: * -> *).
NodeStateHandler tx m -> STM m (NodeState tx)
queryNodeState :: STM (IOSim s) (NodeState SimpleTx)
queryNodeState}} <-
    Tracer (IOSim s) (HydraNodeLog SimpleTx)
-> Ledger SimpleTx
-> ChainStateType SimpleTx
-> Secret (SigningKey HydraKey)
-> [Party]
-> TQueue (IOSim s) (ServerOutput SimpleTx)
-> TQueue (IOSim s) (ClientMessage SimpleTx)
-> TVar (IOSim s) [ServerOutput SimpleTx]
-> SimulatedChainNetwork SimpleTx (IOSim s)
-> ContestationPeriod
-> DepositPeriod
-> IOSim s (HydraNode SimpleTx (IOSim s))
forall tx (m :: * -> *).
(IsChainState tx, MonadDelay m, MonadAsync m, MonadLabelledSTM m,
 MonadThrow m) =>
Tracer m (HydraNodeLog tx)
-> Ledger tx
-> ChainStateType tx
-> Secret (SigningKey HydraKey)
-> [Party]
-> TQueue m (ServerOutput tx)
-> TQueue m (ClientMessage tx)
-> TVar m [ServerOutput tx]
-> SimulatedChainNetwork tx m
-> ContestationPeriod
-> DepositPeriod
-> m (HydraNode tx m)
createHydraNode
      Tracer (IOSim s) (HydraNodeLog SimpleTx)
forall a s. Typeable a => Tracer (IOSim s) a
traceInIOSim
      Ledger SimpleTx
simpleLedger
      ChainStateType SimpleTx
SimpleChainState
initialChainState
      Secret (SigningKey HydraKey)
signingKey
      [Party]
otherParties
      TQueue (IOSim s) (ServerOutput SimpleTx)
TQueueDefault (IOSim s) (ServerOutput SimpleTx)
outputs
      TQueue (IOSim s) (ClientMessage SimpleTx)
TQueueDefault (IOSim s) (ClientMessage SimpleTx)
messages
      TVar (IOSim s) [ServerOutput SimpleTx]
TVar s [ServerOutput SimpleTx]
outputHistory
      SimulatedChainNetwork SimpleTx (IOSim s)
chain
      ContestationPeriod
defaultContestationPeriod
      DepositPeriod
dp
  ([Char], IOSim s ())
-> (Async (IOSim s) () -> IOSim s b) -> IOSim s b
forall (m :: * -> *) a b.
MonadAsync m =>
([Char], m a) -> (Async m a -> m b) -> m b
withAsyncLabelled ([Char]
"run-hydra-node", HydraNode SimpleTx (IOSim s) -> IOSim s ()
forall (m :: * -> *) tx.
(MonadCatch m, MonadAsync m, MonadTime m, IsChainState tx) =>
HydraNode tx m -> m ()
runHydraNode HydraNode SimpleTx (IOSim s)
node) ((Async (IOSim s) () -> IOSim s b) -> IOSim s b)
-> (Async (IOSim s) () -> IOSim s b) -> IOSim s b
forall a b. (a -> b) -> a -> b
$ \Async (IOSim s) ()
_ -> do
    -- await for the node to be in sync with the chain
    STM (IOSim s) () -> IOSim s ()
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) () -> IOSim s ()) -> STM (IOSim s) () -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ do
      NodeState SimpleTx
st <- STM (IOSim s) (NodeState SimpleTx)
STM s (NodeState SimpleTx)
queryNodeState
      case NodeState SimpleTx
st of
        NodeInSync{} -> () -> STM s ()
forall a. a -> STM s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        NodeState SimpleTx
_ -> STM (IOSim s) ()
STM s ()
forall a. STM (IOSim s) a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
    TestHydraClient SimpleTx (IOSim s) -> IOSim s b
action (TQueue (IOSim s) (ServerOutput SimpleTx)
-> TQueue (IOSim s) (ClientMessage SimpleTx)
-> TVar (IOSim s) [ServerOutput SimpleTx]
-> HydraNode SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s)
forall (m :: * -> *) tx.
MonadSTM m =>
TQueue m (ServerOutput tx)
-> TQueue m (ClientMessage tx)
-> TVar m [ServerOutput tx]
-> HydraNode tx m
-> TestHydraClient tx m
createTestHydraClient TQueue (IOSim s) (ServerOutput SimpleTx)
TQueueDefault (IOSim s) (ServerOutput SimpleTx)
outputs TQueue (IOSim s) (ClientMessage SimpleTx)
TQueueDefault (IOSim s) (ClientMessage SimpleTx)
messages TVar (IOSim s) [ServerOutput SimpleTx]
TVar s [ServerOutput SimpleTx]
outputHistory HydraNode SimpleTx (IOSim s)
node)

createTestHydraClient ::
  MonadSTM m =>
  TQueue m (ServerOutput tx) ->
  TQueue m (ClientMessage tx) ->
  TVar m [ServerOutput tx] ->
  HydraNode tx m ->
  TestHydraClient tx m
createTestHydraClient :: forall (m :: * -> *) tx.
MonadSTM m =>
TQueue m (ServerOutput tx)
-> TQueue m (ClientMessage tx)
-> TVar m [ServerOutput tx]
-> HydraNode tx m
-> TestHydraClient tx m
createTestHydraClient TQueue m (ServerOutput tx)
outputs TQueue m (ClientMessage tx)
messages TVar m [ServerOutput tx]
outputHistory HydraNode{InputQueue m (Input tx)
$sel:inputQueue:HydraNode :: forall tx (m :: * -> *). HydraNode tx m -> InputQueue m (Input tx)
inputQueue :: InputQueue m (Input tx)
inputQueue, NodeStateHandler tx m
$sel:nodeStateHandler:HydraNode :: forall tx (m :: * -> *). HydraNode tx m -> NodeStateHandler tx m
nodeStateHandler :: NodeStateHandler tx m
nodeStateHandler} =
  TestHydraClient
    { $sel:send:TestHydraClient :: ClientInput tx -> m ()
send = InputQueue m (Input tx) -> Input tx -> m ()
forall (m :: * -> *) e. InputQueue m e -> e -> m ()
enqueue InputQueue m (Input tx)
inputQueue (Input tx -> m ())
-> (ClientInput tx -> Input tx) -> ClientInput tx -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientInput tx -> Input tx
forall tx. ClientInput tx -> Input tx
ClientInput
    , $sel:waitForNext:TestHydraClient :: m (ServerOutput tx)
waitForNext = STM m (ServerOutput tx) -> m (ServerOutput tx)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (TQueue m (ServerOutput tx) -> STM m (ServerOutput tx)
forall a. TQueue m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TQueue m a -> STM m a
readTQueue TQueue m (ServerOutput tx)
outputs)
    , $sel:waitForNextMessage:TestHydraClient :: m (ClientMessage tx)
waitForNextMessage = STM m (ClientMessage tx) -> m (ClientMessage tx)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (TQueue m (ClientMessage tx) -> STM m (ClientMessage tx)
forall a. TQueue m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TQueue m a -> STM m a
readTQueue TQueue m (ClientMessage tx)
messages)
    , $sel:injectChainEvent:TestHydraClient :: ChainEvent tx -> m ()
injectChainEvent = InputQueue m (Input tx) -> Input tx -> m ()
forall (m :: * -> *) e. InputQueue m e -> e -> m ()
enqueue InputQueue m (Input tx)
inputQueue (Input tx -> m ())
-> (ChainEvent tx -> Input tx) -> ChainEvent tx -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainEvent tx -> Input tx
forall tx. ChainEvent tx -> Input tx
ChainInput
    , $sel:injectNetworkInput:TestHydraClient :: Party -> Message tx -> m ()
injectNetworkInput = \Party
sender Message tx
msg -> InputQueue m (Input tx) -> Input tx -> m ()
forall (m :: * -> *) e. InputQueue m e -> e -> m ()
enqueue InputQueue m (Input tx)
inputQueue (Party -> Message tx -> Input tx
forall tx. Party -> Message tx -> Input tx
mkNetworkInput Party
sender Message tx
msg)
    , $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 (NodeState tx)
queryState = STM m (NodeState tx) -> m (NodeState tx)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (NodeStateHandler tx m -> STM m (NodeState tx)
forall tx (m :: * -> *).
NodeStateHandler tx m -> STM m (NodeState tx)
queryNodeState NodeStateHandler tx m
nodeStateHandler)
    }

createHydraNode ::
  (IsChainState tx, MonadDelay m, MonadAsync m, MonadLabelledSTM m, MonadThrow m) =>
  Tracer m (HydraNodeLog tx) ->
  Ledger tx ->
  ChainStateType tx ->
  Secret (SigningKey HydraKey) ->
  [Party] ->
  TQueue m (ServerOutput tx) ->
  TQueue m (ClientMessage tx) ->
  TVar m [ServerOutput tx] ->
  SimulatedChainNetwork tx m ->
  ContestationPeriod ->
  DepositPeriod ->
  m (HydraNode tx m)
createHydraNode :: forall tx (m :: * -> *).
(IsChainState tx, MonadDelay m, MonadAsync m, MonadLabelledSTM m,
 MonadThrow m) =>
Tracer m (HydraNodeLog tx)
-> Ledger tx
-> ChainStateType tx
-> Secret (SigningKey HydraKey)
-> [Party]
-> TQueue m (ServerOutput tx)
-> TQueue m (ClientMessage tx)
-> TVar m [ServerOutput tx]
-> SimulatedChainNetwork tx m
-> ContestationPeriod
-> DepositPeriod
-> m (HydraNode tx m)
createHydraNode Tracer m (HydraNodeLog tx)
tracer Ledger tx
ledger ChainStateType tx
chainState Secret (SigningKey HydraKey)
signingKey [Party]
otherParties TQueue m (ServerOutput tx)
outputs TQueue m (ClientMessage tx)
messages TVar m [ServerOutput tx]
outputHistory SimulatedChainNetwork tx m
chain ContestationPeriod
cp DepositPeriod
dp = do
  EventStore{EventSource (StateEvent tx) m
eventSource :: EventSource (StateEvent tx) m
$sel:eventSource:EventStore :: forall e (m :: * -> *). EventStore e m -> EventSource e m
eventSource, EventSink (StateEvent tx) m
eventSink :: EventSink (StateEvent tx) m
$sel:eventSink:EventStore :: forall e (m :: * -> *). EventStore e m -> EventSink e m
eventSink} <- m (EventStore (StateEvent tx) m)
forall (m :: * -> *) a. MonadLabelledSTM m => m (EventStore a m)
createMockEventStore
  TVar m (Maybe (Snapshot tx))
seenSnapshotVar <- Maybe (Snapshot tx) -> m (TVar m (Maybe (Snapshot tx)))
forall a. a -> m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO Maybe (Snapshot tx)
forall a. Maybe a
Nothing
  let apiSink :: EventSink (StateEvent tx) m
apiSink =
        (HasEventId (StateEvent tx) => StateEvent tx -> m ())
-> EventSink (StateEvent tx) m
forall (m :: * -> *) e.
Monad m =>
(HasEventId e => e -> m ()) -> EventSink e m
mkEventSink
          ( \event :: StateEvent tx
event@StateEvent{StateChanged tx
stateChanged :: StateChanged tx
$sel:stateChanged:StateEvent :: forall tx. StateEvent tx -> StateChanged tx
stateChanged} -> do
              Maybe (Snapshot tx)
mSeenSnapshot <- TVar m (Maybe (Snapshot tx)) -> m (Maybe (Snapshot tx))
forall a. TVar m a -> m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
readTVarIO TVar m (Maybe (Snapshot tx))
seenSnapshotVar
              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 (Maybe (Snapshot tx)) -> Maybe (Snapshot 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 (Maybe (Snapshot tx))
seenSnapshotVar (Maybe (Snapshot tx) -> StateChanged tx -> Maybe (Snapshot tx)
forall tx.
Maybe (Snapshot tx) -> StateChanged tx -> Maybe (Snapshot tx)
updateSeenSnapshot Maybe (Snapshot tx)
mSeenSnapshot StateChanged tx
stateChanged)
              case Maybe (Snapshot tx)
-> StateEvent tx -> Maybe (TimedServerOutput tx)
forall tx.
IsChainState tx =>
Maybe (Snapshot tx)
-> StateEvent tx -> Maybe (TimedServerOutput tx)
mkTimedServerOutputFromStateEvent Maybe (Snapshot tx)
mSeenSnapshot StateEvent tx
event of
                Maybe (TimedServerOutput tx)
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                Just TimedServerOutput{ServerOutput tx
output :: ServerOutput tx
$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output} -> STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
                  TQueue m (ServerOutput tx) -> ServerOutput tx -> STM m ()
forall a. TQueue m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TQueue m a -> a -> STM m ()
writeTQueue TQueue m (ServerOutput tx)
outputs ServerOutput tx
output
                  TVar m [ServerOutput tx]
-> ([ServerOutput tx] -> [ServerOutput tx]) -> STM m ()
forall a. TVar m a -> (a -> a) -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
TVar m a -> (a -> a) -> STM m ()
modifyTVar' TVar m [ServerOutput tx]
outputHistory (ServerOutput tx
output :)
          )
  -- NOTE: Not using 'hydrate' as we don't want to run the event source conduit.
  let nodeState :: NodeState tx
nodeState = ChainStateType tx -> NodeState tx
forall tx. IsChainState tx => ChainStateType tx -> NodeState tx
initNodeState ChainStateType tx
chainState
  let chainStateHistory :: ChainStateHistory tx
chainStateHistory = ChainStateType tx -> ChainStateHistory tx
forall tx.
IsChainState tx =>
ChainStateType tx -> ChainStateHistory tx
initHistory ChainStateType tx
chainState
  NodeStateHandler tx m
nodeStateHandler <- Maybe Word64 -> NodeState tx -> m (NodeStateHandler tx m)
forall (m :: * -> *) tx.
MonadLabelledSTM m =>
Maybe Word64 -> NodeState tx -> m (NodeStateHandler tx m)
createNodeStateHandler Maybe Word64
forall a. Maybe a
Nothing NodeState tx
nodeState
  InputQueue m (Input tx)
inputQueue <- m (InputQueue m (Input tx))
forall (m :: * -> *) e.
(MonadDelay m, MonadAsync m, MonadLabelledSTM m) =>
m (InputQueue m e)
createInputQueue
  HydraNode tx m
node <-
    SimulatedChainNetwork tx m
-> DraftHydraNode tx m -> m (HydraNode tx m)
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> DraftHydraNode tx m -> m (HydraNode tx m)
connectNode
      SimulatedChainNetwork tx m
chain
      DraftHydraNode
        { Tracer m (HydraNodeLog tx)
tracer :: Tracer m (HydraNodeLog tx)
$sel:tracer:DraftHydraNode :: Tracer m (HydraNodeLog tx)
tracer
        , Environment
$sel:env:DraftHydraNode :: Environment
env :: Environment
env
        , Ledger tx
ledger :: Ledger tx
$sel:ledger:DraftHydraNode :: Ledger tx
ledger
        , NodeStateHandler tx m
nodeStateHandler :: NodeStateHandler tx m
$sel:nodeStateHandler:DraftHydraNode :: NodeStateHandler tx m
nodeStateHandler
        , InputQueue m (Input tx)
inputQueue :: InputQueue m (Input tx)
$sel:inputQueue:DraftHydraNode :: InputQueue m (Input tx)
inputQueue
        , EventSource (StateEvent tx) m
eventSource :: EventSource (StateEvent tx) m
$sel:eventSource:DraftHydraNode :: EventSource (StateEvent tx) m
eventSource
        , $sel:eventSinks:DraftHydraNode :: [EventSink (StateEvent tx) m]
eventSinks = [EventSink (StateEvent tx) m
apiSink, EventSink (StateEvent tx) m
eventSink]
        , ChainStateHistory tx
chainStateHistory :: ChainStateHistory tx
$sel:chainStateHistory:DraftHydraNode :: ChainStateHistory tx
chainStateHistory
        }
  HydraNode tx m -> m (HydraNode tx m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HydraNode tx m -> m (HydraNode tx m))
-> HydraNode tx m -> m (HydraNode tx m)
forall a b. (a -> b) -> a -> b
$
    HydraNode tx m
node
      { server =
          Server
            { sendMessage = atomically . writeTQueue messages
            }
      }
 where
  env :: Environment
env =
    Environment
      { Party
$sel:party:Environment :: Party
party :: Party
party
      , $sel:signingKey:Environment :: Secret (SigningKey HydraKey)
signingKey = Secret (SigningKey HydraKey)
signingKey
      , [Party]
otherParties :: [Party]
$sel:otherParties:Environment :: [Party]
otherParties
      , $sel:contestationPeriod:Environment :: ContestationPeriod
contestationPeriod = ContestationPeriod
cp
      , $sel:depositPeriod:Environment :: DepositPeriod
depositPeriod = DepositPeriod
dp
      , $sel:depositActivation:Environment :: DepositPeriod
depositActivation = DepositPeriod
dp
      , $sel:unsyncedPeriod:Environment :: UnsyncedPeriod
unsyncedPeriod = ContestationPeriod -> UnsyncedPeriod
defaultUnsyncedPeriodFor ContestationPeriod
cp
      , [OnChainId]
participants :: [OnChainId]
$sel:participants:Environment :: [OnChainId]
participants
      , $sel:configuredPeers:Environment :: Text
configuredPeers = Text
""
      }
  party :: Party
party = Secret (SigningKey HydraKey) -> Party
deriveParty Secret (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 ::
  TestHydraClient SimpleTx (IOSim s) ->
  IOSim s ()
openHead :: forall s. TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead 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,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsOpen{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:parties:NetworkConnected :: [Party]
parties = [Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice]}

openHead2 ::
  TestHydraClient SimpleTx (IOSim s) ->
  TestHydraClient SimpleTx (IOSim s) ->
  IOSim s ()
openHead2 :: forall s.
TestHydraClient SimpleTx (IOSim s)
-> TestHydraClient SimpleTx (IOSim s) -> IOSim s ()
openHead2 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,
 MonadLabelledSTM m, IsChainState tx) =>
[TestHydraClient tx m] -> ServerOutput tx -> m ()
waitUntil [TestHydraClient SimpleTx (IOSim s)
n1, TestHydraClient SimpleTx (IOSim s)
n2] (ServerOutput SimpleTx -> IOSim s ())
-> ServerOutput SimpleTx -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ HeadIsOpen{$sel:headId:NetworkConnected :: HeadId
headId = HeadId
testHeadId, $sel:parties:NetworkConnected :: [Party]
parties = [Item [Party]] -> [Party]
forall l. IsList l => [Item l] -> l
fromList [Item [Party]
Party
alice, Item [Party]
Party
bob]}

depositHead ::
  SimulatedChainNetwork SimpleTx (IOSim s) ->
  [TestHydraClient SimpleTx (IOSim s)] ->
  UTxOType SimpleTx ->
  IOSim s ()
depositHead :: forall s.
SimulatedChainNetwork SimpleTx (IOSim s)
-> [TestHydraClient SimpleTx (IOSim s)]
-> UTxOType SimpleTx
-> IOSim s ()
depositHead SimulatedChainNetwork SimpleTx (IOSim s)
chain [TestHydraClient SimpleTx (IOSim s)]
clients UTxOType SimpleTx
utxo = do
  UTCTime
deadline <- IOSim s UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
newDeadlineFarEnoughFromNow
  SimpleId
txid <- SimulatedChainNetwork SimpleTx (IOSim s)
-> HeadId
-> UTxOType SimpleTx
-> UTCTime
-> IOSim s (TxIdType SimpleTx)
forall tx (m :: * -> *).
SimulatedChainNetwork tx m
-> HeadId -> UTxOType tx -> UTCTime -> m (TxIdType tx)
simulateDeposit SimulatedChainNetwork SimpleTx (IOSim s)
chain HeadId
testHeadId UTxOType SimpleTx
utxo UTCTime
deadline
  [TestHydraClient SimpleTx (IOSim s)]
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall tx (m :: * -> *) a.
(Show (ServerOutput tx), HasCallStack, MonadThrow m, MonadAsync m,
 MonadTimer m, MonadLabelledSTM m, Eq a, Show a, IsChainState tx) =>
[TestHydraClient tx m] -> (ServerOutput tx -> Maybe a) -> m a
waitUntilMatch [TestHydraClient SimpleTx (IOSim s)]
clients ((ServerOutput SimpleTx -> Maybe ()) -> IOSim s ())
-> (ServerOutput SimpleTx -> Maybe ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ())
-> (ServerOutput SimpleTx -> Bool)
-> ServerOutput SimpleTx
-> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      CommitFinalized{TxIdType SimpleTx
$sel:depositTxId:NetworkConnected :: forall tx. ServerOutput tx -> TxIdType tx
depositTxId :: TxIdType SimpleTx
depositTxId} -> SimpleId
TxIdType SimpleTx
depositTxId SimpleId -> SimpleId -> Bool
forall a. Eq a => a -> a -> Bool
== SimpleId
txid
      ServerOutput SimpleTx
_ -> Bool
False

headIsClosed :: HeadId -> ServerOutput tx -> Bool
headIsClosed :: forall tx. HeadId -> ServerOutput tx -> Bool
headIsClosed HeadId
hid = \case
  HeadIsClosed{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId} -> HeadId
headId HeadId -> HeadId -> Bool
forall a. Eq a => a -> a -> Bool
== HeadId
hid
  ServerOutput 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
_ -> [Char] -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
[Char] -> m a
failure [Char]
"expected HeadIsClosed"

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

-- | Provide a quick and dirty way to label stuff from a signing key. Uses
-- the *verification* key (which is public) for the label, since 'Show' on a
-- 'SigningKey HydraKey' is forbidden by the type system.
shortLabel :: Secret (SigningKey HydraKey) -> String
shortLabel :: Secret (SigningKey HydraKey) -> [Char]
shortLabel Secret (SigningKey HydraKey)
s =
  Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
8 ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
2 ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ VerificationKey HydraKey -> [Char]
forall b a. (Show a, IsString b) => a -> b
show (Secret (SigningKey HydraKey) -> VerificationKey HydraKey
forall s k. HasVerificationKey s k => s -> VerificationKey k
getVerificationKey Secret (SigningKey HydraKey)
s)

-- | Get the head 'UTxO' from open 'HeadState'.
getHeadUTxO :: HeadState tx -> Maybe (UTxOType tx)
getHeadUTxO :: forall tx. HeadState tx -> Maybe (UTxOType tx)
getHeadUTxO = \case
  Open OpenState{$sel:coordinatedHeadState:OpenState :: forall tx. OpenState tx -> CoordinatedHeadState tx
coordinatedHeadState = CoordinatedHeadState{UTxOType tx
localUTxO :: UTxOType tx
$sel:localUTxO:CoordinatedHeadState :: forall tx. CoordinatedHeadState tx -> UTxOType tx
localUTxO}} -> UTxOType tx -> Maybe (UTxOType tx)
forall a. a -> Maybe a
Just UTxOType tx
localUTxO
  HeadState tx
_ -> Maybe (UTxOType tx)
forall a. Maybe a
Nothing

-- | Get the latest confirmed snapshot from an open node, failing if the node
-- is not in an open state.
getConfirmedSnapshotFromNode ::
  (HasCallStack, MonadThrow m) =>
  TestHydraClient tx m ->
  m (ConfirmedSnapshot tx)
getConfirmedSnapshotFromNode :: forall (m :: * -> *) tx.
(HasCallStack, MonadThrow m) =>
TestHydraClient tx m -> m (ConfirmedSnapshot tx)
getConfirmedSnapshotFromNode TestHydraClient tx m
node = do
  NodeState tx
st <- TestHydraClient tx m -> m (NodeState tx)
forall tx (m :: * -> *). TestHydraClient tx m -> m (NodeState tx)
queryState TestHydraClient tx m
node
  case NodeState tx -> HeadState tx
forall tx. NodeState tx -> HeadState tx
headState NodeState tx
st of
    Open OpenState{$sel:coordinatedHeadState:OpenState :: forall tx. OpenState tx -> CoordinatedHeadState tx
coordinatedHeadState = CoordinatedHeadState{ConfirmedSnapshot tx
confirmedSnapshot :: ConfirmedSnapshot tx
$sel:confirmedSnapshot:CoordinatedHeadState :: forall tx. CoordinatedHeadState tx -> ConfirmedSnapshot tx
confirmedSnapshot}} ->
      ConfirmedSnapshot tx -> m (ConfirmedSnapshot tx)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfirmedSnapshot tx
confirmedSnapshot
    HeadState tx
_ -> [Char] -> m (ConfirmedSnapshot tx)
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
[Char] -> m a
failure [Char]
"getConfirmedSnapshotFromNode: node is not in Open state"