{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DuplicateRecordFields #-}

-- | Observe hydra transactions
module Hydra.Tx.Observe (
  module Hydra.Tx.Observe,
  module Hydra.Tx.Init,
  module Hydra.Tx.Abort,
  module Hydra.Tx.Commit,
  module Hydra.Tx.CollectCom,
  module Hydra.Tx.Decrement,
  module Hydra.Tx.Deposit,
  module Hydra.Tx.Increment,
  module Hydra.Tx.Recover,
  module Hydra.Tx.Close,
  module Hydra.Tx.Contest,
  module Hydra.Tx.Fanout,
) where

import Hydra.Cardano.Api
import Hydra.Prelude hiding (toList)

import Hydra.Tx.Abort (AbortObservation (..), observeAbortTx)
import Hydra.Tx.Close (CloseObservation (..), observeCloseTx)
import Hydra.Tx.CollectCom (CollectComObservation (..), observeCollectComTx)
import Hydra.Tx.Commit (CommitObservation (..), observeCommitTx)
import Hydra.Tx.Contest (ContestObservation (..), observeContestTx)
import Hydra.Tx.Decrement (DecrementObservation (..), observeDecrementTx)
import Hydra.Tx.Deposit (DepositObservation (..), observeDepositTx)
import Hydra.Tx.Fanout (FanoutObservation (..), observeFanoutTx)
import Hydra.Tx.Increment (IncrementObservation (..), observeIncrementTx)
import Hydra.Tx.Init (InitObservation (..), NotAnInitReason (..), observeInitTx)
import Hydra.Tx.Recover (RecoverObservation (..), observeRecoverTx)

-- * Observe Hydra Head transactions

-- | Generalised type for arbitrary Head observations on-chain.
data HeadObservation
  = NoHeadTx
  | Init InitObservation
  | Abort AbortObservation
  | Commit CommitObservation
  | CollectCom CollectComObservation
  | Deposit DepositObservation
  | Recover RecoverObservation
  | Increment IncrementObservation
  | Decrement DecrementObservation
  | Close CloseObservation
  | Contest ContestObservation
  | Fanout FanoutObservation
  deriving stock (HeadObservation -> HeadObservation -> Bool
(HeadObservation -> HeadObservation -> Bool)
-> (HeadObservation -> HeadObservation -> Bool)
-> Eq HeadObservation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeadObservation -> HeadObservation -> Bool
== :: HeadObservation -> HeadObservation -> Bool
$c/= :: HeadObservation -> HeadObservation -> Bool
/= :: HeadObservation -> HeadObservation -> Bool
Eq, Int -> HeadObservation -> ShowS
[HeadObservation] -> ShowS
HeadObservation -> String
(Int -> HeadObservation -> ShowS)
-> (HeadObservation -> String)
-> ([HeadObservation] -> ShowS)
-> Show HeadObservation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeadObservation -> ShowS
showsPrec :: Int -> HeadObservation -> ShowS
$cshow :: HeadObservation -> String
show :: HeadObservation -> String
$cshowList :: [HeadObservation] -> ShowS
showList :: [HeadObservation] -> ShowS
Show, (forall x. HeadObservation -> Rep HeadObservation x)
-> (forall x. Rep HeadObservation x -> HeadObservation)
-> Generic HeadObservation
forall x. Rep HeadObservation x -> HeadObservation
forall x. HeadObservation -> Rep HeadObservation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HeadObservation -> Rep HeadObservation x
from :: forall x. HeadObservation -> Rep HeadObservation x
$cto :: forall x. Rep HeadObservation x -> HeadObservation
to :: forall x. Rep HeadObservation x -> HeadObservation
Generic)

-- | Observe any Hydra head transaction.
observeHeadTx :: NetworkId -> UTxO -> Tx -> HeadObservation
observeHeadTx :: NetworkId -> UTxO -> Tx -> HeadObservation
observeHeadTx NetworkId
networkId UTxO
utxo Tx
tx =
  -- XXX: This is throwing away valuable information! We should be collecting
  -- all "not an XX" reasons here in case we fall through and want that
  -- diagnostic information in the call site of this function. Collecting errors
  -- could be done with 'validation' or a similar package.
  HeadObservation -> Maybe HeadObservation -> HeadObservation
forall a. a -> Maybe a -> a
fromMaybe HeadObservation
NoHeadTx (Maybe HeadObservation -> HeadObservation)
-> Maybe HeadObservation -> HeadObservation
forall a b. (a -> b) -> a -> b
$
    (NotAnInitReason -> Maybe HeadObservation)
-> (InitObservation -> Maybe HeadObservation)
-> Either NotAnInitReason InitObservation
-> Maybe HeadObservation
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe HeadObservation -> NotAnInitReason -> Maybe HeadObservation
forall a b. a -> b -> a
const Maybe HeadObservation
forall a. Maybe a
Nothing) (HeadObservation -> Maybe HeadObservation
forall a. a -> Maybe a
Just (HeadObservation -> Maybe HeadObservation)
-> (InitObservation -> HeadObservation)
-> InitObservation
-> Maybe HeadObservation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitObservation -> HeadObservation
Init) (Tx -> Either NotAnInitReason InitObservation
observeInitTx Tx
tx)
      Maybe HeadObservation
