module Hydra.Tx.Deposit where

import Hydra.Prelude

import Cardano.Api.UTxO qualified as UTxO
import Cardano.Ledger.Api (bodyTxL, inputsTxBodyL, outputsTxBodyL)
import Control.Lens ((.~), (^.))
import Data.Sequence.Strict qualified as StrictSeq
import Data.Set qualified as Set
import Hydra.Cardano.Api
import Hydra.Cardano.Api.Network (Network)
import Hydra.Contract.Commit qualified as Commit
import Hydra.Contract.Deposit qualified as Deposit
import Hydra.Plutus.Extras.Time (posixFromUTCTime)
import Hydra.Tx (CommitBlueprintTx (..), HeadId, fromCurrencySymbol, headIdToCurrencySymbol)
import Hydra.Tx.Utils (addMetadata, mkHydraHeadV1TxName)
import PlutusLedgerApi.V3 (POSIXTime)

-- * Construction

-- | Builds a deposit transaction to lock funds into the v_deposit script.
depositTx ::
  NetworkId ->
  HeadId ->
  CommitBlueprintTx Tx ->
  -- | Deposit deadline
  UTCTime ->
  Tx
depositTx :: NetworkId -> HeadId -> CommitBlueprintTx Tx -> UTCTime -> Tx
depositTx NetworkId
networkId HeadId
headId CommitBlueprintTx Tx
commitBlueprintTx UTCTime
deadline =
  Tx (ShelleyLedgerEra Era) -> Tx
forall era.
IsShelleyBasedEra era =>
Tx (ShelleyLedgerEra era) -> Tx era
fromLedgerTx (Tx (ShelleyLedgerEra Era) -> Tx)
-> Tx (ShelleyLedgerEra Era) -> Tx
forall a b. (a -> b) -> a -> b
$
    Tx -> Tx (ShelleyLedgerEra Era)
forall era. Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx Tx
blueprintTx
      Tx (ConwayEra StandardCrypto)
-> (Tx (ConwayEra StandardCrypto) -> Tx (ConwayEra StandardCrypto))
-> Tx (ConwayEra StandardCrypto)
forall a b. a -> (a -> b) -> b
& Tx (ConwayEra StandardCrypto) -> Tx (ConwayEra StandardCrypto)
addDepositInputs
      Tx (ConwayEra StandardCrypto)
-> (Tx (ConwayEra StandardCrypto)
    -> AlonzoTx (ConwayEra StandardCrypto))
-> AlonzoTx (ConwayEra StandardCrypto)
forall a b. a -> (a -> b) -> b
& (TxBody (ConwayEra StandardCrypto)
 -> Identity (TxBody (ConwayEra StandardCrypto)))
-> Tx (ConwayEra StandardCrypto)
-> Identity (Tx (ConwayEra StandardCrypto))
(TxBody (ConwayEra StandardCrypto)
 -> Identity (TxBody (ConwayEra StandardCrypto)))
-> Tx (ConwayEra StandardCrypto)
-> Identity (AlonzoTx (ConwayEra StandardCrypto))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens'
  (Tx (ConwayEra StandardCrypto)) (TxBody (ConwayEra StandardCrypto))
bodyTxL ((TxBody (ConwayEra StandardCrypto)
  -> Identity (TxBody (ConwayEra StandardCrypto)))
 -> Tx (ConwayEra StandardCrypto)
 -> Identity (AlonzoTx (ConwayEra StandardCrypto)))
-> ((StrictSeq (TxOut (ConwayEra StandardCrypto))
     -> Identity (StrictSeq (TxOut (ConwayEra StandardCrypto))))
    -> TxBody (ConwayEra StandardCrypto)
    -> Identity (TxBody (ConwayEra StandardCrypto)))
-> (StrictSeq (TxOut (ConwayEra StandardCrypto))
    -> Identity (StrictSeq (TxOut (ConwayEra StandardCrypto))))
