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

module Hydra.API.ServerOutput where

import Control.Lens ((.~))
import Data.Aeson (Value (..), defaultOptions, encode, genericParseJSON, genericToJSON, omitNothingFields, 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 (HeadState)
import Hydra.Ledger (ValidationError)
import Hydra.Network (Host, ProtocolVersion)
import Hydra.Prelude hiding (seq)
import Hydra.Tx (
  HeadId,
  Party,
  Snapshot,
  SnapshotNumber,
 )
import Hydra.Tx.ContestationPeriod (ContestationPeriod)
import Hydra.Tx.Crypto (MultiSignature)
import Hydra.Tx.IsTx (ArbitraryIsTx, IsTx (..))
import Hydra.Tx.OnChainId (OnChainId)
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
        }

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
        }

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
      }
  | 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, forall tx. ServerOutput tx -> tx
transaction :: tx}
  | -- | Given transaction was not not applicable to the given UTxO in time and
    -- has been dropped.
    TxInvalid {headId :: HeadId, utxo :: UTxOType 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, decommitTxId :: TxIdType tx}
  | CommitRecorded {headId :: HeadId, forall tx. ServerOutput tx -> UTxOType tx
utxoToCommit :: UTxOType tx, forall tx. ServerOutput tx -> TxIdType tx
pendingDeposit :: TxIdType tx, forall tx. ServerOutput tx -> UTCTime
deadline :: UTCTime}
  | CommitApproved {headId :: HeadId, utxoToCommit :: UTxOType tx}
  | CommitFinalized {headId :: HeadId, forall tx. ServerOutput tx -> TxIdType tx
depositTxId :: TxIdType tx}
  | 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}
  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

  -- NOTE: Somehow, can't use 'genericShrink' here as GHC is complaining about
  -- Overlapping instances with 'UTxOType tx' even though for a fixed `tx`, there
  -- should be only one 'UTxOType tx'
  shrink :: ServerOutput tx -> [ServerOutput tx]
shrink = \case
    HeadIsInitializing HeadId
headId [Party]
xs -> HeadId -> [Party] -> ServerOutput tx
forall tx. HeadId -> [Party] -> ServerOutput tx
HeadIsInitializing (HeadId -> [Party] -> ServerOutput tx)
-> [HeadId] -> [[Party] -> ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HeadId -> [HeadId]
forall a. Arbitrary a => a -> [a]
shrink HeadId
headId [[Party] -> ServerOutput tx] -> [[Party]] -> [ServerOutput tx]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Party] -> [[Party]]
forall a. Arbitrary a => a -> [a]
shrink [Party]
xs
    Committed HeadId