-> Maybe HeadObservation -> Maybe HeadObservation
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AbortObservation -> HeadObservation
Abort (AbortObservation -> HeadObservation)
-> Maybe AbortObservation -> Maybe HeadObservation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxO -> Tx -> Maybe AbortObservation
observeAbortTx UTxO
utxo Tx
tx
      Maybe HeadObservation
-> Maybe HeadObservation -> Maybe HeadObservation
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CommitObservation -> HeadObservation
Commit (CommitObservation -> HeadObservation)
-> Maybe CommitObservation -> Maybe HeadObservation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NetworkId -> UTxO -> Tx -> Maybe CommitObservation
observeCommitTx NetworkId
networkId UTxO
utxo Tx
tx
      Maybe HeadObservation
-> Maybe HeadObservation -> Maybe HeadObservation
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CollectComObservation -> HeadObservation
CollectCom (CollectComObservation -> HeadObservation)
-> Maybe CollectComObservation -> Maybe HeadObservation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxO -> Tx -> Maybe CollectComObservation
observeCollectComTx UTxO
utxo Tx
tx
      Maybe HeadObservation
-> Maybe HeadObservation -> Maybe HeadObservation
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DepositObservation -> HeadObservation
Deposit (DepositObservation -> HeadObservation)
-> Maybe DepositObservation -> Maybe HeadObservation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NetworkId -> Tx -> Maybe DepositObservation
observeDepositTx NetworkId
networkId Tx
tx
      Maybe HeadObservation
-> Maybe HeadObservation -> Maybe HeadObservation
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RecoverObservation -> HeadObservation
Recover (RecoverObservation -> HeadObservation)
-> Maybe RecoverObservation -> Maybe HeadObservation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NetworkId -> UTxO -> Tx -> Maybe RecoverObservation
observeRecoverTx NetworkId
networkId UTxO
utxo Tx
tx
      Maybe HeadObservation
-> Maybe HeadObservation -> Maybe HeadObservation
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IncrementObservation -> HeadObservation
Increment (IncrementObservation -> HeadObservation)
-> Maybe IncrementObservation -> Maybe HeadObservation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxO -> Tx -> Maybe IncrementObservation
observeIncrementTx UTxO
utxo Tx
tx
      Maybe HeadObservation
-> Maybe HeadObservation -> Maybe HeadObservation
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DecrementObservation -> HeadObservation
Decrement (DecrementObservation -> HeadObservation)
-> Maybe DecrementObservation -> Maybe HeadObservation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxO -> Tx -> Maybe DecrementObservation
observeDecrementTx UTxO
utxo Tx
tx
      Maybe HeadObservation
-> Maybe HeadObservation -> Maybe HeadObservation
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CloseObservation -> HeadObservation
Close (CloseObservation -> HeadObservation)
-> Maybe CloseObservation -> Maybe HeadObservation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxO -> Tx -> Maybe CloseObservation
observeCloseTx UTxO
utxo Tx
tx
      Maybe HeadObservation
-> Maybe HeadObservation -> Maybe HeadObservation
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ContestObservation -> HeadObservation
Contest (ContestObservation -> HeadObservation)
-> Maybe ContestObservation -> Maybe HeadObservation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxO -> Tx -> Maybe ContestObservation
observeContestTx UTxO
utxo Tx
tx
      Maybe HeadObservation
-> Maybe HeadObservation -> Maybe HeadObservation
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FanoutObservation -> HeadObservation
Fanout (FanoutObservation -> HeadObservation)
-> Maybe FanoutObservation -> Maybe HeadObservation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxO -> Tx -> Maybe FanoutObservation
observeFanoutTx UTxO
utxo Tx
tx