-> Tx (ConwayEra StandardCrypto)
-> Identity (AlonzoTx (ConwayEra StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxOut (ConwayEra StandardCrypto))
 -> Identity (StrictSeq (TxOut (ConwayEra StandardCrypto))))
-> TxBody (ConwayEra StandardCrypto)
-> Identity (TxBody (ConwayEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (StrictSeq (TxOut (ConwayEra StandardCrypto)))
outputsTxBodyL ((StrictSeq (TxOut (ConwayEra StandardCrypto))
  -> Identity (StrictSeq (TxOut (ConwayEra StandardCrypto))))
 -> Tx (ConwayEra StandardCrypto)
 -> Identity (AlonzoTx (ConwayEra StandardCrypto)))
-> StrictSeq (TxOut (ConwayEra StandardCrypto))
-> Tx (ConwayEra StandardCrypto)
-> AlonzoTx (ConwayEra StandardCrypto)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxOut (ConwayEra StandardCrypto)
-> StrictSeq (TxOut (ConwayEra StandardCrypto))
forall a. a -> StrictSeq a
StrictSeq.singleton (TxOut CtxUTxO Era -> TxOut (ShelleyLedgerEra Era)
forall era.
IsShelleyBasedEra era =>
TxOut CtxUTxO era -> TxOut (ShelleyLedgerEra era)
toLedgerTxOut TxOut CtxUTxO Era
depositOutput)
      AlonzoTx (ConwayEra StandardCrypto)
-> (AlonzoTx (ConwayEra StandardCrypto)
    -> AlonzoTx (ConwayEra StandardCrypto))
-> AlonzoTx (ConwayEra StandardCrypto)
forall a b. a -> (a -> b) -> b
& TxMetadata
-> Tx
-> AlonzoTx (ConwayEra StandardCrypto)
-> AlonzoTx (ConwayEra StandardCrypto)
addMetadata (Text -> TxMetadata
mkHydraHeadV1TxName Text
"DepositTx") Tx
blueprintTx
 where
  addDepositInputs :: Tx (ConwayEra StandardCrypto) -> Tx (ConwayEra StandardCrypto)
addDepositInputs Tx (ConwayEra StandardCrypto)
tx =
    let newInputs :: Set (TxIn StandardCrypto)
newInputs = Tx (ConwayEra StandardCrypto)
tx Tx (ConwayEra StandardCrypto)
-> Getting
     (Set (TxIn StandardCrypto))
     (Tx (ConwayEra StandardCrypto))
     (Set (TxIn StandardCrypto))
-> Set (TxIn StandardCrypto)
forall s a. s -> Getting a s a -> a
^. (TxBody (ConwayEra StandardCrypto)
 -> Const
      (Set (TxIn StandardCrypto)) (TxBody (ConwayEra StandardCrypto)))
-> Tx (ConwayEra StandardCrypto)
-> Const
     (Set (TxIn StandardCrypto)) (Tx (ConwayEra StandardCrypto))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens'
  (Tx (ConwayEra StandardCrypto)) (TxBody (ConwayEra StandardCrypto))
bodyTxL ((TxBody (ConwayEra StandardCrypto)
  -> Const
       (Set (TxIn StandardCrypto)) (TxBody (ConwayEra StandardCrypto)))
 -> Tx (ConwayEra StandardCrypto)
 -> Const
      (Set (TxIn StandardCrypto)) (Tx (ConwayEra StandardCrypto)))
-> ((Set (TxIn StandardCrypto)
     -> Const (Set (TxIn StandardCrypto)) (Set (TxIn StandardCrypto)))
    -> TxBody (ConwayEra StandardCrypto)
    -> Const
         (Set (TxIn StandardCrypto)) (TxBody (ConwayEra StandardCrypto)))
-> Getting
     (Set (TxIn StandardCrypto))
     (Tx (ConwayEra StandardCrypto))
     (Set (TxIn StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (TxIn StandardCrypto)
 -> Const (Set (TxIn StandardCrypto)) (Set (TxIn StandardCrypto)))
-> TxBody (ConwayEra StandardCrypto)
-> Const
     (Set (TxIn StandardCrypto)) (TxBody (ConwayEra StandardCrypto))
(Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
 -> Const
      (Set (TxIn StandardCrypto))
      (Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))))
-> TxBody (ConwayEra StandardCrypto)
-> Const
     (Set (TxIn StandardCrypto)) (TxBody (ConwayEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
inputsTxBodyL Set (TxIn StandardCrypto)
-> Set (TxIn StandardCrypto) -> Set (TxIn StandardCrypto)
forall a. Semigroup a => a -> a -> a
<> [TxIn StandardCrypto] -> Set (TxIn StandardCrypto)
forall a. Ord a => [a] -> Set a
Set.fromList (TxIn -> TxIn StandardCrypto
toLedgerTxIn (TxIn -> TxIn StandardCrypto)
-> ((TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn)) -> TxIn)
-> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn))
-> TxIn StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn)) -> TxIn
forall a b. (a, b) -> a
fst ((TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn))
 -> TxIn StandardCrypto)
