{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE UndecidableInstances #-}

module Hydra.HeadLogic.Outcome where

import Hydra.Prelude

import Hydra.API.ServerOutput (DecommitInvalidReason, ServerOutput)
import Hydra.Chain (PostChainTx)
import Hydra.Chain.ChainState (ChainSlot, ChainStateType, IsChainState)
import Hydra.HeadLogic.Error (LogicError)
import Hydra.HeadLogic.State (HeadState)
import Hydra.Ledger (ValidationError)
import Hydra.Network.Message (Message)
import Hydra.Tx (
  HeadId,
  HeadParameters,
  HeadSeed,
  IsTx,
  Party,
  Snapshot,
  SnapshotNumber,
  SnapshotVersion,
  TxIdType,
  UTxOType,
  mkHeadParameters,
 )
import Hydra.Tx.Crypto (MultiSignature, Signature)
import Hydra.Tx.Environment (Environment (..))
import Hydra.Tx.IsTx (ArbitraryIsTx)
import Test.QuickCheck (oneof)
import Test.QuickCheck.Arbitrary.ADT (ToADTArbitrary)

-- | Analogous to inputs, the pure head logic "core" can have effects emited to
-- the "shell" layers and we distinguish the same: effects onto the client, the
-- network and the chain.
data Effect tx
  = -- | Effect to be handled by the "Hydra.API", results in sending this 'ServerOutput'.
    ClientEffect {forall tx. Effect tx -> ServerOutput tx
serverOutput :: ServerOutput tx}
  | -- | Effect to be handled by a "Hydra.Network", results in a 'Hydra.Network.broadcast'.
    NetworkEffect {forall tx. Effect tx -> Message tx
message :: Message tx}
  | -- | Effect to be handled by a "Hydra.Chain", results in a 'Hydra.Chain.postTx'.
    OnChainEffect {forall tx. Effect tx -> PostChainTx tx
postChainTx :: PostChainTx tx}
  deriving stock ((forall x. Effect tx -> Rep (Effect tx) x)
-> (forall x. Rep (Effect tx) x -> Effect tx)
-> Generic (Effect tx)
forall x. Rep (Effect tx) x -> Effect tx
forall x. Effect tx -> Rep (Effect tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x. Rep (Effect tx) x -> Effect tx
forall tx x. Effect tx -> Rep (Effect tx) x
$cfrom :: forall tx x. Effect tx -> Rep (Effect tx) x
from :: forall x. Effect tx -> Rep (Effect tx) x
$cto :: forall tx x. Rep (Effect tx) x -> Effect tx
to :: forall x. Rep (Effect tx) x -> Effect tx
Generic)

deriving stock instance IsChainState tx => Eq (Effect tx)
deriving stock instance IsChainState tx => Show (Effect tx)
deriving anyclass instance IsChainState tx => ToJSON (Effect tx)
deriving anyclass instance IsChainState tx => FromJSON (Effect tx)

instance (ArbitraryIsTx tx, IsChainState tx) => Arbitrary (Effect tx) where
  arbitrary :: Gen (Effect tx)
arbitrary = Gen (Effect tx)
forall a.
(Generic a, GA UnsizedOpts (Rep a),
 UniformWeight (Weights_ (Rep a))) =>
Gen a
genericArbitrary

-- | Head state changed event. These events represent all the internal state
-- changes, get persisted and processed in an event sourcing manner.
data StateChanged tx
  = HeadInitialized
      { forall tx. StateChanged tx -> HeadParameters
parameters :: HeadParameters
      , forall tx. StateChanged tx -> ChainStateType tx
chainState :: ChainStateType tx
      , forall tx. StateChanged tx -> HeadId
headId :: HeadId
      , forall tx. StateChanged tx -> HeadSeed
headSeed :: HeadSeed
      }
  | CommittedUTxO
      { forall tx. StateChanged tx -> Party
party :: Party
      , forall tx. StateChanged tx -> UTxOType tx
committedUTxO :: UTxOType tx
      , chainState :: ChainStateType tx
      }
  | HeadAborted {chainState :: ChainStateType tx}
  | HeadOpened {chainState :: ChainStateType tx, forall tx. StateChanged tx -> UTxOType tx
initialUTxO :: UTxOType tx}
  | TransactionReceived {forall tx. StateChanged tx -> tx
tx :: tx}
  | TransactionAppliedToLocalUTxO
      { tx :: tx
      , forall tx. StateChanged tx -> UTxOType tx
newLocalUTxO :: UTxOType tx
      }
  | CommitRecorded {forall tx. StateChanged tx -> Map (TxIdType tx) (UTxOType tx)
pendingDeposits :: Map (TxIdType tx) (UTxOType tx), newLocalUTxO :: UTxOType tx}
  | CommitRecovered {forall tx. StateChanged tx -> UTxOType tx
recoveredUTxO :: UTxOType tx, newLocalUTxO :: UTxOType tx, forall tx. StateChanged tx -> TxIdType tx
recoveredTxId :: TxIdType tx}
  | DecommitRecorded {forall tx. StateChanged tx -> tx
decommitTx :: tx, newLocalUTxO :: UTxOType tx}
  | SnapshotRequestDecided {forall tx. StateChanged tx -> SnapshotNumber
snapshotNumber :: SnapshotNumber}
  | -- | A snapshot was requested by some party.
    -- NOTE: We deliberately already include an updated local ledger state to
    -- not need a ledger to interpret this event.
    SnapshotRequested
      { forall tx. StateChanged tx -> Snapshot tx
snapshot :: Snapshot tx
      , forall tx. StateChanged tx -> [TxIdType tx]
requestedTxIds :: [TxIdType tx]
      , newLocalUTxO :: UTxOType tx
      , forall tx. StateChanged tx -> [tx]
newLocalTxs :: [tx]
      }
  | CommitFinalized {forall tx. StateChanged tx -> SnapshotVersion
newVersion :: SnapshotVersion, forall tx. StateChanged tx -> TxIdType tx
depositTxId :: TxIdType tx}
  | DecommitFinalized {newVersion :: SnapshotVersion}
  | PartySignedSnapshot {snapshot :: Snapshot tx, party :: Party, forall tx. StateChanged tx -> Signature (Snapshot tx)
signature :: Signature (Snapshot tx)}
  | SnapshotConfirmed {snapshot :: Snapshot tx, forall tx. StateChanged tx -> MultiSignature (Snapshot tx)
signatures :: MultiSignature (Snapshot tx)}
  | HeadClosed {chainState :: ChainStateType tx, forall tx. StateChanged tx -> UTCTime
contestationDeadline :: UTCTime}
  | HeadContested {chainState :: ChainStateType tx, contestationDeadline :: UTCTime}
  | HeadIsReadyToFanout
  | HeadFannedOut {chainState :: ChainStateType tx}
  | ChainRolledBack {chainState :: ChainStateType tx}
  | TickObserved {forall tx. StateChanged tx -> ChainSlot
chainSlot :: ChainSlot}
  deriving stock ((forall x. StateChanged tx -> Rep (StateChanged tx) x)
-> (forall x. Rep (StateChanged tx) x -> StateChanged tx)
-> Generic (StateChanged tx)
forall x. Rep (StateChanged tx) x -> StateChanged tx
forall x. StateChanged tx -> Rep (StateChanged tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x. Rep (StateChanged tx) x -> StateChanged tx
forall tx x. StateChanged tx -> Rep (StateChanged tx) x
$cfrom :: forall tx x. StateChanged tx -> Rep (StateChanged tx) x
from :: forall x. StateChanged tx -> Rep (StateChanged tx) x
$cto :: forall tx x. Rep (StateChanged tx) x -> StateChanged tx
to :: forall x. Rep (StateChanged tx) x -> StateChanged tx
Generic)

deriving stock instance (IsTx tx, Eq (HeadState tx), Eq (ChainStateType tx)) => Eq (StateChanged tx)
deriving stock instance (IsTx tx, Show (HeadState tx), Show (ChainStateType tx)) => Show (StateChanged tx)
deriving anyclass instance (IsTx tx, ToJSON (ChainStateType tx)) => ToJSON (StateChanged tx)
deriving anyclass instance (IsTx tx, FromJSON (HeadState tx), FromJSON (ChainStateType tx)) => FromJSON (StateChanged tx)

instance (ArbitraryIsTx tx, IsChainState tx) => Arbitrary (StateChanged tx) where
  arbitrary :: Gen (StateChanged tx)
arbitrary = Gen Environment
forall a. Arbitrary a => Gen a
arbitrary Gen Environment
-> (Environment -> Gen (StateChanged tx)) -> Gen (StateChanged tx)
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Environment -> Gen (StateChanged tx)
forall tx.
(ArbitraryIsTx tx, IsChainState tx) =>
Environment -> Gen (StateChanged tx)
genStateChanged

instance (ArbitraryIsTx tx, IsChainState tx) => ToADTArbitrary (StateChanged tx)

genStateChanged :: (ArbitraryIsTx tx, IsChainState tx) => Environment -> Gen (StateChanged tx)
genStateChanged :: forall tx.
(ArbitraryIsTx tx, IsChainState tx) =>
Environment -> Gen (StateChanged tx)
genStateChanged Environment
env =
  [Gen (StateChanged tx)] -> Gen (StateChanged tx)
forall a. HasCallStack => [Gen a] -> Gen a
oneof
    [ HeadParameters
-> ChainStateType tx -> HeadId -> HeadSeed -> StateChanged tx
forall tx.
HeadParameters
-> ChainStateType tx -> HeadId -> HeadSeed -> StateChanged tx
HeadInitialized (Environment -> HeadParameters
mkHeadParameters Environment
env) (ChainStateType tx -> HeadId -> HeadSeed -> StateChanged tx)
-> Gen (ChainStateType tx)
-> Gen (HeadId -> HeadSeed -> StateChanged tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ChainStateType tx)
forall a. Arbitrary a => Gen a
arbitrary Gen (HeadId -> HeadSeed -> StateChanged tx)
-> Gen HeadId -> Gen (HeadSeed -> StateChanged tx)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen HeadId
forall a. Arbitrary a => Gen a
arbitrary Gen (HeadSeed -> StateChanged tx)
-> Gen HeadSeed -> Gen (StateChanged tx)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen HeadSeed
forall a. Arbitrary a => Gen a
arbitrary
    , Party -> UTxOType tx -> ChainStateType tx -> StateChanged tx
forall tx.
Party -> UTxOType tx -> ChainStateType tx -> StateChanged tx
CommittedUTxO Party
party (UTxOType tx -> ChainStateType tx -> StateChanged tx)
-> Gen (UTxOType tx) -> Gen (ChainStateType tx -> StateChanged tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (UTxOType tx)
forall a. Arbitrary a => Gen a
arbitrary Gen (ChainStateType tx -> StateChanged tx)
-> Gen (ChainStateType tx) -> Gen (StateChanged tx)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (ChainStateType tx)
forall a. Arbitrary a => Gen a
arbitrary
    , ChainStateType tx -> StateChanged tx
forall tx. ChainStateType tx -> StateChanged tx
HeadAborted (ChainStateType tx -> StateChanged tx)
-> Gen (ChainStateType tx) -> Gen (StateChanged tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ChainStateType tx)
forall a. Arbitrary a => Gen a
arbitrary
    , ChainStateType tx -> UTxOType tx -> StateChanged tx
forall tx. ChainStateType tx -> UTxOType tx -> StateChanged tx
HeadOpened (ChainStateType tx -> UTxOType tx -> StateChanged tx)
-> Gen (ChainStateType tx) -> Gen (UTxOType tx -> StateChanged tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ChainStateType tx)
forall a. Arbitrary a => Gen a
arbitrary Gen (UTxOType tx -> StateChanged tx)
-> Gen (UTxOType tx) -> Gen (StateChanged tx)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (UTxOType tx)
forall a. Arbitrary a => Gen a
arbitrary
    , tx -> StateChanged tx
forall tx. tx -> StateChanged tx
TransactionReceived (tx -> StateChanged tx) -> Gen tx -> Gen (StateChanged tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen tx
forall a. Arbitrary a => Gen a
arbitrary
    , tx -> UTxOType tx -> StateChanged tx
forall tx. tx -> UTxOType tx -> StateChanged tx
TransactionAppliedToLocalUTxO (tx -> UTxOType tx -> StateChanged tx)
-> Gen tx -> Gen (UTxOType tx -> StateChanged tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen tx
forall a. Arbitrary a => Gen a
arbitrary Gen (UTxOType tx -> StateChanged tx)
-> Gen (UTxOType tx) -> Gen (StateChanged tx)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (UTxOType tx)
forall a. Arbitrary a => Gen a
arbitrary
    , tx -> UTxOType tx -> StateChanged tx
forall tx. tx -> UTxOType tx -> StateChanged tx
DecommitRecorded (tx -> UTxOType tx -> StateChanged tx)
-> Gen tx -> Gen (UTxOType tx -> StateChanged tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen tx
forall a. Arbitrary a => Gen a
arbitrary Gen (UTxOType tx -> StateChanged tx)
-> Gen (UTxOType tx) -> Gen (StateChanged tx)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (UTxOType tx)
forall a. Arbitrary a => Gen a
arbitrary
    , SnapshotNumber -> StateChanged tx
forall tx. SnapshotNumber -> StateChanged tx
SnapshotRequestDecided (SnapshotNumber -> StateChanged tx)
-> Gen SnapshotNumber -> Gen (StateChanged tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SnapshotNumber
forall a. Arbitrary a => Gen a
arbitrary
    , Snapshot tx
-> [TxIdType tx] -> UTxOType tx -> [tx] -> StateChanged tx
forall tx.
Snapshot tx
-> [TxIdType tx] -> UTxOType tx -> [tx] -> StateChanged tx
SnapshotRequested (Snapshot tx
 -> [TxIdType tx] -> UTxOType tx -> [tx] -> StateChanged tx)
-> Gen (Snapshot tx)
-> Gen ([TxIdType tx] -> UTxOType tx -> [tx] -> StateChanged tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Snapshot tx)
forall a. Arbitrary a => Gen a
arbitrary Gen ([TxIdType tx] -> UTxOType tx -> [tx] -> StateChanged tx)
-> Gen [TxIdType tx]
-> Gen (UTxOType tx -> [tx] -> StateChanged tx)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [TxIdType tx]
forall a. Arbitrary a => Gen a
arbitrary Gen (UTxOType tx -> [tx] -> StateChanged tx)
-> Gen (UTxOType tx) -> Gen ([tx] -> StateChanged tx)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (UTxOType tx)
forall a. Arbitrary a => Gen a
arbitrary Gen ([tx] -> StateChanged tx) -> Gen [tx] -> Gen (StateChanged tx)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [tx]
forall a. Arbitrary a => Gen a
arbitrary
    , Snapshot tx -> Party -> Signature (Snapshot tx) -> StateChanged tx
forall tx.
Snapshot tx -> Party -> Signature (Snapshot tx) -> StateChanged tx
PartySignedSnapshot (Snapshot tx
 -> Party -> Signature (Snapshot tx) -> StateChanged tx)
-> Gen (Snapshot tx)
-> Gen (Party -> Signature (Snapshot tx) -> StateChanged tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Snapshot tx)
forall a. Arbitrary a => Gen a
arbitrary Gen (Party -> Signature (Snapshot tx) -> StateChanged tx)
-> Gen Party -> Gen (Signature (Snapshot tx) -> StateChanged tx)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Party
forall a. Arbitrary a => Gen a
arbitrary Gen (Signature (Snapshot tx) -> StateChanged tx)
-> Gen (Signature (Snapshot tx)) -> Gen (StateChanged tx)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Signature (Snapshot tx))
forall a. Arbitrary a => Gen a
arbitrary
    , Snapshot tx -> MultiSignature (Snapshot tx) -> StateChanged tx
forall tx.
Snapshot tx -> MultiSignature (Snapshot tx) -> StateChanged tx
SnapshotConfirmed (Snapshot tx -> MultiSignature (Snapshot tx) -> StateChanged tx)
-> Gen (Snapshot tx)
-> Gen (MultiSignature (Snapshot tx) -> StateChanged tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Snapshot tx)
forall a. Arbitrary a => Gen a
arbitrary Gen (MultiSignature (Snapshot tx) -> StateChanged tx)
-> Gen (MultiSignature (Snapshot tx)) -> Gen (StateChanged tx)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (MultiSignature (Snapshot tx))
forall a. Arbitrary a => Gen a
arbitrary
    , SnapshotVersion -> StateChanged tx
forall tx. SnapshotVersion -> StateChanged tx
DecommitFinalized (SnapshotVersion -> StateChanged tx)
-> Gen SnapshotVersion -> Gen (StateChanged tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SnapshotVersion
forall a. Arbitrary a => Gen a
arbitrary
    , ChainStateType tx -> UTCTime -> StateChanged tx
forall tx. ChainStateType tx -> UTCTime -> StateChanged tx
HeadClosed (ChainStateType tx -> UTCTime -> StateChanged tx)
-> Gen (ChainStateType tx) -> Gen (UTCTime -> StateChanged tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ChainStateType tx)
forall a. Arbitrary a => Gen a
arbitrary Gen (UTCTime -> StateChanged tx)
-> Gen UTCTime -> Gen (StateChanged tx)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen UTCTime
forall a. Arbitrary a => Gen a
arbitrary
    , ChainStateType tx -> UTCTime -> StateChanged tx
forall tx. ChainStateType tx -> UTCTime -> StateChanged tx
HeadContested (ChainStateType tx -> UTCTime -> StateChanged tx)
-> Gen (ChainStateType tx) -> Gen (UTCTime -> StateChanged tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ChainStateType tx)
forall a. Arbitrary a => Gen a
arbitrary Gen (UTCTime -> StateChanged tx)
-> Gen UTCTime -> Gen (StateChanged tx)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen UTCTime
forall a. Arbitrary a => Gen a
arbitrary
    , StateChanged tx -> Gen (StateChanged tx)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StateChanged tx
forall tx. StateChanged tx
HeadIsReadyToFanout
    , ChainStateType tx -> StateChanged tx
forall tx. ChainStateType tx -> StateChanged tx
HeadFannedOut (ChainStateType tx -> StateChanged tx)
-> Gen (ChainStateType tx) -> Gen (StateChanged tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ChainStateType tx)
forall a. Arbitrary a => Gen a
arbitrary
    , ChainStateType tx -> StateChanged tx
forall tx. ChainStateType tx -> StateChanged tx
ChainRolledBack (ChainStateType tx -> StateChanged tx)
-> Gen (ChainStateType tx) -> Gen (StateChanged tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ChainStateType tx)
forall a. Arbitrary a => Gen a
arbitrary
    , ChainSlot -> StateChanged tx
forall tx. ChainSlot -> StateChanged tx
TickObserved (ChainSlot -> StateChanged tx)
-> Gen ChainSlot -> Gen (StateChanged tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ChainSlot
forall a. Arbitrary a => Gen a
arbitrary
    ]
 where
  Environment{Party
party :: Party
$sel:party:Environment :: Environment -> Party
party} = Environment
env

data Outcome tx
  = -- | Continue with the given state updates and side effects.
    Continue {forall tx. Outcome tx -> [StateChanged tx]
stateChanges :: [StateChanged tx], forall tx. Outcome tx -> [Effect tx]
effects :: [Effect tx]}
  | -- | Wait for some condition to be met with optional state updates.
    Wait {forall tx. Outcome tx -> WaitReason tx
reason :: WaitReason tx, stateChanges :: [StateChanged tx]}
  | -- | Processing resulted in an error.
    Error {forall tx. Outcome tx -> LogicError tx
error :: LogicError tx}
  deriving stock ((forall x. Outcome tx -> Rep (Outcome tx) x)
-> (forall x. Rep (Outcome tx) x -> Outcome tx)
-> Generic (Outcome tx)
forall x. Rep (Outcome tx) x -> Outcome tx
forall x. Outcome tx -> Rep (Outcome tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x. Rep (Outcome tx) x -> Outcome tx
forall tx x. Outcome tx -> Rep (Outcome tx) x
$cfrom :: forall tx x. Outcome tx -> Rep (Outcome tx) x
from :: forall x. Outcome tx -> Rep (Outcome tx) x
$cto :: forall tx x. Rep (Outcome tx) x -> Outcome tx
to :: forall x. Rep (Outcome tx) x -> Outcome tx
Generic)

instance Semigroup (Outcome tx) where
  e :: Outcome tx
e@Error{} <> :: Outcome tx -> Outcome tx -> Outcome tx
<> Outcome tx
_ = Outcome tx
e
  Outcome tx
_ <> e :: Outcome tx
e@Error{} = Outcome tx
e
  Continue [StateChanged tx]
scA [Effect tx]
_ <> Wait WaitReason tx
r [StateChanged tx]
scB = WaitReason tx -> [StateChanged tx] -> Outcome tx
forall tx. WaitReason tx -> [StateChanged tx] -> Outcome tx
Wait WaitReason tx
r ([StateChanged tx]
scA [StateChanged tx] -> [StateChanged tx] -> [StateChanged tx]
forall a. Semigroup a => a -> a -> a
<> [StateChanged tx]
scB)
  Wait WaitReason tx
r [StateChanged tx]
scA <> Outcome tx
_ = WaitReason tx -> [StateChanged tx] -> Outcome tx
forall tx. WaitReason tx -> [StateChanged tx] -> Outcome tx
Wait WaitReason tx
r [StateChanged tx]
scA
  Continue [StateChanged tx]
scA [Effect tx]
efA <> Continue [StateChanged tx]
scB [Effect tx]
efB = [StateChanged tx] -> [Effect tx] -> Outcome tx
forall tx. [StateChanged tx] -> [Effect tx] -> Outcome tx
Continue ([StateChanged tx]
scA [StateChanged tx] -> [StateChanged tx] -> [StateChanged tx]
forall a. Semigroup a => a -> a -> a
<> [StateChanged tx]
scB) ([Effect tx]
efA [Effect tx] -> [Effect tx] -> [Effect tx]
forall a. Semigroup a => a -> a -> a
<> [Effect tx]
efB)

deriving stock instance IsChainState tx => Eq (Outcome tx)
deriving stock instance IsChainState tx => Show (Outcome tx)
deriving anyclass instance IsChainState tx => ToJSON (Outcome tx)
deriving anyclass instance IsChainState tx => FromJSON (Outcome tx)

instance (ArbitraryIsTx tx, IsChainState tx) => Arbitrary (Outcome tx) where
  arbitrary :: Gen (Outcome tx)
arbitrary = Gen (Outcome tx)
forall a.
(Generic a, GA UnsizedOpts (Rep a),
 UniformWeight (Weights_ (Rep a))) =>
Gen a
genericArbitrary
  shrink :: Outcome tx -> [Outcome tx]
shrink = Outcome tx -> [Outcome tx]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

noop :: Outcome tx
noop :: forall tx. Outcome tx
noop = [StateChanged tx] -> [Effect tx] -> Outcome tx
forall tx. [StateChanged tx] -> [Effect tx] -> Outcome tx
Continue [] []

wait :: WaitReason tx -> Outcome tx
wait :: forall tx. WaitReason tx -> Outcome tx
wait WaitReason tx
reason = WaitReason tx -> [StateChanged tx] -> Outcome tx
forall tx. WaitReason tx -> [StateChanged tx] -> Outcome tx
Wait WaitReason tx
reason []

newState :: StateChanged tx -> Outcome tx
newState :: forall tx. StateChanged tx -> Outcome tx
newState StateChanged tx
change = [StateChanged tx] -> [Effect tx] -> Outcome tx
forall tx. [StateChanged tx] -> [Effect tx] -> Outcome tx
Continue [StateChanged tx
change] []

cause :: Effect tx -> Outcome tx
cause :: forall tx. Effect tx -> Outcome tx
cause Effect tx
e = [StateChanged tx] -> [Effect tx] -> Outcome tx
forall tx. [StateChanged tx] -> [Effect tx] -> Outcome tx
Continue [] [Effect tx
e]

causes :: [Effect tx] -> Outcome tx
causes :: forall tx. [Effect tx] -> Outcome tx
causes = [StateChanged tx] -> [Effect tx] -> Outcome tx
forall tx. [StateChanged tx] -> [Effect tx] -> Outcome tx
Continue []

data WaitReason tx
  = WaitOnNotApplicableTx {forall tx. WaitReason tx -> ValidationError
validationError :: ValidationError}
  | WaitOnSnapshotNumber {forall tx. WaitReason tx -> SnapshotNumber
waitingForNumber :: SnapshotNumber}
  | WaitOnSnapshotVersion {forall tx. WaitReason tx -> SnapshotVersion
waitingForVersion :: SnapshotVersion}
  | WaitOnSeenSnapshot
  | WaitOnTxs {forall tx. WaitReason tx -> [TxIdType tx]
waitingForTxIds :: [TxIdType tx]}
  | WaitOnContestationDeadline
  | WaitOnNotApplicableDecommitTx {forall tx. WaitReason tx -> DecommitInvalidReason tx
notApplicableReason :: DecommitInvalidReason tx}
  | WaitOnUnresolvedCommit {forall tx. WaitReason tx -> UTxOType tx
commitUTxO :: UTxOType tx}
  | WaitOnUnresolvedDecommit {forall tx. WaitReason tx -> tx
decommitTx :: tx}
  deriving stock ((forall x. WaitReason tx -> Rep (WaitReason tx) x)
-> (forall x. Rep (WaitReason tx) x -> WaitReason tx)
-> Generic (WaitReason tx)
forall x. Rep (WaitReason tx) x -> WaitReason tx
forall x. WaitReason tx -> Rep (WaitReason tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x. Rep (WaitReason tx) x -> WaitReason tx
forall tx x. WaitReason tx -> Rep (WaitReason tx) x
$cfrom :: forall tx x. WaitReason tx -> Rep (WaitReason tx) x
from :: forall x. WaitReason tx -> Rep (WaitReason tx) x
$cto :: forall tx x. Rep (WaitReason tx) x -> WaitReason tx
to :: forall x. Rep (WaitReason tx) x -> WaitReason tx
Generic)

deriving stock instance IsTx tx => Eq (WaitReason tx)
deriving stock instance IsTx tx => Show (WaitReason tx)
deriving anyclass instance IsTx tx => ToJSON (WaitReason tx)
deriving anyclass instance IsTx tx => FromJSON (WaitReason tx)

instance ArbitraryIsTx tx => Arbitrary (WaitReason tx) where
  arbitrary :: Gen (WaitReason tx)
arbitrary = Gen (WaitReason tx)
forall a.
(Generic a, GA UnsizedOpts (Rep a),
 UniformWeight (Weights_ (Rep a))) =>
Gen a
genericArbitrary