headId Party
p UTxOType tx
u -> HeadId -> Party -> UTxOType tx -> ServerOutput tx
forall tx. HeadId -> Party -> UTxOType tx -> ServerOutput tx
Committed (HeadId -> Party -> UTxOType tx -> ServerOutput tx)
-> [HeadId] -> [Party -> UTxOType tx -> ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HeadId -> [HeadId]
forall a. Arbitrary a => a -> [a]
shrink HeadId
headId [Party -> UTxOType tx -> ServerOutput tx]
-> [Party] -> [UTxOType tx -> ServerOutput tx]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Party -> [Party]
forall a. Arbitrary a => a -> [a]
shrink Party
p [UTxOType tx -> ServerOutput tx]
-> [UTxOType tx] -> [ServerOutput tx]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UTxOType tx -> [UTxOType tx]
forall a. Arbitrary a => a -> [a]
shrink UTxOType tx
u
    HeadIsOpen HeadId
headId UTxOType tx
u -> HeadId -> UTxOType tx -> ServerOutput tx
forall tx. HeadId -> UTxOType tx -> ServerOutput tx
HeadIsOpen (HeadId -> UTxOType tx -> ServerOutput tx)
-> [HeadId] -> [UTxOType tx -> ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HeadId -> [HeadId]
forall a. Arbitrary a => a -> [a]
shrink HeadId
headId [UTxOType tx -> ServerOutput tx]
-> [UTxOType tx] -> [ServerOutput tx]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UTxOType tx -> [UTxOType tx]
forall a. Arbitrary a => a -> [a]
shrink UTxOType tx
u
    HeadIsClosed HeadId
headId SnapshotNumber
s UTCTime
t -> HeadId -> SnapshotNumber -> UTCTime -> ServerOutput tx
forall tx. HeadId -> SnapshotNumber -> UTCTime -> ServerOutput tx
HeadIsClosed (HeadId -> SnapshotNumber -> UTCTime -> ServerOutput tx)
-> [HeadId] -> [SnapshotNumber -> UTCTime -> ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HeadId -> [HeadId]
forall a. Arbitrary a => a -> [a]
shrink HeadId
headId [SnapshotNumber -> UTCTime -> ServerOutput tx]
-> [SnapshotNumber] -> [UTCTime -> ServerOutput tx]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnapshotNumber -> [SnapshotNumber]
forall a. Arbitrary a => a -> [a]
shrink SnapshotNumber
s [UTCTime -> ServerOutput tx] -> [UTCTime] -> [ServerOutput tx]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UTCTime -> [UTCTime]
forall a. Arbitrary a => a -> [a]
shrink UTCTime
t
    HeadIsContested HeadId
headId SnapshotNumber
sn UTCTime
dl -> HeadId -> SnapshotNumber -> UTCTime -> ServerOutput tx
forall tx. HeadId -> SnapshotNumber -> UTCTime -> ServerOutput tx
HeadIsContested (HeadId -> SnapshotNumber -> UTCTime -> ServerOutput tx)
-> [HeadId] -> [SnapshotNumber -> UTCTime -> ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HeadId -> [HeadId]
forall a. Arbitrary a => a -> [a]
shrink HeadId
headId [SnapshotNumber -> UTCTime -> ServerOutput tx]
-> [SnapshotNumber] -> [UTCTime -> ServerOutput tx]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnapshotNumber -> [SnapshotNumber]
forall a. Arbitrary a => a -> [a]
shrink SnapshotNumber
sn [UTCTime -> ServerOutput tx] -> [UTCTime] -> [ServerOutput tx]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UTCTime -> [UTCTime]
forall a. Arbitrary a => a -> [a]
shrink UTCTime
dl
    ReadyToFanout HeadId
headId -> HeadId -> ServerOutput tx
forall tx. HeadId -> ServerOutput tx
ReadyToFanout (HeadId -> ServerOutput tx) -> [HeadId] -> [ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HeadId -> [HeadId]
forall a. Arbitrary a => a -> [a]
shrink HeadId
headId
    HeadIsFinalized HeadId
headId UTxOType tx
u -> HeadId -> UTxOType tx -> ServerOutput tx
forall tx. HeadId -> UTxOType tx -> ServerOutput tx
HeadIsFinalized (HeadId -> UTxOType tx -> ServerOutput tx)
-> [HeadId] -> [UTxOType tx -> ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HeadId -> [HeadId]
forall a. Arbitrary a => a -> [a]
shrink HeadId
headId [UTxOType tx -> ServerOutput tx]
-> [UTxOType tx] -> [ServerOutput tx]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UTxOType tx -> [UTxOType tx]
forall a. Arbitrary a => a -> [a]
shrink UTxOType tx
u
    HeadIsAborted HeadId
headId UTxOType tx
u -> HeadId -> UTxOType tx -> ServerOutput tx
forall tx. HeadId -> UTxOType tx -> ServerOutput tx
HeadIsAborted (HeadId -> UTxOType tx -> ServerOutput tx)
-> [HeadId] -> [UTxOType tx -> ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HeadId -> [HeadId]
forall a. Arbitrary a => a -> [a]
shrink HeadId
headId [UTxOType tx -> ServerOutput tx]
-> [UTxOType tx] -> [ServerOutput tx]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UTxOType tx -> [UTxOType tx]
forall a. Arbitrary a => a -> [a]
shrink UTxOType tx
u
    TxValid HeadId
headId TxIdType tx
i tx
tx -> HeadId -> TxIdType tx -> tx -> ServerOutput tx
forall tx. HeadId -> TxIdType tx -> tx -> ServerOutput tx
TxValid (HeadId -> TxIdType tx -> tx -> ServerOutput tx)
-> [HeadId] -> [TxIdType tx -> tx -> ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HeadId -> [HeadId]
forall a. Arbitrary a => a -> [a]
shrink HeadId
headId [TxIdType tx -> tx -> ServerOutput tx]
-> [TxIdType tx] -> [tx -> ServerOutput tx]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TxIdType tx -> [TxIdType tx]
forall a. Arbitrary a => a -> [a]
shrink TxIdType tx
i [tx -> ServerOutput tx] -> [tx] -> [ServerOutput tx]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> tx -> [tx]
forall a. Arbitrary a => a -> [a]
shrink tx
tx
    TxInvalid HeadId
headId UTxOType tx
u tx
tx ValidationError
err -> HeadId -> UTxOType tx -> tx -> ValidationError -> ServerOutput tx
forall tx.
HeadId -> UTxOType tx -> tx -> ValidationError -> ServerOutput tx
TxInvalid (HeadId -> UTxOType tx -> tx -> ValidationError -> ServerOutput tx)
-> [HeadId]
-> [UTxOType tx -> tx -> ValidationError -> ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HeadId -> [HeadId]
forall a. Arbitrary a => a -> [a]
shrink HeadId
headId [UTxOType tx -> tx -> ValidationError -> ServerOutput tx]
-> [UTxOType tx] -> [tx -> ValidationError -> ServerOutput tx]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UTxOType tx -> [UTxOType tx]
forall a. Arbitrary a => a -> [a]
shrink UTxOType tx
u [tx -> ValidationError -> ServerOutput tx]
-> [tx] -> [ValidationError -> ServerOutput tx]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> tx -> [tx]
forall a. Arbitrary a => a -> [a]
shrink tx
tx [ValidationError -> ServerOutput tx]
-> [ValidationError] -> [ServerOutput tx]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ValidationError -> [ValidationError]
forall a. Arbitrary a => a -> [a]
shrink ValidationError
err
    SnapshotConfirmed HeadId
headId Snapshot tx
s MultiSignature (Snapshot tx)
ms -> HeadId
-> Snapshot tx -> MultiSignature (Snapshot tx) -> ServerOutput tx
forall tx.
HeadId
-> Snapshot tx -> MultiSignature (Snapshot tx) -> ServerOutput tx
SnapshotConfirmed (HeadId
 -> Snapshot tx -> MultiSignature (Snapshot tx) -> ServerOutput tx)
-> [HeadId]
-> [Snapshot tx -> MultiSignature (Snapshot tx) -> ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HeadId -> [HeadId]
forall a. Arbitrary a => a -> [a]
shrink HeadId
headId [Snapshot tx -> MultiSignature (Snapshot tx) -> ServerOutput tx]
-> [Snapshot tx]
-> [MultiSignature (Snapshot tx) -> ServerOutput tx]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Snapshot tx -> [Snapshot tx]
forall a. Arbitrary a => a -> [a]
shrink Snapshot tx
s [MultiSignature (Snapshot tx) -> ServerOutput tx]
-> [MultiSignature (Snapshot tx)] -> [ServerOutput tx]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MultiSignature (Snapshot tx) -> [MultiSignature (Snapshot tx)]
forall a. Arbitrary a => a -> [a]
shrink MultiSignature (Snapshot tx)
ms
    IgnoredHeadInitializing{} -> []
    DecommitRequested HeadId
headId tx
txid UTxOType tx
u -> HeadId -> tx -> UTxOType tx -> ServerOutput tx
forall tx. HeadId -> tx -> UTxOType tx -> ServerOutput tx
DecommitRequested HeadId
headId tx
txid (UTxOType tx -> ServerOutput tx)
-> [UTxOType tx] -> [ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxOType tx -> [UTxOType tx]
forall a. Arbitrary a => a -> [a]
shrink UTxOType tx
u
    DecommitInvalid HeadId
headId tx
decommitTx DecommitInvalidReason tx
decommitInvalidReason -> HeadId -> tx -> DecommitInvalidReason tx -> ServerOutput tx
forall tx.
HeadId -> tx -> DecommitInvalidReason tx -> ServerOutput tx
DecommitInvalid HeadId
headId (tx -> DecommitInvalidReason tx -> ServerOutput tx)
-> [tx] -> [DecommitInvalidReason tx -> ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> tx -> [tx]
forall a. Arbitrary a => a -> [a]
shrink tx
decommitTx [DecommitInvalidReason tx -> ServerOutput tx]
-> [DecommitInvalidReason tx] -> [ServerOutput tx]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DecommitInvalidReason tx -> [DecommitInvalidReason tx]
forall a. Arbitrary a => a -> [a]
shrink DecommitInvalidReason tx
decommitInvalidReason
    DecommitApproved HeadId
headId TxIdType tx
txid UTxOType tx
u -> HeadId -> TxIdType tx -> UTxOType tx -> ServerOutput tx
forall tx. HeadId -> TxIdType tx -> UTxOType tx -> ServerOutput tx
DecommitApproved HeadId
headId TxIdType tx
txid (UTxOType tx -> ServerOutput tx)
-> [UTxOType tx] -> [ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxOType tx -> [UTxOType tx]
forall a. Arbitrary a => a -> [a]
shrink UTxOType tx
u
    DecommitFinalized HeadId
headId TxIdType tx
decommitTxId -> HeadId -> TxIdType tx -> ServerOutput tx
forall tx. HeadId -> TxIdType tx -> ServerOutput tx
DecommitFinalized HeadId
headId (TxIdType tx -> ServerOutput tx)
-> [TxIdType tx] -> [ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxIdType tx -> [TxIdType tx]
forall a. Arbitrary a => a -> [a]
shrink TxIdType tx
decommitTxId
    CommitRecorded HeadId
headId UTxOType tx
u TxIdType tx
i UTCTime
d -> HeadId -> UTxOType tx -> TxIdType tx -> UTCTime -> ServerOutput tx
forall tx.
HeadId -> UTxOType tx -> TxIdType tx -> UTCTime -> ServerOutput tx
CommitRecorded HeadId
headId (UTxOType tx -> TxIdType tx -> UTCTime -> ServerOutput tx)
-> [UTxOType tx] -> [TxIdType tx -> UTCTime -> ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxOType tx -> [UTxOType tx]
forall a. Arbitrary a => a -> [a]
shrink UTxOType tx
u [TxIdType tx -> UTCTime -> ServerOutput tx]
-> [TxIdType tx] -> [UTCTime -> ServerOutput tx]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TxIdType tx -> [TxIdType tx]
forall a. Arbitrary a => a -> [a]
shrink TxIdType tx
i [UTCTime -> ServerOutput tx] -> [UTCTime] -> [ServerOutput tx]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UTCTime -> [UTCTime]
forall a. Arbitrary a => a -> [a]
shrink UTCTime
d
    CommitApproved HeadId
headId UTxOType tx
u -> HeadId -> UTxOType tx -> ServerOutput tx
forall tx. HeadId -> UTxOType tx -> ServerOutput tx
CommitApproved HeadId
headId (UTxOType tx -> ServerOutput tx)
-> [UTxOType tx] -> [ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxOType tx -> [UTxOType tx]
forall a. Arbitrary a => a -> [a]
shrink UTxOType tx
u
    CommitRecovered HeadId
headId UTxOType tx
u TxIdType tx
rid -> HeadId -> UTxOType tx -> TxIdType tx -> ServerOutput tx
forall tx. HeadId -> UTxOType tx -> TxIdType tx -> ServerOutput tx
CommitRecovered HeadId
headId (UTxOType tx -> TxIdType tx -> ServerOutput tx)
-> [UTxOType tx] -> [TxIdType tx -> ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxOType tx -> [UTxOType tx]
forall a. Arbitrary a => a -> [a]
shrink UTxOType tx
u [TxIdType tx -> ServerOutput tx]
-> [TxIdType tx] -> [ServerOutput tx]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TxIdType tx -> [TxIdType tx]
forall a. Arbitrary a => a -> [a]
shrink TxIdType tx
rid
    CommitFinalized HeadId
headId TxIdType tx
depositTxId -> HeadId -> TxIdType tx -> ServerOutput tx
forall tx. HeadId -> TxIdType tx -> ServerOutput tx
CommitFinalized HeadId
headId (TxIdType tx -> ServerOutput tx)
-> [TxIdType tx] -> [ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxIdType tx -> [TxIdType tx]
forall a. Arbitrary a => a -> [a]
shrink TxIdType tx
depositTxId
    ServerOutput tx
NetworkConnected -> []
    ServerOutput tx
NetworkDisconnected -> []
    NetworkVersionMismatch ProtocolVersion
our Maybe ProtocolVersion
theirs -> ProtocolVersion -> Maybe ProtocolVersion -> ServerOutput tx
forall tx.
ProtocolVersion -> Maybe ProtocolVersion -> ServerOutput tx
NetworkVersionMismatch (ProtocolVersion -> Maybe ProtocolVersion -> ServerOutput tx)
-> [ProtocolVersion] -> [Maybe ProtocolVersion -> ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolVersion -> [ProtocolVersion]
forall a. Arbitrary a => a -> [a]
shrink ProtocolVersion
our [Maybe ProtocolVersion -> ServerOutput tx]
-> [Maybe ProtocolVersion] -> [ServerOutput tx]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ProtocolVersion -> [Maybe ProtocolVersion]
forall a. Arbitrary a => a -> [a]
shrink Maybe ProtocolVersion
theirs
    PeerConnected Host
peer -> Host -> ServerOutput tx
forall tx. Host -> ServerOutput tx
PeerConnected (Host -> ServerOutput tx) -> [Host] -> [ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Host -> [Host]
forall a. Arbitrary a => a -> [a]
shrink Host
peer
    PeerDisconnected Host
peer -> Host -> ServerOutput tx
forall tx. Host -> ServerOutput tx
PeerDisconnected (Host -> ServerOutput tx) -> [Host] -> [ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Host -> [Host]
forall a. Arbitrary a => a -> [a]
shrink Host
peer
    SnapshotSideLoaded HeadId
headId SnapshotNumber
snapshotNumber -> HeadId -> SnapshotNumber -> ServerOutput tx
forall tx. HeadId -> SnapshotNumber -> ServerOutput tx
SnapshotSideLoaded HeadId
headId (SnapshotNumber -> ServerOutput tx)
-> [SnapshotNumber] -> [ServerOutput tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SnapshotNumber -> [SnapshotNumber]
forall a. Arbitrary a => a -> [a]
shrink SnapshotNumber
snapshotNumber

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
    CommitApproved{} -> ByteString
encodedResponse
    CommitFinalized{} -> ByteString
encodedResponse
    CommitRecovered{} -> ByteString
encodedResponse
    ServerOutput tx
NetworkConnected -> ByteString
encodedResponse
    ServerOutput tx
NetworkDisconnected -> ByteString
encodedResponse
    NetworkVersionMismatch{} -> ByteString
encodedResponse
    PeerConnected{} -> ByteString
encodedResponse
    PeerDisconnected{} -> ByteString
encodedResponse
    SnapshotSideLoaded{} -> 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
  | Final
  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