-> [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn))]
-> [TxIn StandardCrypto]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn))]
depositInputs)
     in Tx (ConwayEra StandardCrypto)
tx Tx (ConwayEra StandardCrypto)
-> (Tx (ConwayEra StandardCrypto) -> Tx (ConwayEra StandardCrypto))
-> Tx (ConwayEra StandardCrypto)
forall a b. a -> (a -> b) -> b
& (TxBody (ConwayEra StandardCrypto)
 -> Identity (TxBody (ConwayEra StandardCrypto)))
-> Tx (ConwayEra StandardCrypto)
-> Identity (Tx (ConwayEra StandardCrypto))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens'
  (Tx (ConwayEra StandardCrypto)) (TxBody (ConwayEra StandardCrypto))
bodyTxL ((TxBody (ConwayEra StandardCrypto)
  -> Identity (TxBody (ConwayEra StandardCrypto)))
 -> Tx (ConwayEra StandardCrypto)
 -> Identity (Tx (ConwayEra StandardCrypto)))
-> ((Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
     -> Identity (Set (TxIn StandardCrypto)))
    -> TxBody (ConwayEra StandardCrypto)
    -> Identity (TxBody (ConwayEra StandardCrypto)))
-> (Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
    -> Identity (Set (TxIn StandardCrypto)))
-> Tx (ConwayEra StandardCrypto)
-> Identity (Tx (ConwayEra StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
 -> Identity (Set (TxIn StandardCrypto)))
-> TxBody (ConwayEra StandardCrypto)
-> Identity (TxBody (ConwayEra StandardCrypto))
(Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
 -> Identity (Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))))
-> TxBody (ConwayEra StandardCrypto)
-> Identity (TxBody (ConwayEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
inputsTxBodyL ((Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
  -> Identity (Set (TxIn StandardCrypto)))
 -> Tx (ConwayEra StandardCrypto)
 -> Identity (Tx (ConwayEra StandardCrypto)))
-> Set (TxIn StandardCrypto)
-> Tx (ConwayEra StandardCrypto)
-> Tx (ConwayEra StandardCrypto)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (TxIn StandardCrypto)
newInputs

  CommitBlueprintTx{$sel:lookupUTxO:CommitBlueprintTx :: forall tx. CommitBlueprintTx tx -> UTxOType tx
lookupUTxO = UTxOType Tx
depositUTxO, Tx
blueprintTx :: Tx
$sel:blueprintTx:CommitBlueprintTx :: forall tx. CommitBlueprintTx tx -> tx
blueprintTx} = CommitBlueprintTx Tx
commitBlueprintTx

  depositInputsList :: [TxIn]
depositInputsList = Set TxIn -> [TxIn]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (UTxO' (TxOut CtxUTxO Era) -> Set TxIn
forall out. UTxO' out -> Set TxIn
UTxO.inputSet UTxO' (TxOut CtxUTxO Era)
UTxOType Tx
depositUTxO)

  depositInputs :: [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn))]
