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

module Hydra.API.ServerOutput where

import Control.Lens ((.~))
import Data.Aeson (Value (..), defaultOptions, encode, genericParseJSON, genericToJSON, omitNothingFields, tagSingleConstructors, withObject, (.:))
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Aeson.Lens (atKey, key)
import Data.ByteString.Lazy qualified as LBS
import Hydra.API.ClientInput (ClientInput)
import Hydra.Chain (PostChainTx, PostTxError)
import Hydra.Chain.ChainState (IsChainState)
import Hydra.HeadLogic.State (ClosedState (..), HeadState (..), InitialState (..), OpenState (..), SeenSnapshot (..))
import Hydra.HeadLogic.State qualified as HeadState
import Hydra.Ledger (ValidationError)
import Hydra.Network (Host, ProtocolVersion)
import Hydra.Prelude hiding (seq)
import Hydra.Tx (HeadId, Party, Snapshot, SnapshotNumber, getSnapshot)
import Hydra.Tx qualified as Tx
import Hydra.Tx.ContestationPeriod (ContestationPeriod)
import Hydra.Tx.Crypto (MultiSignature)
import Hydra.Tx.IsTx (ArbitraryIsTx, IsTx (..))
import Hydra.Tx.OnChainId (OnChainId)
import Hydra.Tx.Snapshot (ConfirmedSnapshot (..), Snapshot (..))
import Hydra.Tx.Snapshot qualified as HeadState
import Test.QuickCheck (recursivelyShrink)
import Test.QuickCheck.Arbitrary.ADT (ToADTArbitrary)