depositInputs = (,Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn))
-> Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn)
forall a b. (a -> b) -> a -> b
$ KeyWitnessInCtx WitCtxTxIn -> Witness WitCtxTxIn
forall ctx. KeyWitnessInCtx ctx -> Witness ctx
KeyWitness KeyWitnessInCtx WitCtxTxIn
KeyWitnessForSpending) (TxIn -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn)))
-> [TxIn] -> [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxIn]
depositInputsList

  depositValue :: Value
depositValue = (TxOut CtxUTxO Era -> Value) -> UTxO' (TxOut CtxUTxO Era) -> Value
forall m a. Monoid m => (a -> m) -> UTxO' a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut CtxUTxO Era -> Value
forall ctx. TxOut ctx -> Value
txOutValue UTxO' (TxOut CtxUTxO Era)
UTxOType Tx
depositUTxO

  depositScript :: PlutusScript PlutusScriptV3
depositScript = forall lang. SerialisedScript -> PlutusScript lang
fromPlutusScript @PlutusScriptV3 SerialisedScript
Deposit.validatorScript

  deposits :: [Commit]
deposits = ((TxIn, TxOut CtxUTxO Era) -> Maybe Commit)
-> [(TxIn, TxOut CtxUTxO Era)] -> [Commit]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (TxIn, TxOut CtxUTxO Era) -> Maybe Commit
Commit.serializeCommit ([(TxIn, TxOut CtxUTxO Era)] -> [Commit])
-> [(TxIn, TxOut CtxUTxO Era)] -> [Commit]
forall a b. (a -> b) -> a -> b
$ UTxO' (TxOut CtxUTxO Era) -> [(TxIn, TxOut CtxUTxO Era)]
forall out. UTxO' out -> [(TxIn, out)]
UTxO.pairs UTxO' (TxOut CtxUTxO Era)
UTxOType Tx
depositUTxO

  depositPlutusDatum :: Datum
depositPlutusDatum = DepositDatum -> Datum
Deposit.datum (DepositDatum -> Datum) -> DepositDatum -> Datum
forall a b. (a -> b) -> a -> b
$ (CurrencySymbol, POSIXTime, [Commit]) -> DepositDatum
Deposit.DepositDatum (HeadId -> CurrencySymbol
headIdToCurrencySymbol HeadId
headId, UTCTime -> POSIXTime
posixFromUTCTime UTCTime
deadline, [Commit]
deposits)

  depositDatum :: TxOutDatum CtxUTxO Era
depositDatum = Datum -> TxOutDatum CtxUTxO Era
forall era a ctx.
(ToScriptData a, IsBabbageBasedEra era) =>
a -> TxOutDatum ctx era
mkTxOutDatumInline Datum
depositPlutusDatum

  depositOutput :: TxOut CtxUTxO Era
depositOutput =
    AddressInEra
-> Value
-> TxOutDatum CtxUTxO Era
-> ReferenceScript
-> TxOut CtxUTxO Era
forall ctx.
AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut
      (forall lang era.
(IsShelleyBasedEra era, IsPlutusScriptLanguage lang) =>
NetworkId -> PlutusScript lang -> AddressInEra era
mkScriptAddress @PlutusScriptV3 NetworkId
networkId PlutusScript PlutusScriptV3
depositScript)
      Value
depositValue
      TxOutDatum CtxUTxO Era
depositDatum
      ReferenceScript
ReferenceScriptNone

-- * Observation

data DepositObservation = DepositObservation
  { DepositObservation -> HeadId
headId :: HeadId
  , DepositObservation -> UTxO' (TxOut CtxUTxO Era)
deposited :: UTxO
  , DepositObservation -> TxId
depositTxId :: TxId
  , DepositObservation -> POSIXTime
deadline :: POSIXTime
  }
  deriving stock (Int -> DepositObservation -> ShowS
[DepositObservation] -> ShowS
DepositObservation -> String
(Int -> DepositObservation -> ShowS)
-> (DepositObservation -> String)
-> ([DepositObservation] -> ShowS)
-> Show DepositObservation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DepositObservation -> ShowS
showsPrec :: Int -> DepositObservation -> ShowS
$cshow :: DepositObservation -> String
show :: DepositObservation -> String
$cshowList :: [DepositObservation] -> ShowS
showList :: [DepositObservation] -> ShowS
Show, DepositObservation -> DepositObservation -> Bool
(DepositObservation -> DepositObservation -> Bool)
-> (DepositObservation -> DepositObservation -> Bool)
-> Eq DepositObservation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DepositObservation -> DepositObservation -> Bool
== :: DepositObservation -> DepositObservation -> Bool
$c/= :: DepositObservation -> DepositObservation -> Bool
/= :: DepositObservation -> DepositObservation -> Bool
Eq, (forall x. DepositObservation -> Rep DepositObservation x)
-> (forall x. Rep DepositObservation x -> DepositObservation)
-> Generic DepositObservation
forall x. Rep DepositObservation x -> DepositObservation
forall x. DepositObservation -> Rep DepositObservation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DepositObservation -> Rep DepositObservation x
from :: forall x. DepositObservation -> Rep DepositObservation x
$cto :: forall x. Rep DepositObservation x -> DepositObservation
to :: forall x. Rep DepositObservation x -> DepositObservation
Generic)

observeDepositTx ::
  NetworkId ->
  Tx ->
  Maybe DepositObservation