-- | The type of messages sent to clients by the 'Hydra.API.Server'.
data TimedServerOutput tx = TimedServerOutput
  { forall tx. TimedServerOutput tx -> ServerOutput tx
output :: ServerOutput tx
  , forall tx. TimedServerOutput tx -> Natural
seq :: Natural
  , forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
  }
  deriving stock (TimedServerOutput tx -> TimedServerOutput tx -> Bool
(TimedServerOutput tx -> TimedServerOutput tx -> Bool)
-> (TimedServerOutput tx -> TimedServerOutput tx -> Bool)
-> Eq (TimedServerOutput tx)
forall tx.
IsChainState tx =>
TimedServerOutput tx -> TimedServerOutput tx -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall tx.
IsChainState tx =>
TimedServerOutput tx -> TimedServerOutput tx -> Bool
== :: TimedServerOutput tx -> TimedServerOutput tx -> Bool
$c/= :: forall tx.
IsChainState tx =>
TimedServerOutput tx -> TimedServerOutput tx -> Bool
/= :: TimedServerOutput tx -> TimedServerOutput tx -> Bool
Eq, Int -> TimedServerOutput tx -> ShowS
[TimedServerOutput tx] -> ShowS
TimedServerOutput tx -> String
(Int -> TimedServerOutput tx -> ShowS)
-> (TimedServerOutput tx -> String)
-> ([TimedServerOutput tx] -> ShowS)
-> Show (TimedServerOutput tx)
forall tx. IsChainState tx => Int -> TimedServerOutput tx -> ShowS
forall tx. IsChainState tx => [TimedServerOutput tx] -> ShowS
forall tx. IsChainState tx => TimedServerOutput tx -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall tx. IsChainState tx => Int -> TimedServerOutput tx -> ShowS
showsPrec :: Int -> TimedServerOutput tx -> ShowS
$cshow :: forall tx. IsChainState tx => TimedServerOutput tx -> String
show :: TimedServerOutput tx -> String
$cshowList :: forall tx. IsChainState tx => [TimedServerOutput tx] -> ShowS
showList :: [TimedServerOutput tx] -> ShowS
Show, (forall x. TimedServerOutput tx -> Rep (TimedServerOutput tx) x)
-> (forall x. Rep (TimedServerOutput tx) x -> TimedServerOutput tx)
-> Generic (TimedServerOutput tx)
forall x. Rep (TimedServerOutput tx) x -> TimedServerOutput tx
forall x. TimedServerOutput tx -> Rep (TimedServerOutput tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x. Rep (TimedServerOutput tx) x -> TimedServerOutput tx
forall tx x. TimedServerOutput tx -> Rep (TimedServerOutput tx) x
$cfrom :: forall tx x. TimedServerOutput tx -> Rep (TimedServerOutput tx) x
from :: forall x. TimedServerOutput tx -> Rep (TimedServerOutput tx) x
$cto :: forall tx x. Rep (TimedServerOutput tx) x -> TimedServerOutput tx
to :: forall x. Rep (TimedServerOutput tx) x -> TimedServerOutput tx
Generic)

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

instance IsChainState tx => ToJSON (TimedServerOutput tx) where
  toJSON :: TimedServerOutput tx -> Value
toJSON TimedServerOutput{ServerOutput tx
$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output :: ServerOutput tx
output, Natural
$sel:seq:TimedServerOutput :: forall tx. TimedServerOutput tx -> Natural
seq :: Natural
seq, UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time :: UTCTime
time} =
    case ServerOutput tx -> Value
forall a. ToJSON a => a -> Value
toJSON ServerOutput tx
output of
      Object Object
o ->
        Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Object
o Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList [(Key
"seq", Natural -> Value
forall a. ToJSON a => a -> Value
toJSON Natural
seq), (Key
"timestamp", UTCTime -> Value
forall a. ToJSON a => a -> Value
toJSON UTCTime
time)]
      Value
_NotAnObject -> Text -> Value
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"expected ServerOutput to serialize to an Object"

instance IsChainState tx => FromJSON (TimedServerOutput tx) where
  parseJSON :: Value -> Parser (TimedServerOutput tx)
parseJSON Value
v = ((Object -> Parser (TimedServerOutput tx))
 -> Value -> Parser (TimedServerOutput tx))
-> Value
-> (Object -> Parser (TimedServerOutput tx))
-> Parser (TimedServerOutput tx)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String
-> (Object -> Parser (TimedServerOutput tx))
-> Value
-> Parser (TimedServerOutput tx)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TimedServerOutput") Value
v ((Object -> Parser (TimedServerOutput tx))
 -> Parser (TimedServerOutput tx))
-> (Object -> Parser (TimedServerOutput tx))
-> Parser (TimedServerOutput tx)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    ServerOutput tx -> Natural -> UTCTime -> TimedServerOutput tx
forall tx.
ServerOutput tx -> Natural -> UTCTime -> TimedServerOutput tx
TimedServerOutput (ServerOutput tx -> Natural -> UTCTime -> TimedServerOutput tx)
-> Parser (ServerOutput tx)
-> Parser (Natural -> UTCTime -> TimedServerOutput tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (ServerOutput tx)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser (Natural -> UTCTime -> TimedServerOutput tx)
-> Parser Natural -> Parser (UTCTime -> TimedServerOutput tx)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"seq" Parser (UTCTime -> TimedServerOutput tx)
-> Parser UTCTime -> Parser (TimedServerOutput tx)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"timestamp"

data DecommitInvalidReason tx
  = DecommitTxInvalid {forall tx. DecommitInvalidReason tx -> UTxOType tx
localUTxO :: UTxOType tx, forall tx. DecommitInvalidReason tx -> ValidationError
validationError :: ValidationError}
  | DecommitAlreadyInFlight {forall tx. DecommitInvalidReason tx -> TxIdType tx
otherDecommitTxId :: TxIdType tx}
  deriving stock ((forall x.
 DecommitInvalidReason tx -> Rep (DecommitInvalidReason tx) x)
-> (forall x.
    Rep (DecommitInvalidReason tx) x -> DecommitInvalidReason tx)
-> Generic (DecommitInvalidReason tx)
forall x.
Rep (DecommitInvalidReason tx) x -> DecommitInvalidReason tx
forall x.
DecommitInvalidReason tx -> Rep (DecommitInvalidReason tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x.
Rep (DecommitInvalidReason tx) x -> DecommitInvalidReason tx
forall tx x.
DecommitInvalidReason tx -> Rep (DecommitInvalidReason tx) x
$cfrom :: forall tx x.
DecommitInvalidReason tx -> Rep (DecommitInvalidReason tx) x
from :: forall x.
DecommitInvalidReason tx -> Rep (DecommitInvalidReason tx) x
$cto :: forall tx x.
Rep (DecommitInvalidReason tx) x -> DecommitInvalidReason tx
to :: forall x.
Rep (DecommitInvalidReason tx) x -> DecommitInvalidReason tx
Generic)

deriving stock instance (Eq (TxIdType tx), Eq (UTxOType tx)) => Eq (DecommitInvalidReason tx)
deriving stock instance (Show (TxIdType tx), Show (UTxOType tx)) => Show (DecommitInvalidReason tx)

instance (ToJSON (TxIdType tx), ToJSON (UTxOType tx)) => ToJSON (DecommitInvalidReason tx) where
  toJSON :: DecommitInvalidReason tx -> Value
toJSON = Options -> DecommitInvalidReason tx -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions

instance (FromJSON (TxIdType tx), FromJSON (UTxOType tx)) => FromJSON (DecommitInvalidReason tx) where
  parseJSON :: Value -> Parser (DecommitInvalidReason tx)
parseJSON = Options -> Value -> Parser (DecommitInvalidReason tx)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions

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

-- | Individual messages as produced by the 'Hydra.HeadLogic' in
-- the 'ClientEffect'.
data ClientMessage tx
  = CommandFailed {forall tx. ClientMessage tx -> ClientInput tx
clientInput :: ClientInput tx, forall tx. ClientMessage tx -> HeadState tx
state :: HeadState tx}
  | PostTxOnChainFailed {forall tx. ClientMessage tx -> PostChainTx tx
postChainTx :: PostChainTx tx, forall tx. ClientMessage tx -> PostTxError tx
postTxError :: PostTxError tx}
  deriving (ClientMessage tx -> ClientMessage tx -> Bool
(ClientMessage tx -> ClientMessage tx -> Bool)
-> (ClientMessage tx -> ClientMessage tx -> Bool)
-> Eq (ClientMessage tx)
forall tx.
IsChainState tx =>
ClientMessage tx -> ClientMessage tx -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall tx.
IsChainState tx =>
ClientMessage tx -> ClientMessage tx -> Bool
== :: ClientMessage tx -> ClientMessage tx -> Bool
$c/= :: forall tx.
IsChainState tx =>
ClientMessage tx -> ClientMessage tx -> Bool
/= :: ClientMessage tx -> ClientMessage tx -> Bool
Eq, Int -> ClientMessage tx -> ShowS
[ClientMessage tx] -> ShowS
ClientMessage tx -> String
(Int -> ClientMessage tx -> ShowS)
-> (ClientMessage tx -> String)
-> ([ClientMessage tx] -> ShowS)
-> Show (ClientMessage tx)
forall tx. IsChainState tx => Int -> ClientMessage tx -> ShowS
forall tx. IsChainState tx => [ClientMessage tx] -> ShowS
forall tx. IsChainState tx => ClientMessage tx -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall tx. IsChainState tx => Int -> ClientMessage tx -> ShowS
showsPrec :: Int -> ClientMessage tx -> ShowS
$cshow :: forall tx. IsChainState tx => ClientMessage tx -> String
show :: ClientMessage tx -> String
$cshowList :: forall tx. IsChainState tx => [ClientMessage tx] -> ShowS
showList :: [ClientMessage tx] -> ShowS
Show, (forall x. ClientMessage tx -> Rep (ClientMessage tx) x)
-> (forall x. Rep (ClientMessage tx) x -> ClientMessage tx)
-> Generic (ClientMessage tx)
forall x. Rep (ClientMessage tx) x -> ClientMessage tx
forall x. ClientMessage tx -> Rep (ClientMessage tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x. Rep (ClientMessage tx) x -> ClientMessage tx
forall tx x. ClientMessage tx -> Rep (ClientMessage tx) x
$cfrom :: forall tx x. ClientMessage tx -> Rep (ClientMessage tx) x
from :: forall x. ClientMessage tx -> Rep (ClientMessage tx) x
$cto :: forall tx x. Rep (ClientMessage tx) x -> ClientMessage tx
to :: forall x. Rep (ClientMessage tx) x -> ClientMessage tx
Generic)

instance IsChainState tx => ToJSON (ClientMessage tx) where
  toJSON :: ClientMessage tx -> Value
toJSON =
    Options -> ClientMessage tx -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON
      Options
defaultOptions
        { omitNothingFields = True
        }

instance IsChainState tx => FromJSON (ClientMessage tx) where
  parseJSON :: Value -> Parser (ClientMessage tx)
parseJSON =
    Options -> Value -> Parser (ClientMessage tx)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      Options
defaultOptions
        { omitNothingFields = True
        }

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

-- | A friendly welcome message which tells a client something about the
-- node. Currently used for knowing what signing key the server uses (it
-- only knows one), 'HeadStatus' and optionally (if 'HeadIsOpen' or
-- 'SnapshotConfirmed' message is emitted) UTxO's present in the Hydra Head.
data Greetings tx = Greetings
  { forall tx. Greetings tx -> Party
me :: Party
  , forall tx. Greetings tx -> HeadStatus
headStatus :: HeadStatus
  , forall tx. Greetings tx -> Maybe HeadId
hydraHeadId :: Maybe HeadId
  , forall tx. Greetings tx -> Maybe (UTxOType tx)
snapshotUtxo :: Maybe (UTxOType tx)
  , forall tx. Greetings tx -> String
hydraNodeVersion :: String
  }
  deriving ((forall x. Greetings tx -> Rep (Greetings tx) x)
-> (forall x. Rep (Greetings tx) x -> Greetings tx)
-> Generic (Greetings tx)
forall x. Rep (Greetings tx) x -> Greetings tx
forall x. Greetings tx -> Rep (Greetings tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x. Rep (Greetings tx) x -> Greetings tx
forall tx x. Greetings tx -> Rep (Greetings tx) x
$cfrom :: forall tx x. Greetings tx -> Rep (Greetings tx) x
from :: forall x. Greetings tx -> Rep (Greetings tx) x
$cto :: forall tx x. Rep (Greetings tx) x -> Greetings tx
to :: forall x. Rep (Greetings tx) x -> Greetings tx
Generic)

deriving instance IsChainState tx => Eq (Greetings tx)
deriving instance IsChainState tx => Show (Greetings tx)

instance IsChainState tx => ToJSON (Greetings tx) where
  toJSON :: Greetings tx -> Value
toJSON =
    Options -> Greetings tx -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON
      Options
defaultOptions
        { omitNothingFields = True
        , tagSingleConstructors = True
        }

instance IsChainState tx => FromJSON (Greetings tx) where
  parseJSON :: Value -> Parser (Greetings tx)
parseJSON =
    Options -> Value -> Parser (Greetings tx)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      Options
defaultOptions
        { omitNothingFields = True
        , tagSingleConstructors = True
        }

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

data InvalidInput = InvalidInput
  { InvalidInput -> String
reason :: String
  , InvalidInput -> Text
input :: Text
  }
  deriving (InvalidInput -> InvalidInput -> Bool
(InvalidInput -> InvalidInput -> Bool)
-> (InvalidInput -> InvalidInput -> Bool) -> Eq InvalidInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvalidInput -> InvalidInput -> Bool
== :: InvalidInput -> InvalidInput -> Bool
$c/= :: InvalidInput -> InvalidInput -> Bool
/= :: InvalidInput -> InvalidInput -> Bool
Eq, Int -> InvalidInput -> ShowS
[InvalidInput] -> ShowS
InvalidInput -> String
(Int -> InvalidInput -> ShowS)
-> (InvalidInput -> String)
-> ([InvalidInput] -> ShowS)
-> Show InvalidInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidInput -> ShowS
showsPrec :: Int -> InvalidInput -> ShowS
$cshow :: InvalidInput -> String
show :: InvalidInput -> String
$cshowList :: [InvalidInput] -> ShowS
showList :: [InvalidInput] -> ShowS
Show, (forall x. InvalidInput -> Rep InvalidInput x)
-> (forall x. Rep InvalidInput x -> InvalidInput)
-> Generic InvalidInput
forall x. Rep InvalidInput x -> InvalidInput
forall x. InvalidInput -> Rep InvalidInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InvalidInput -> Rep InvalidInput x
from :: forall x. InvalidInput -> Rep InvalidInput x
$cto :: forall x. Rep InvalidInput x -> InvalidInput
to :: forall x. Rep InvalidInput x -> InvalidInput
Generic)

deriving instance ToJSON InvalidInput
deriving instance FromJSON InvalidInput

data ServerOutput tx
  = NetworkConnected
  | NetworkDisconnected
  | NetworkVersionMismatch
      { forall tx. ServerOutput tx -> ProtocolVersion
ourVersion :: ProtocolVersion
      , forall tx. ServerOutput tx -> Maybe ProtocolVersion
theirVersion :: Maybe ProtocolVersion
      }
  | NetworkClusterIDMismatch
      { forall tx. ServerOutput tx -> Text
clusterPeers :: Text
      , forall tx. ServerOutput tx -> Text
misconfiguredPeers :: Text
      }
  | PeerConnected {forall tx. ServerOutput tx -> Host
peer :: Host}
  | PeerDisconnected {peer :: Host}
  | HeadIsInitializing {forall tx. ServerOutput tx -> HeadId
headId :: HeadId, forall tx. ServerOutput tx -> [Party]
parties :: [Party]}
  | Committed {headId :: HeadId, forall tx. ServerOutput tx -> Party
party :: Party, forall tx. ServerOutput tx -> UTxOType tx
utxo :: UTxOType tx}
  | HeadIsOpen {headId :: HeadId, utxo :: UTxOType tx}
  | HeadIsClosed
      { headId :: HeadId
      , forall tx. ServerOutput tx -> SnapshotNumber
snapshotNumber :: SnapshotNumber
      , forall tx. ServerOutput tx -> UTCTime
contestationDeadline :: UTCTime
      -- ^ Nominal deadline until which contest can be submitted and after
      -- which fanout is possible. NOTE: Use this only for informational
      -- purpose and wait for 'ReadyToFanout' instead before sending 'Fanout'
      -- as the ledger of our cardano-node might not have progressed
      -- sufficiently in time yet and we do not re-submit transactions (yet).
      }
  | HeadIsContested {headId :: HeadId, snapshotNumber :: SnapshotNumber, contestationDeadline :: UTCTime}
  | ReadyToFanout {headId :: HeadId}
  | HeadIsAborted {headId :: HeadId, utxo :: UTxOType tx}
  | HeadIsFinalized {headId :: HeadId, utxo :: UTxOType tx}
  | -- | Given transaction has been seen as valid in the Head. It is expected to
    -- eventually be part of a 'SnapshotConfirmed'.
    TxValid {headId :: HeadId, forall tx. ServerOutput tx -> TxIdType tx
transactionId :: TxIdType tx}
  | -- | Given transaction was not not applicable to the given UTxO in time and
    -- has been dropped.
    TxInvalid {headId :: HeadId, utxo :: UTxOType tx, forall tx. ServerOutput tx -> tx
transaction :: tx, forall tx. ServerOutput tx -> ValidationError
validationError :: ValidationError}
  | -- | Given snapshot was confirmed and included transactions can be
    -- considered final.
    SnapshotConfirmed
      { headId :: HeadId
      , forall tx. ServerOutput tx -> Snapshot tx
snapshot :: Snapshot tx
      , forall tx. ServerOutput tx -> MultiSignature (Snapshot tx)
signatures :: MultiSignature (Snapshot tx)
      }
  | IgnoredHeadInitializing
      { headId :: HeadId
      , forall tx. ServerOutput tx -> ContestationPeriod
contestationPeriod :: ContestationPeriod
      , parties :: [Party]
      , forall tx. ServerOutput tx -> [OnChainId]
participants :: [OnChainId]
      }
  | DecommitRequested {headId :: HeadId, forall tx. ServerOutput tx -> tx
decommitTx :: tx, forall tx. ServerOutput tx -> UTxOType tx
utxoToDecommit :: UTxOType tx}
  | DecommitInvalid {headId :: HeadId, decommitTx :: tx, forall tx. ServerOutput tx -> DecommitInvalidReason tx
decommitInvalidReason :: DecommitInvalidReason tx}
  | DecommitApproved {headId :: HeadId, forall tx. ServerOutput tx -> TxIdType tx
decommitTxId :: TxIdType tx, utxoToDecommit :: UTxOType tx}
  | DecommitFinalized {headId :: HeadId, forall tx. ServerOutput tx -> UTxOType tx
distributedUTxO :: UTxOType tx}
  | -- XXX: Rename to DepositRecorded following the state events naming. But only
    -- do this when changing the endpoint also to /commits
    CommitRecorded
      { headId :: HeadId
      , forall tx. ServerOutput tx -> UTxOType tx
utxoToCommit :: UTxOType tx
      , -- XXX: Inconsinstent field name
        forall tx. ServerOutput tx -> TxIdType tx
pendingDeposit :: TxIdType tx
      , forall tx. ServerOutput tx -> UTCTime
deadline :: UTCTime
      }
  | DepositActivated {headId :: HeadId, forall tx. ServerOutput tx -> TxIdType tx
depositTxId :: TxIdType tx, deadline :: UTCTime, forall tx. ServerOutput tx -> UTCTime
chainTime :: UTCTime}
  | DepositExpired {headId :: HeadId, depositTxId :: TxIdType tx, deadline :: UTCTime, chainTime :: UTCTime}
  | CommitApproved {headId :: HeadId, utxoToCommit :: UTxOType tx}
  | CommitFinalized {headId :: HeadId, depositTxId :: TxIdType tx}
  | -- XXX: Rename to DepositRecovered to be more consistent. But only do this
    -- when changing the endpoint also to /commits
    CommitRecovered {headId :: HeadId, forall tx. ServerOutput tx -> UTxOType tx
recoveredUTxO :: UTxOType tx, forall tx. ServerOutput tx -> TxIdType tx
recoveredTxId :: TxIdType tx}
  | -- | Snapshot was side-loaded, and the included transactions can be considered final.
    -- The local state has been reset, meaning pending transactions were pruned.
    -- Any signing round has been discarded, and the snapshot leader has changed accordingly.
    SnapshotSideLoaded {headId :: HeadId, snapshotNumber :: SnapshotNumber}
  | EventLogRotated
  deriving stock ((forall x. ServerOutput tx -> Rep (ServerOutput tx) x)
-> (forall x. Rep (ServerOutput tx) x -> ServerOutput tx)
-> Generic (ServerOutput tx)
forall x. Rep (ServerOutput tx) x -> ServerOutput tx
forall x. ServerOutput tx -> Rep (ServerOutput tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x. Rep (ServerOutput tx) x -> ServerOutput tx
forall tx x. ServerOutput tx -> Rep (ServerOutput tx) x
$cfrom :: forall tx x. ServerOutput tx -> Rep (ServerOutput tx) x
from :: forall x. ServerOutput tx -> Rep (ServerOutput tx) x
$cto :: forall tx x. Rep (ServerOutput tx) x -> ServerOutput tx
to :: forall x. Rep (ServerOutput tx) x -> ServerOutput tx
Generic)

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

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

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

-- | Whether or not to include full UTxO in server outputs.
data WithUTxO = WithUTxO | WithoutUTxO
  deriving stock (WithUTxO -> WithUTxO -> Bool
(WithUTxO -> WithUTxO -> Bool)
-> (WithUTxO -> WithUTxO -> Bool) -> Eq WithUTxO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WithUTxO -> WithUTxO -> Bool
== :: WithUTxO -> WithUTxO -> Bool
$c/= :: WithUTxO -> WithUTxO -> Bool
/= :: WithUTxO -> WithUTxO -> Bool
Eq, Int -> WithUTxO -> ShowS
[WithUTxO] -> ShowS
WithUTxO -> String
(Int -> WithUTxO -> ShowS)
-> (WithUTxO -> String) -> ([WithUTxO] -> ShowS) -> Show WithUTxO
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WithUTxO -> ShowS
showsPrec :: Int -> WithUTxO -> ShowS
$cshow :: WithUTxO -> String
show :: WithUTxO -> String
$cshowList :: [WithUTxO] -> ShowS
showList :: [WithUTxO] -> ShowS
Show)

-- | Whether or not to filter transaction server outputs by given address.
data WithAddressedTx = WithAddressedTx Text | WithoutAddressedTx
  deriving stock (WithAddressedTx -> WithAddressedTx -> Bool
(WithAddressedTx -> WithAddressedTx -> Bool)
-> (WithAddressedTx -> WithAddressedTx -> Bool)
-> Eq WithAddressedTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WithAddressedTx -> WithAddressedTx -> Bool
== :: WithAddressedTx -> WithAddressedTx -> Bool
$c/= :: WithAddressedTx -> WithAddressedTx -> Bool
/= :: WithAddressedTx -> WithAddressedTx -> Bool
Eq, Int -> WithAddressedTx -> ShowS
[WithAddressedTx] -> ShowS
WithAddressedTx -> String
(Int -> WithAddressedTx -> ShowS)
-> (WithAddressedTx -> String)
-> ([WithAddressedTx] -> ShowS)
-> Show WithAddressedTx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WithAddressedTx -> ShowS
showsPrec :: Int -> WithAddressedTx -> ShowS
$cshow :: WithAddressedTx -> String
show :: WithAddressedTx -> String
$cshowList :: [WithAddressedTx] -> ShowS
showList :: [WithAddressedTx] -> ShowS
Show)

data ServerOutputConfig = ServerOutputConfig
  { ServerOutputConfig -> WithUTxO
utxoInSnapshot :: WithUTxO
  , ServerOutputConfig -> WithAddressedTx
addressInTx :: WithAddressedTx
  }
  deriving stock (ServerOutputConfig -> ServerOutputConfig -> Bool
(ServerOutputConfig -> ServerOutputConfig -> Bool)
-> (ServerOutputConfig -> ServerOutputConfig -> Bool)
-> Eq ServerOutputConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServerOutputConfig -> ServerOutputConfig -> Bool
== :: ServerOutputConfig -> ServerOutputConfig -> Bool
$c/= :: ServerOutputConfig -> ServerOutputConfig -> Bool
/= :: ServerOutputConfig -> ServerOutputConfig -> Bool
Eq, Int -> ServerOutputConfig -> ShowS
[ServerOutputConfig] -> ShowS
ServerOutputConfig -> String
(Int -> ServerOutputConfig -> ShowS)
-> (ServerOutputConfig -> String)
-> ([ServerOutputConfig] -> ShowS)
-> Show ServerOutputConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerOutputConfig -> ShowS
showsPrec :: Int -> ServerOutputConfig -> ShowS
$cshow :: ServerOutputConfig -> String
show :: ServerOutputConfig -> String
$cshowList :: [ServerOutputConfig] -> ShowS
showList :: [ServerOutputConfig] -> ShowS
Show)

-- | Replaces the json encoded tx field with it's cbor representation.
--
-- NOTE: we deliberately pattern match on all 'ServerOutput' constructors in
-- 'handleTxOutput' so that we don't forget to update this function if they
-- change.
prepareServerOutput ::
  IsChainState tx =>
  -- | Decide on tx representation
  ServerOutputConfig ->
  -- | Server output
  TimedServerOutput tx ->
  -- | Final output
  LBS.ByteString
prepareServerOutput :: forall tx.
IsChainState tx =>
ServerOutputConfig -> TimedServerOutput tx -> ByteString
prepareServerOutput ServerOutputConfig
config TimedServerOutput tx
response =
  case TimedServerOutput tx -> ServerOutput tx
forall tx. TimedServerOutput tx -> ServerOutput tx
output TimedServerOutput tx
response of
    Committed{} -> ByteString
encodedResponse
    HeadIsInitializing{} -> ByteString
encodedResponse
    HeadIsOpen{} -> ByteString
encodedResponse
    HeadIsClosed{} -> ByteString
encodedResponse
    HeadIsContested{} -> ByteString
encodedResponse
    ReadyToFanout{} -> ByteString
encodedResponse
    HeadIsAborted{} -> ByteString
encodedResponse
    HeadIsFinalized{} -> ByteString
encodedResponse
    TxValid{} -> ByteString
encodedResponse
    TxInvalid{} -> ByteString
encodedResponse
    SnapshotConfirmed{} ->
      ServerOutputConfig
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall a. ServerOutputConfig -> (a -> a) -> a -> a
handleUtxoInclusion ServerOutputConfig
config ByteString -> ByteString
removeSnapshotUTxO ByteString
encodedResponse
    IgnoredHeadInitializing{} -> ByteString
encodedResponse
    DecommitRequested{} -> ByteString
encodedResponse
    DecommitApproved{} -> ByteString
encodedResponse
    DecommitFinalized{} -> ByteString
encodedResponse
    DecommitInvalid{} -> ByteString
encodedResponse
    CommitRecorded{} -> ByteString
encodedResponse
    DepositActivated{} -> ByteString
encodedResponse
    DepositExpired{} -> ByteString
encodedResponse
    CommitApproved{} -> ByteString
encodedResponse
    CommitFinalized{} -> ByteString
encodedResponse
    CommitRecovered{} -> ByteString
encodedResponse
    ServerOutput tx
NetworkConnected -> ByteString
encodedResponse
    ServerOutput tx
NetworkDisconnected -> ByteString
encodedResponse
    NetworkVersionMismatch{} -> ByteString
encodedResponse
    NetworkClusterIDMismatch{} -> ByteString
encodedResponse
    PeerConnected{} -> ByteString
encodedResponse
    PeerDisconnected{} -> ByteString
encodedResponse
    SnapshotSideLoaded{} -> ByteString
encodedResponse
    EventLogRotated{} -> ByteString
encodedResponse
 where
  encodedResponse :: ByteString
encodedResponse = TimedServerOutput tx -> ByteString
forall a. ToJSON a => a -> ByteString
encode TimedServerOutput tx
response

removeSnapshotUTxO :: LBS.ByteString -> LBS.ByteString
removeSnapshotUTxO :: ByteString -> ByteString
removeSnapshotUTxO = Key -> Traversal' ByteString Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"snapshot" ((Value -> Identity Value) -> ByteString -> Identity ByteString)
-> ((Maybe Value -> Identity (Maybe Value))
    -> Value -> Identity Value)
-> (Maybe Value -> Identity (Maybe Value))
-> ByteString
-> Identity ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value (Maybe Value)
forall t. AsValue t => Key -> Traversal' t (Maybe Value)
atKey Key
"utxo" ((Maybe Value -> Identity (Maybe Value))
 -> ByteString -> Identity ByteString)
-> Maybe Value -> ByteString -> ByteString
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Value
forall a. Maybe a
Nothing

handleUtxoInclusion :: ServerOutputConfig -> (a -> a) -> a -> a
handleUtxoInclusion :: forall a. ServerOutputConfig -> (a -> a) -> a -> a
handleUtxoInclusion ServerOutputConfig
config a -> a
f a
bs =
  case ServerOutputConfig -> WithUTxO
utxoInSnapshot ServerOutputConfig
config of
    WithUTxO
WithUTxO -> a
bs
    WithUTxO
WithoutUTxO -> a
bs a -> (a -> a) -> a
forall a b. a -> (a -> b) -> b
& a -> a
f

-- | All possible Hydra states displayed in the API server outputs.
data HeadStatus
  = Idle
  | Initializing
  | Open
  | Closed
  | FanoutPossible
  deriving stock (HeadStatus -> HeadStatus -> Bool
(HeadStatus -> HeadStatus -> Bool)
-> (HeadStatus -> HeadStatus -> Bool) -> Eq HeadStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeadStatus -> HeadStatus -> Bool
== :: HeadStatus -> HeadStatus -> Bool
$c/= :: HeadStatus -> HeadStatus -> Bool
/= :: HeadStatus -> HeadStatus -> Bool
Eq, Int -> HeadStatus -> ShowS
[HeadStatus] -> ShowS
HeadStatus -> String
(Int -> HeadStatus -> ShowS)
-> (HeadStatus -> String)
-> ([HeadStatus] -> ShowS)
-> Show HeadStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeadStatus -> ShowS
showsPrec :: Int -> HeadStatus -> ShowS
$cshow :: HeadStatus -> String
show :: HeadStatus -> String
$cshowList :: [HeadStatus] -> ShowS
showList :: [HeadStatus] -> ShowS
Show, (forall x. HeadStatus -> Rep HeadStatus x)
-> (forall x. Rep HeadStatus x -> HeadStatus) -> Generic HeadStatus
forall x. Rep HeadStatus x -> HeadStatus
forall x. HeadStatus -> Rep HeadStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HeadStatus -> Rep HeadStatus x
from :: forall x. HeadStatus -> Rep HeadStatus x
$cto :: forall x. Rep HeadStatus x -> HeadStatus
to :: forall x. Rep HeadStatus x -> HeadStatus
Generic)
  deriving anyclass ([HeadStatus] -> Value
[HeadStatus] -> Encoding
HeadStatus -> Bool
HeadStatus -> Value
HeadStatus -> Encoding
(HeadStatus -> Value)
-> (HeadStatus -> Encoding)
-> ([HeadStatus] -> Value)
-> ([HeadStatus] -> Encoding)
-> (HeadStatus -> Bool)
-> ToJSON HeadStatus
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: HeadStatus -> Value
toJSON :: HeadStatus -> Value
$ctoEncoding :: HeadStatus -> Encoding
toEncoding :: HeadStatus -> Encoding
$ctoJSONList :: [HeadStatus] -> Value
toJSONList :: [HeadStatus] -> Value
$ctoEncodingList :: [HeadStatus] -> Encoding
toEncodingList :: [HeadStatus] -> Encoding
$comitField :: HeadStatus -> Bool
omitField :: HeadStatus -> Bool
ToJSON, Maybe HeadStatus
Value -> Parser [HeadStatus]
Value -> Parser HeadStatus
(Value -> Parser HeadStatus)
-> (Value -> Parser [HeadStatus])
-> Maybe HeadStatus
-> FromJSON HeadStatus
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser HeadStatus
parseJSON :: Value -> Parser HeadStatus
$cparseJSONList :: Value -> Parser [HeadStatus]
parseJSONList :: Value -> Parser [HeadStatus]
$comittedField :: Maybe HeadStatus
omittedField :: Maybe HeadStatus
FromJSON)

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

-- | All information needed to distinguish behavior of the commit endpoint.
data CommitInfo
  = CannotCommit
  | NormalCommit HeadId
  | IncrementalCommit HeadId

-- | Get latest confirmed snapshot UTxO from 'HeadState'.
getSnapshotUtxo :: Monoid (UTxOType tx) => HeadState tx -> Maybe (UTxOType tx)
getSnapshotUtxo :: forall tx.
Monoid (UTxOType tx) =>
HeadState tx -> Maybe (UTxOType tx)
getSnapshotUtxo = \case
  HeadState.Idle{} ->
    Maybe (UTxOType tx)
forall a. Maybe a
Nothing
  HeadState.Initial InitialState{Committed tx
committed :: Committed tx
$sel:committed:InitialState :: forall tx. InitialState tx -> Committed tx
committed} ->
    let u0 :: UTxOType tx
u0 = Committed tx -> UTxOType tx
forall m. Monoid m => Map Party m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Committed tx
committed
     in UTxOType tx -> Maybe (UTxOType tx)
forall a. a -> Maybe a
Just UTxOType tx
u0
  HeadState.Open OpenState{CoordinatedHeadState tx
coordinatedHeadState :: CoordinatedHeadState tx
$sel:coordinatedHeadState:OpenState :: forall tx. OpenState tx -> CoordinatedHeadState tx
coordinatedHeadState} ->
    let snapshot :: Snapshot tx
snapshot = ConfirmedSnapshot tx -> Snapshot tx
forall tx. ConfirmedSnapshot tx -> Snapshot tx
getSnapshot CoordinatedHeadState tx
coordinatedHeadState.confirmedSnapshot
     in UTxOType tx -> Maybe (UTxOType tx)
forall a. a -> Maybe a
Just (UTxOType tx -> Maybe (UTxOType tx))
-> UTxOType tx -> Maybe (UTxOType tx)
forall a b. (a -> b) -> a -> b
$ Snapshot tx -> UTxOType tx
forall tx. Snapshot tx -> UTxOType tx
Tx.utxo Snapshot tx
snapshot 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 (Snapshot tx -> Maybe (UTxOType tx)
forall tx. Snapshot tx -> Maybe (UTxOType tx)
Tx.utxoToCommit Snapshot tx
snapshot)
  HeadState.Closed ClosedState{ConfirmedSnapshot tx
confirmedSnapshot :: ConfirmedSnapshot tx
$sel:confirmedSnapshot:ClosedState :: forall tx. ClosedState tx -> ConfirmedSnapshot tx
confirmedSnapshot} ->
    let snapshot :: Snapshot tx
snapshot = ConfirmedSnapshot tx -> Snapshot tx
forall tx. ConfirmedSnapshot tx -> Snapshot tx
getSnapshot ConfirmedSnapshot tx
confirmedSnapshot
     in UTxOType tx -> Maybe (UTxOType tx)
forall a. a -> Maybe a
Just (UTxOType tx -> Maybe (UTxOType tx))
-> UTxOType tx -> Maybe (UTxOType tx)
forall a b. (a -> b) -> a -> b
$ Snapshot tx -> UTxOType tx
forall tx. Snapshot tx -> UTxOType tx
Tx.utxo Snapshot tx
snapshot 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 (Snapshot tx -> Maybe (UTxOType tx)
forall tx. Snapshot tx -> Maybe (UTxOType tx)
Tx.utxoToCommit Snapshot tx
snapshot)

-- | Get latest seen snapshot from 'HeadState'.
getSeenSnapshot :: HeadState tx -> HeadState.SeenSnapshot tx
getSeenSnapshot :: forall tx. HeadState tx -> SeenSnapshot tx
getSeenSnapshot = \case
  HeadState.Idle{} ->
    SeenSnapshot tx
forall tx. SeenSnapshot tx
NoSeenSnapshot
  HeadState.Initial{} ->
    SeenSnapshot tx
forall tx. SeenSnapshot tx
NoSeenSnapshot
  HeadState.Open OpenState{CoordinatedHeadState tx
$sel:coordinatedHeadState:OpenState :: forall tx. OpenState tx -> CoordinatedHeadState tx
coordinatedHeadState :: CoordinatedHeadState tx
coordinatedHeadState} ->
    CoordinatedHeadState tx
coordinatedHeadState.seenSnapshot
  HeadState.Closed ClosedState{ConfirmedSnapshot tx
$sel:confirmedSnapshot:ClosedState :: forall tx. ClosedState tx -> ConfirmedSnapshot tx
confirmedSnapshot :: ConfirmedSnapshot tx
confirmedSnapshot} ->
    let Snapshot{SnapshotNumber
number :: SnapshotNumber
$sel:number:Snapshot :: forall tx. Snapshot tx -> SnapshotNumber
number} = ConfirmedSnapshot tx -> Snapshot tx
forall tx. ConfirmedSnapshot tx -> Snapshot tx
getSnapshot ConfirmedSnapshot tx
confirmedSnapshot
     in SnapshotNumber -> SeenSnapshot tx
forall tx. SnapshotNumber -> SeenSnapshot tx
LastSeenSnapshot SnapshotNumber
number

-- | Get latest confirmed snapshot from 'HeadState'.
getConfirmedSnapshot :: IsChainState tx => HeadState tx -> Maybe (HeadState.ConfirmedSnapshot tx)
getConfirmedSnapshot :: forall tx.
IsChainState tx =>
HeadState tx -> Maybe (ConfirmedSnapshot tx)
getConfirmedSnapshot = \case
  HeadState.Idle{} ->
    Maybe (ConfirmedSnapshot tx)
forall a. Maybe a
Nothing
  HeadState.Initial InitialState{HeadId
headId :: HeadId
$sel:headId:InitialState :: forall tx. InitialState tx -> HeadId
headId, Committed tx
$sel:committed:InitialState :: forall tx. InitialState tx -> Committed tx
committed :: Committed tx
committed} ->
    let u0 :: UTxOType tx
u0 = Committed tx -> UTxOType tx
forall m. Monoid m => Map Party m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Committed tx
committed
     in ConfirmedSnapshot tx -> Maybe (ConfirmedSnapshot tx)
forall a. a -> Maybe a
Just (ConfirmedSnapshot tx -> Maybe (ConfirmedSnapshot tx))
-> ConfirmedSnapshot tx -> Maybe (ConfirmedSnapshot tx)
forall a b. (a -> b) -> a -> b
$ HeadId -> UTxOType tx -> ConfirmedSnapshot tx
forall tx. HeadId -> UTxOType tx -> ConfirmedSnapshot tx
InitialSnapshot HeadId
headId UTxOType tx
u0
  HeadState.Open OpenState{CoordinatedHeadState tx
$sel:coordinatedHeadState:OpenState :: forall tx. OpenState tx -> CoordinatedHeadState tx
coordinatedHeadState :: CoordinatedHeadState tx
coordinatedHeadState} ->
    ConfirmedSnapshot tx -> Maybe (ConfirmedSnapshot tx)
forall a. a -> Maybe a
Just CoordinatedHeadState tx
coordinatedHeadState.confirmedSnapshot
  HeadState.Closed ClosedState{ConfirmedSnapshot tx
$sel:confirmedSnapshot:ClosedState :: forall tx. ClosedState tx -> ConfirmedSnapshot tx
confirmedSnapshot :: ConfirmedSnapshot tx
confirmedSnapshot} ->
    ConfirmedSnapshot tx -> Maybe (ConfirmedSnapshot tx)
forall a. a -> Maybe a
Just ConfirmedSnapshot tx
confirmedSnapshot