observeDepositTx :: NetworkId -> Tx -> Maybe DepositObservation
observeDepositTx NetworkId
networkId Tx
tx = do
  -- TODO: could just use the first output and fail otherwise
  (TxIn TxId
depositTxId TxIx
_, TxOut CtxTx Era
depositOut) <- AddressInEra -> Tx -> Maybe (TxIn, TxOut CtxTx Era)
forall era.
AddressInEra era -> Tx era -> Maybe (TxIn, TxOut CtxTx era)
findTxOutByAddress AddressInEra
depositAddress Tx
tx
  (HeadId
headId, UTxO' (TxOut CtxUTxO Era)
deposited, POSIXTime
deadline) <- Network
-> TxOut CtxUTxO Era
-> Maybe (HeadId, UTxO' (TxOut CtxUTxO Era), POSIXTime)
observeDepositTxOut (NetworkId -> Network
networkIdToNetwork NetworkId
networkId) (TxOut CtxTx Era -> TxOut CtxUTxO Era
forall era. TxOut CtxTx era -> TxOut CtxUTxO era
forall {k} (f :: * -> k -> *) (era :: k).
ToUTxOContext f =>
f CtxTx era -> f CtxUTxO era
toUTxOContext TxOut CtxTx Era
depositOut)
  if (TxIn -> Bool) -> Set TxIn -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TxIn -> [TxIn] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` Tx -> [TxIn]
forall era. Tx era -> [TxIn]
txIns' Tx
tx) (UTxO' (TxOut CtxUTxO Era) -> Set TxIn
forall out. UTxO' out -> Set TxIn
UTxO.inputSet UTxO' (TxOut CtxUTxO Era)
deposited)
    then
      DepositObservation -> Maybe DepositObservation
forall a. a -> Maybe a
Just
        DepositObservation
          { HeadId
$sel:headId:DepositObservation :: HeadId
headId :: HeadId
headId
          , UTxO' (TxOut CtxUTxO Era)
$sel:deposited:DepositObservation :: UTxO' (TxOut CtxUTxO Era)
deposited :: UTxO' (TxOut CtxUTxO Era)
deposited
          , TxId
$sel:depositTxId:DepositObservation :: TxId
depositTxId :: TxId
depositTxId
          , POSIXTime
$sel:deadline:DepositObservation :: POSIXTime
deadline :: POSIXTime
deadline
          }
    else Maybe DepositObservation
forall a. Maybe a
Nothing
 where
  depositScript :: PlutusScript lang
depositScript = SerialisedScript -> PlutusScript lang
forall lang. SerialisedScript -> PlutusScript lang
fromPlutusScript SerialisedScript
Deposit.validatorScript

  depositAddress :: AddressInEra
depositAddress = forall lang era.
(IsShelleyBasedEra era, IsPlutusScriptLanguage lang) =>
NetworkId -> PlutusScript lang -> AddressInEra era
mkScriptAddress @PlutusScriptV3 NetworkId
networkId PlutusScript PlutusScriptV3
forall {lang}. PlutusScript lang
depositScript

observeDepositTxOut :: Network -> TxOut CtxUTxO -> Maybe (HeadId, UTxO, POSIXTime)
observeDepositTxOut :: Network
-> TxOut CtxUTxO Era
-> Maybe (HeadId, UTxO' (TxOut CtxUTxO Era), POSIXTime)
observeDepositTxOut Network
network TxOut CtxUTxO Era
depositOut = do
  HashableScriptData
dat <- case TxOut CtxUTxO Era -> TxOutDatum CtxUTxO Era
forall ctx. TxOut ctx -> TxOutDatum ctx
txOutDatum TxOut CtxUTxO Era
depositOut of
    TxOutDatumInline HashableScriptData
d -> HashableScriptData -> Maybe HashableScriptData
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashableScriptData
d
    TxOutDatum CtxUTxO Era
_ -> Maybe HashableScriptData
forall a. Maybe a
Nothing
  Deposit.DepositDatum (CurrencySymbol
headCurrencySymbol, POSIXTime
deadline, [Commit]
onChainDeposits) <- HashableScriptData -> Maybe DepositDatum
forall a. FromScriptData a => HashableScriptData -> Maybe a
fromScriptData HashableScriptData
dat
  UTxO' (TxOut CtxUTxO Era)
deposit <- do
    [(TxIn, TxOut CtxUTxO Era)]
depositedUTxO <- (Commit -> Maybe (TxIn, TxOut CtxUTxO Era))
-> [Commit] -> Maybe [(TxIn, TxOut CtxUTxO Era)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Network -> Commit -> Maybe (TxIn, TxOut CtxUTxO Era)
Commit.deserializeCommit Network
network) [Commit]
onChainDeposits
    UTxO' (TxOut CtxUTxO Era) -> Maybe (UTxO' (TxOut CtxUTxO Era))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTxO' (TxOut CtxUTxO Era) -> Maybe (UTxO' (TxOut CtxUTxO Era)))
-> ([(TxIn, TxOut CtxUTxO Era)] -> UTxO' (TxOut CtxUTxO Era))
-> [(TxIn, TxOut CtxUTxO Era)]
-> Maybe (UTxO' (TxOut CtxUTxO Era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TxIn, TxOut CtxUTxO Era)] -> UTxO' (TxOut CtxUTxO Era)
forall out. [(TxIn, out)] -> UTxO' out
UTxO.fromPairs ([(TxIn, TxOut CtxUTxO Era)] -> Maybe (UTxO' (TxOut CtxUTxO Era)))
-> [(TxIn, TxOut CtxUTxO Era)] -> Maybe (UTxO' (TxOut CtxUTxO Era))
forall a b. (a -> b) -> a -> b
$ [(TxIn, TxOut CtxUTxO Era)]
depositedUTxO
  HeadId
headId <- CurrencySymbol -> Maybe HeadId
forall (m :: * -> *). MonadFail m => CurrencySymbol -> m HeadId
fromCurrencySymbol CurrencySymbol
headCurrencySymbol
  (HeadId, UTxO' (TxOut CtxUTxO Era), POSIXTime)
-> Maybe (HeadId, UTxO' (TxOut CtxUTxO Era), POSIXTime)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HeadId
headId, UTxO' (TxOut CtxUTxO Era)
deposit, POSIXTime
deadline)