module Hydra.Tx.Commit where

import Hydra.Cardano.Api
import Hydra.Prelude

import Cardano.Api.UTxO qualified as UTxO
import Cardano.Ledger.Alonzo.Core (AsIxItem (..))
import Cardano.Ledger.Api (
  AsIx (..),
  ConwayPlutusPurpose (..),
  Redeemers (..),
  bodyTxL,
  inputsTxBodyL,
  mintTxBodyL,
  outputsTxBodyL,
  rdmrsTxWitsL,
  redeemerPointerInverse,
  referenceInputsTxBodyL,
  reqSignerHashesTxBodyL,
  unRedeemers,
  witsTxL,
 )
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.Plutus.ExUnits (ExUnits (..))
import Control.Lens ((.~), (<>~), (^.))
import Data.Map qualified as Map
import Data.Sequence.Strict qualified as StrictSeq
import Data.Set qualified as Set
import Hydra.Contract.Commit qualified as Commit
import Hydra.Contract.Initial qualified as Initial
import Hydra.Plutus (commitValidatorScript, initialValidatorScript)
import Hydra.Tx.BlueprintTx (CommitBlueprintTx (..))
import Hydra.Tx.HeadId (HeadId, headIdToCurrencySymbol, mkHeadId)
import Hydra.Tx.Party (Party, partyFromChain, partyToChain)
import Hydra.Tx.ScriptRegistry (ScriptRegistry, initialReference)
import Hydra.Tx.Utils (addMetadata, mkHydraHeadV1TxName)
import PlutusLedgerApi.V3 (CurrencySymbol)
import PlutusLedgerApi.V3 qualified as Plutus

-- * Construction

-- | Craft a commit transaction which includes the "committed" utxo as a datum.
commitTx ::
  NetworkId ->
  -- | Published Hydra scripts to reference.
  ScriptRegistry ->
  HeadId ->
  Party ->
  CommitBlueprintTx Tx ->
  -- | The initial output (sent to each party) which should contain the PT and is
  -- locked by initial script
  (TxIn, TxOut CtxUTxO, Hash PaymentKey) ->
  Tx
commitTx :: NetworkId
-> ScriptRegistry
-> HeadId
-> Party
-> CommitBlueprintTx Tx
-> (TxIn, TxOut CtxUTxO, Hash PaymentKey)
-> Tx
commitTx NetworkId
networkId ScriptRegistry
scriptRegistry HeadId
headId Party
party CommitBlueprintTx Tx
commitBlueprintTx (TxIn
initialInput, TxOut CtxUTxO
out, Hash PaymentKey
vkh) =
  -- NOTE: We use the cardano-ledger-api functions here such that we can use the
  -- blueprint transaction as a starting point (cardano-api does not allow
  -- convenient transaction modifications).
  Tx LedgerEra -> Tx
forall era.
IsShelleyBasedEra era =>
Tx (ShelleyLedgerEra era) -> Tx era
fromLedgerTx (Tx LedgerEra -> Tx) -> Tx LedgerEra -> Tx
forall a b. (a -> b) -> a -> b
$
    Tx -> Tx LedgerEra
forall era. Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx Tx
blueprintTx
      Tx ConwayEra
-> (Tx ConwayEra -> AlonzoTx ConwayEra) -> AlonzoTx ConwayEra
forall a b. a -> (a -> b) -> b
& Tx ConwayEra -> AlonzoTx ConwayEra
spendFromInitial
      AlonzoTx ConwayEra
-> (AlonzoTx ConwayEra -> AlonzoTx ConwayEra) -> AlonzoTx ConwayEra
forall a b. a -> (a -> b) -> b
& (TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> Tx ConwayEra -> Identity (Tx ConwayEra)
(TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx ConwayEra) (TxBody ConwayEra)
bodyTxL ((TxBody ConwayEra -> Identity (TxBody ConwayEra))
 -> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra))
-> ((StrictSeq (TxOut ConwayEra)
     -> Identity (StrictSeq (TxOut ConwayEra)))
    -> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> (StrictSeq (TxOut ConwayEra)
    -> Identity (StrictSeq (TxOut ConwayEra)))
-> AlonzoTx ConwayEra
-> Identity (AlonzoTx ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxOut ConwayEra)
 -> Identity (StrictSeq (TxOut ConwayEra)))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody ConwayEra) (StrictSeq (TxOut ConwayEra))
outputsTxBodyL ((StrictSeq (TxOut ConwayEra)
  -> Identity (StrictSeq (TxOut ConwayEra)))
 -> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra))
-> StrictSeq (TxOut ConwayEra)
-> AlonzoTx ConwayEra
-> AlonzoTx ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxOut ConwayEra -> StrictSeq (TxOut ConwayEra)
forall a. a -> StrictSeq a
StrictSeq.singleton (TxOut CtxUTxO -> TxOut LedgerEra
forall era.
IsShelleyBasedEra era =>
TxOut CtxUTxO era -> TxOut (ShelleyLedgerEra era)
toLedgerTxOut TxOut CtxUTxO
commitOutput)
      AlonzoTx ConwayEra
-> (AlonzoTx ConwayEra -> AlonzoTx ConwayEra) -> AlonzoTx ConwayEra
forall a b. a -> (a -> b) -> b
& (TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> Tx ConwayEra -> Identity (Tx ConwayEra)
(TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx ConwayEra) (TxBody ConwayEra)
bodyTxL ((TxBody ConwayEra -> Identity (TxBody ConwayEra))
 -> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra))
-> ((MultiAsset -> Identity MultiAsset)
    -> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> (MultiAsset -> Identity MultiAsset)
-> AlonzoTx ConwayEra
-> Identity (AlonzoTx ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MultiAsset -> Identity MultiAsset)
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era. MaryEraTxBody era => Lens' (TxBody era) MultiAsset
Lens' (TxBody ConwayEra) MultiAsset
mintTxBodyL ((MultiAsset -> Identity MultiAsset)
 -> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra))
-> MultiAsset -> AlonzoTx ConwayEra -> AlonzoTx ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ MultiAsset
forall a. Monoid a => a
mempty
      AlonzoTx ConwayEra
-> (AlonzoTx ConwayEra -> AlonzoTx ConwayEra) -> AlonzoTx ConwayEra
forall a b. a -> (a -> b) -> b
& TxMetadata -> Tx -> AlonzoTx ConwayEra -> AlonzoTx ConwayEra
addMetadata (Text -> TxMetadata
mkHydraHeadV1TxName Text
"CommitTx") Tx
blueprintTx
 where
  spendFromInitial :: Tx ConwayEra -> AlonzoTx ConwayEra
spendFromInitial Tx ConwayEra
tx =
    let newRedeemers :: Map TxIn (Data ConwayEra)
newRedeemers =
          Tx ConwayEra -> Map TxIn (Data ConwayEra)
forall {era} {era}.
(PlutusPurpose AsIxItem era ~ ConwayPlutusPurpose AsIxItem era,
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraTxBody era, EraTx era, AlonzoEraTxWits era,
 EraPParams era, Eq (TxCert era), Show (TxCert era),
 NFData (TxCert era), NoThunks (TxCert era)) =>
Tx era -> Map TxIn (Data era)
resolveSpendingRedeemers Tx ConwayEra
tx
            Map TxIn (Data ConwayEra)
-> (Map TxIn (Data ConwayEra) -> Map TxIn (Data ConwayEra))
-> Map TxIn (Data ConwayEra)
forall a b. a -> (a -> b) -> b
& TxIn
-> Data ConwayEra
-> Map TxIn (Data ConwayEra)
-> Map TxIn (Data ConwayEra)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (TxIn -> TxIn
toLedgerTxIn TxIn
initialInput) (forall era. Era era => HashableScriptData -> Data era
toLedgerData @LedgerEra HashableScriptData
initialRedeemer)
        newInputs :: Set TxIn
newInputs = Tx ConwayEra
tx Tx ConwayEra
-> Getting (Set TxIn) (Tx ConwayEra) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. (TxBody ConwayEra -> Const (Set TxIn) (TxBody ConwayEra))
-> Tx ConwayEra -> Const (Set TxIn) (Tx ConwayEra)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx ConwayEra) (TxBody ConwayEra)
bodyTxL ((TxBody ConwayEra -> Const (Set TxIn) (TxBody ConwayEra))
 -> Tx ConwayEra -> Const (Set TxIn) (Tx ConwayEra))
-> ((Set TxIn -> Const (Set TxIn) (Set TxIn))
    -> TxBody ConwayEra -> Const (Set TxIn) (TxBody ConwayEra))
-> Getting (Set TxIn) (Tx ConwayEra) (Set TxIn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxIn -> Const (Set TxIn) (Set TxIn))
-> TxBody ConwayEra -> Const (Set TxIn) (TxBody ConwayEra)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody ConwayEra) (Set TxIn)
inputsTxBodyL Set TxIn -> Set TxIn -> Set TxIn
forall a. Semigroup a => a -> a -> a
<> TxIn -> Set TxIn
forall a. a -> Set a
Set.singleton (TxIn -> TxIn
toLedgerTxIn TxIn
initialInput)
     in Tx ConwayEra
tx
          Tx ConwayEra
-> (Tx ConwayEra -> AlonzoTx ConwayEra) -> AlonzoTx ConwayEra
forall a b. a -> (a -> b) -> b
& (TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> Tx ConwayEra -> Identity (Tx ConwayEra)
(TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> Tx ConwayEra -> Identity (AlonzoTx ConwayEra)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx ConwayEra) (TxBody ConwayEra)
bodyTxL ((TxBody ConwayEra -> Identity (TxBody ConwayEra))
 -> Tx ConwayEra -> Identity (AlonzoTx ConwayEra))
-> ((Set TxIn -> Identity (Set TxIn))
    -> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> (Set TxIn -> Identity (Set TxIn))
-> Tx ConwayEra
-> Identity (AlonzoTx ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxIn -> Identity (Set TxIn))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody ConwayEra) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> Tx ConwayEra -> Identity (AlonzoTx ConwayEra))
-> Set TxIn -> Tx ConwayEra -> AlonzoTx ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
newInputs
          AlonzoTx ConwayEra
-> (AlonzoTx ConwayEra -> AlonzoTx ConwayEra) -> AlonzoTx ConwayEra
forall a b. a -> (a -> b) -> b
& (TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> Tx ConwayEra -> Identity (Tx ConwayEra)
(TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx ConwayEra) (TxBody ConwayEra)
bodyTxL ((TxBody ConwayEra -> Identity (TxBody ConwayEra))
 -> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra))
-> ((Set TxIn -> Identity (Set TxIn))
    -> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> (Set TxIn -> Identity (Set TxIn))
-> AlonzoTx ConwayEra
-> Identity (AlonzoTx ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxIn -> Identity (Set TxIn))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody ConwayEra) (Set TxIn)
referenceInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra))
-> Set TxIn -> AlonzoTx ConwayEra -> AlonzoTx ConwayEra
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ TxIn -> Set TxIn
forall a. a -> Set a
Set.singleton (TxIn -> TxIn
toLedgerTxIn TxIn
initialScriptRef)
          AlonzoTx ConwayEra
-> (AlonzoTx ConwayEra -> AlonzoTx ConwayEra) -> AlonzoTx ConwayEra
forall a b. a -> (a -> b) -> b
& (TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> Tx ConwayEra -> Identity (Tx ConwayEra)
(TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx ConwayEra) (TxBody ConwayEra)
bodyTxL ((TxBody ConwayEra -> Identity (TxBody ConwayEra))
 -> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra))
-> ((Set (KeyHash 'Witness) -> Identity (Set (KeyHash 'Witness)))
    -> TxBody ConwayEra -> Identity (TxBody ConwayEra))
-> (Set (KeyHash 'Witness) -> Identity (Set (KeyHash 'Witness)))
-> AlonzoTx ConwayEra
-> Identity (AlonzoTx ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (KeyHash 'Witness) -> Identity (Set (KeyHash 'Witness)))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (KeyHash 'Witness))
Lens' (TxBody ConwayEra) (Set (KeyHash 'Witness))
reqSignerHashesTxBodyL ((Set (KeyHash 'Witness) -> Identity (Set (KeyHash 'Witness)))
 -> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra))
-> Set (KeyHash 'Witness)
-> AlonzoTx ConwayEra
-> AlonzoTx ConwayEra
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ KeyHash 'Witness -> Set (KeyHash 'Witness)
forall a. a -> Set a
Set.singleton (Hash PaymentKey -> KeyHash 'Witness
toLedgerKeyHash Hash PaymentKey
vkh)
          AlonzoTx ConwayEra
-> (AlonzoTx ConwayEra -> AlonzoTx ConwayEra) -> AlonzoTx ConwayEra
forall a b. a -> (a -> b) -> b
& (TxWits ConwayEra -> Identity (TxWits ConwayEra))
-> Tx ConwayEra -> Identity (Tx ConwayEra)
(TxWits ConwayEra -> Identity (TxWits ConwayEra))
-> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx ConwayEra) (TxWits ConwayEra)
witsTxL ((TxWits ConwayEra -> Identity (TxWits ConwayEra))
 -> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra))
-> ((Redeemers ConwayEra -> Identity (Redeemers ConwayEra))
    -> TxWits ConwayEra -> Identity (TxWits ConwayEra))
-> (Redeemers ConwayEra -> Identity (Redeemers ConwayEra))
-> AlonzoTx ConwayEra
-> Identity (AlonzoTx ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers ConwayEra -> Identity (Redeemers ConwayEra))
-> TxWits ConwayEra -> Identity (TxWits ConwayEra)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits ConwayEra) (Redeemers ConwayEra)
rdmrsTxWitsL
            ((Redeemers ConwayEra -> Identity (Redeemers ConwayEra))
 -> AlonzoTx ConwayEra -> Identity (AlonzoTx ConwayEra))
-> Redeemers ConwayEra -> AlonzoTx ConwayEra -> AlonzoTx ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
-> Redeemers ConwayEra
forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers ([Item
   (Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits))]
-> Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
forall l. IsList l => [Item l] -> l
fromList ([Item
    (Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits))]
 -> Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits))
-> [Item
      (Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits))]
-> Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
forall a b. (a -> b) -> a -> b
$ Tx ConwayEra
-> [(ConwayPlutusPurpose AsIx ConwayEra,
     (Data ConwayEra, ExUnits))]
forall {era} {era} {era}.
(PlutusPurpose AsIxItem era ~ ConwayPlutusPurpose AsIxItem era,
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraTxBody era, EraTx era, AlonzoEraTxWits era,
 EraPParams era, Eq (TxCert era), Show (TxCert era),
 NFData (TxCert era), NoThunks (TxCert era)) =>
Tx era -> [(ConwayPlutusPurpose AsIx era, (Data era, ExUnits))]
nonSpendingRedeemers Tx ConwayEra
tx)
              Redeemers ConwayEra -> Redeemers ConwayEra -> Redeemers ConwayEra
forall a. Semigroup a => a -> a -> a
<> Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
-> Redeemers ConwayEra
forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers ([Item
   (Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits))]
-> Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
forall l. IsList l => [Item l] -> l
fromList ([Item
    (Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits))]
 -> Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits))
-> [Item
      (Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits))]
-> Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
forall a b. (a -> b) -> a -> b
$ Map TxIn (Data ConwayEra)
-> Set TxIn
-> [(ConwayPlutusPurpose AsIx ConwayEra,
     (Data ConwayEra, ExUnits))]
forall {k} {a} {era}.
Ord k =>
Map k a -> Set k -> [(ConwayPlutusPurpose AsIx era, (a, ExUnits))]
mkRedeemers Map TxIn (Data ConwayEra)
newRedeemers Set TxIn
newInputs)

  -- Make redeemers (with zeroed units) from a TxIn -> Data map and a set of transaction inputs
  mkRedeemers :: Map k a -> Set k -> [(ConwayPlutusPurpose AsIx era, (a, ExUnits))]
mkRedeemers Map k a
resolved Set k
inputs =
    ([(ConwayPlutusPurpose AsIx era, (a, ExUnits))]
 -> k -> [(ConwayPlutusPurpose AsIx era, (a, ExUnits))])
-> [(ConwayPlutusPurpose AsIx era, (a, ExUnits))]
-> Set k
-> [(ConwayPlutusPurpose AsIx era, (a, ExUnits))]
forall b a. (b -> a -> b) -> b -> Set a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
      ( \[(ConwayPlutusPurpose AsIx era, (a, ExUnits))]
newRedeemerData k
txin ->
          let ix :: Word32
ix = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ k -> Set k -> Int
forall a. Ord a => a -> Set a -> Int
Set.findIndex k
txin Set k
inputs
           in case k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
txin Map k a
resolved of
                Maybe a
Nothing -> [(ConwayPlutusPurpose AsIx era, (a, ExUnits))]
newRedeemerData
                Just a
d ->
                  (AsIx Word32 TxIn -> ConwayPlutusPurpose AsIx era
forall (f :: * -> * -> *) era.
f Word32 TxIn -> ConwayPlutusPurpose f era
ConwaySpending (Word32 -> AsIx Word32 TxIn
forall ix it. ix -> AsIx ix it
AsIx Word32
ix), (a
d, Nat -> Nat -> ExUnits
ExUnits Nat
0 Nat
0)) (ConwayPlutusPurpose AsIx era, (a, ExUnits))
-> [(ConwayPlutusPurpose AsIx era, (a, ExUnits))]
-> [(ConwayPlutusPurpose AsIx era, (a, ExUnits))]
forall a. a -> [a] -> [a]
: [(ConwayPlutusPurpose AsIx era, (a, ExUnits))]
newRedeemerData
      )
      []
      Set k
inputs

  -- Create a TxIn -> Data map of all spending redeemers
  resolveSpendingRedeemers :: Tx era -> Map TxIn (Data era)
resolveSpendingRedeemers Tx era
tx =
    (PlutusPurpose AsIx era
 -> (Data era, ExUnits) -> Map TxIn (Data era))
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> Map TxIn (Data era)
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey
      ( \PlutusPurpose AsIx era
p (Data era
d, ExUnits
_ex) ->
          -- XXX: Should soon be available through cardano-ledger-api again
          case TxBody era
-> PlutusPurpose AsIx era
-> StrictMaybe (PlutusPurpose AsIxItem era)
forall era.
AlonzoEraTxBody era =>
TxBody era
-> PlutusPurpose AsIx era
-> StrictMaybe (PlutusPurpose AsIxItem era)
redeemerPointerInverse (Tx era
tx Tx era -> Getting (TxBody era) (Tx era) (TxBody era) -> TxBody era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody era) (Tx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL) PlutusPurpose AsIx era
p of
            SJust (ConwaySpending (AsIxItem Word32
_ TxIn
txIn)) -> TxIn -> Data era -> Map TxIn (Data era)
forall k a. k -> a -> Map k a
Map.singleton TxIn
txIn Data era
d
            StrictMaybe (PlutusPurpose AsIxItem era)
_ -> Map TxIn (Data era)
forall a. Monoid a => a
mempty
      )
      (Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall era.
Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
unRedeemers (Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits))
-> Redeemers era
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall a b. (a -> b) -> a -> b
$ Tx era
tx Tx era
-> Getting (Redeemers era) (Tx era) (Redeemers era)
-> Redeemers era
forall s a. s -> Getting a s a -> a
^. (TxWits era -> Const (Redeemers era) (TxWits era))
-> Tx era -> Const (Redeemers era) (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Const (Redeemers era) (TxWits era))
 -> Tx era -> Const (Redeemers era) (Tx era))
-> ((Redeemers era -> Const (Redeemers era) (Redeemers era))
    -> TxWits era -> Const (Redeemers era) (TxWits era))
-> Getting (Redeemers era) (Tx era) (Redeemers era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era -> Const (Redeemers era) (Redeemers era))
-> TxWits era -> Const (Redeemers era) (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL)

  nonSpendingRedeemers :: Tx era -> [(ConwayPlutusPurpose AsIx era, (Data era, ExUnits))]
nonSpendingRedeemers Tx era
tx =
    (PlutusPurpose AsIx era
 -> (Data era, ExUnits)
 -> [(ConwayPlutusPurpose AsIx era, (Data era, ExUnits))])
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> [(ConwayPlutusPurpose AsIx era, (Data era, ExUnits))]
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey
      ( \PlutusPurpose AsIx era
p (Data era
d, ExUnits
ex) ->
          case TxBody era
-> PlutusPurpose AsIx era
-> StrictMaybe (PlutusPurpose AsIxItem era)
forall era.
AlonzoEraTxBody era =>
TxBody era
-> PlutusPurpose AsIx era
-> StrictMaybe (PlutusPurpose AsIxItem era)
redeemerPointerInverse (Tx era
tx Tx era -> Getting (TxBody era) (Tx era) (TxBody era) -> TxBody era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody era) (Tx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL) PlutusPurpose AsIx era
p of
            SJust (ConwayMinting (AsIxItem Word32
i PolicyID
_)) -> [(AsIx Word32 PolicyID -> ConwayPlutusPurpose AsIx era
forall (f :: * -> * -> *) era.
f Word32 PolicyID -> ConwayPlutusPurpose f era
ConwayMinting (Word32 -> AsIx Word32 PolicyID
forall ix it. ix -> AsIx ix it
AsIx Word32
i), (Data era
d, ExUnits
ex))]
            SJust (ConwayRewarding (AsIxItem Word32
i RewardAccount
_)) -> [(AsIx Word32 RewardAccount -> ConwayPlutusPurpose AsIx era
forall (f :: * -> * -> *) era.
f Word32 RewardAccount -> ConwayPlutusPurpose f era
ConwayRewarding (Word32 -> AsIx Word32 RewardAccount
forall ix it. ix -> AsIx ix it
AsIx Word32
i), (Data era
d, ExUnits
ex))]
            SJust (ConwayCertifying (AsIxItem Word32
i TxCert era
_)) -> [(AsIx Word32 (TxCert era) -> ConwayPlutusPurpose AsIx era
forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> ConwayPlutusPurpose f era
ConwayCertifying (Word32 -> AsIx Word32 (TxCert era)
forall ix it. ix -> AsIx ix it
AsIx Word32
i), (Data era
d, ExUnits
ex))]
            SJust (ConwayProposing (AsIxItem Word32
i ProposalProcedure era
_)) -> [(AsIx Word32 (ProposalProcedure era) -> ConwayPlutusPurpose AsIx era
forall (f :: * -> * -> *) era.
f Word32 (ProposalProcedure era) -> ConwayPlutusPurpose f era
ConwayProposing (Word32 -> AsIx Word32 (ProposalProcedure era)
forall ix it. ix -> AsIx ix it
AsIx Word32
i), (Data era
d, ExUnits
ex))]
            SJust (ConwayVoting (AsIxItem Word32
i Voter
_)) -> [(AsIx Word32 Voter -> ConwayPlutusPurpose AsIx era
forall (f :: * -> * -> *) era.
f Word32 Voter -> ConwayPlutusPurpose f era
ConwayVoting (Word32 -> AsIx Word32 Voter
forall ix it. ix -> AsIx ix it
AsIx Word32
i), (Data era
d, ExUnits
ex))]
            SJust (ConwaySpending (AsIxItem Word32
_ TxIn
_)) -> []
            StrictMaybe (PlutusPurpose AsIxItem era)
SNothing -> []
      )
      (Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall era.
Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
unRedeemers (Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits))
-> Redeemers era
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall a b. (a -> b) -> a -> b
$ Tx era
tx Tx era
-> Getting (Redeemers era) (Tx era) (Redeemers era)
-> Redeemers era
forall s a. s -> Getting a s a -> a
^. (TxWits era -> Const (Redeemers era) (TxWits era))
-> Tx era -> Const (Redeemers era) (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Const (Redeemers era) (TxWits era))
 -> Tx era -> Const (Redeemers era) (Tx era))
-> ((Redeemers era -> Const (Redeemers era) (Redeemers era))
    -> TxWits era -> Const (Redeemers era) (TxWits era))
-> Getting (Redeemers era) (Tx era) (Redeemers era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era -> Const (Redeemers era) (Redeemers era))
-> TxWits era -> Const (Redeemers era) (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL)
  initialScriptRef :: TxIn
initialScriptRef =
    (TxIn, TxOut CtxUTxO) -> TxIn
forall a b. (a, b) -> a
fst (ScriptRegistry -> (TxIn, TxOut CtxUTxO)
initialReference ScriptRegistry
scriptRegistry)

  initialRedeemer :: HashableScriptData
initialRedeemer =
    Redeemer -> HashableScriptData
forall a. ToScriptData a => a -> HashableScriptData
toScriptData (Redeemer -> HashableScriptData)
-> (InitialRedeemer -> Redeemer)
-> InitialRedeemer
-> HashableScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitialRedeemer -> Redeemer
Initial.redeemer (InitialRedeemer -> HashableScriptData)
-> InitialRedeemer -> HashableScriptData
forall a b. (a -> b) -> a -> b
$
      [TxOutRef] -> InitialRedeemer
Initial.ViaCommit (TxIn -> TxOutRef
toPlutusTxOutRef (TxIn -> TxOutRef) -> [TxIn] -> [TxOutRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxIn]
committedTxIns)

  committedTxIns :: [TxIn]
committedTxIns = Tx -> [TxIn]
forall era. Tx era -> [TxIn]
txIns' Tx
blueprintTx

  commitOutput :: TxOut CtxUTxO
commitOutput =
    AddressInEra
-> Value -> TxOutDatum CtxUTxO -> ReferenceScript -> TxOut CtxUTxO
forall ctx.
AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut AddressInEra
commitAddress Value
commitValue TxOutDatum CtxUTxO
commitDatum ReferenceScript
ReferenceScriptNone

  commitAddress :: AddressInEra
commitAddress =
    NetworkId -> PlutusScript PlutusScriptV3 -> AddressInEra
forall lang era.
(IsShelleyBasedEra era, IsPlutusScriptLanguage lang) =>
NetworkId -> PlutusScript lang -> AddressInEra era
mkScriptAddress NetworkId
networkId PlutusScript PlutusScriptV3
commitValidatorScript

  utxoToCommit :: UTxO' (TxOut CtxUTxO)
utxoToCommit =
    [(TxIn, TxOut CtxUTxO)] -> UTxO' (TxOut CtxUTxO)
forall out. [(TxIn, out)] -> UTxO' out
UTxO.fromList ([(TxIn, TxOut CtxUTxO)] -> UTxO' (TxOut CtxUTxO))
-> [(TxIn, TxOut CtxUTxO)] -> UTxO' (TxOut CtxUTxO)
forall a b. (a -> b) -> a -> b
$ (TxIn -> Maybe (TxIn, TxOut CtxUTxO))
-> [TxIn] -> [(TxIn, TxOut CtxUTxO)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\TxIn
txin -> (TxIn
txin,) (TxOut CtxUTxO -> (TxIn, TxOut CtxUTxO))
-> Maybe (TxOut CtxUTxO) -> Maybe (TxIn, TxOut CtxUTxO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxIn -> UTxO' (TxOut CtxUTxO) -> Maybe (TxOut CtxUTxO)
forall out. TxIn -> UTxO' out -> Maybe out
UTxO.resolve TxIn
txin UTxO' (TxOut CtxUTxO)
UTxOType Tx
lookupUTxO) [TxIn]
committedTxIns

  commitValue :: Value
commitValue =
    TxOut CtxUTxO -> Value
forall ctx. TxOut ctx -> Value
txOutValue TxOut CtxUTxO
out Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> (TxOut CtxUTxO -> Value) -> UTxO' (TxOut CtxUTxO) -> 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 -> Value
forall ctx. TxOut ctx -> Value
txOutValue UTxO' (TxOut CtxUTxO)
utxoToCommit

  commitDatum :: TxOutDatum CtxUTxO
commitDatum =
    Datum -> TxOutDatum CtxUTxO
forall era a ctx.
(ToScriptData a, IsBabbageBasedEra era) =>
a -> TxOutDatum ctx era
mkTxOutDatumInline (Datum -> TxOutDatum CtxUTxO) -> Datum -> TxOutDatum CtxUTxO
forall a b. (a -> b) -> a -> b
$ Party -> UTxO' (TxOut CtxUTxO) -> CurrencySymbol -> Datum
mkCommitDatum Party
party UTxO' (TxOut CtxUTxO)
utxoToCommit (HeadId -> CurrencySymbol
headIdToCurrencySymbol HeadId
headId)

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

mkCommitDatum :: Party -> UTxO -> CurrencySymbol -> Plutus.Datum
mkCommitDatum :: Party -> UTxO' (TxOut CtxUTxO) -> CurrencySymbol -> Datum
mkCommitDatum Party
party UTxO' (TxOut CtxUTxO)
utxo CurrencySymbol
headId =
  DatumType -> Datum
Commit.datum (Party -> Party
partyToChain Party
party, [Commit]
commits, CurrencySymbol
headId)
 where
  commits :: [Commit]
commits =
    ((TxIn, TxOut CtxUTxO) -> Maybe Commit)
-> [(TxIn, TxOut CtxUTxO)] -> [Commit]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (TxIn, TxOut CtxUTxO) -> Maybe Commit
Commit.serializeCommit ([(TxIn, TxOut CtxUTxO)] -> [Commit])
-> [(TxIn, TxOut CtxUTxO)] -> [Commit]
forall a b. (a -> b) -> a -> b
$ UTxO' (TxOut CtxUTxO) -> [(TxIn, TxOut CtxUTxO)]
forall out. UTxO' out -> [(TxIn, out)]
UTxO.toList UTxO' (TxOut CtxUTxO)
utxo

-- * Observation

-- | Full observation of a commit transaction.
data CommitObservation = CommitObservation
  { CommitObservation -> (TxIn, TxOut CtxUTxO)
commitOutput :: (TxIn, TxOut CtxUTxO)
  , CommitObservation -> Party
party :: Party
  -- ^ Hydra participant who committed the UTxO.
  , CommitObservation -> UTxO' (TxOut CtxUTxO)
committed :: UTxO
  , CommitObservation -> HeadId
headId :: HeadId
  }
  deriving stock (CommitObservation -> CommitObservation -> Bool
(CommitObservation -> CommitObservation -> Bool)
-> (CommitObservation -> CommitObservation -> Bool)
-> Eq CommitObservation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommitObservation -> CommitObservation -> Bool
== :: CommitObservation -> CommitObservation -> Bool
$c/= :: CommitObservation -> CommitObservation -> Bool
/= :: CommitObservation -> CommitObservation -> Bool
Eq, Int -> CommitObservation -> ShowS
[CommitObservation] -> ShowS
CommitObservation -> String
(Int -> CommitObservation -> ShowS)
-> (CommitObservation -> String)
-> ([CommitObservation] -> ShowS)
-> Show CommitObservation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommitObservation -> ShowS
showsPrec :: Int -> CommitObservation -> ShowS
$cshow :: CommitObservation -> String
show :: CommitObservation -> String
$cshowList :: [CommitObservation] -> ShowS
showList :: [CommitObservation] -> ShowS
Show, (forall x. CommitObservation -> Rep CommitObservation x)
-> (forall x. Rep CommitObservation x -> CommitObservation)
-> Generic CommitObservation
forall x. Rep CommitObservation x -> CommitObservation
forall x. CommitObservation -> Rep CommitObservation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CommitObservation -> Rep CommitObservation x
from :: forall x. CommitObservation -> Rep CommitObservation x
$cto :: forall x. Rep CommitObservation x -> CommitObservation
to :: forall x. Rep CommitObservation x -> CommitObservation
Generic)

-- | Identify a commit tx by:
--
-- - Check that its spending from the init validator,
-- - Find the outputs which pays to the commit validator,
-- - Using the datum of that output, deserialize the committed output,
-- - Reconstruct the committed UTxO from both values (tx input and output).
observeCommitTx ::
  NetworkId ->
  -- | A UTxO set to lookup tx inputs. Should at least contain the input
  -- spending from νInitial.
  UTxO ->
  Tx ->
  Maybe CommitObservation
observeCommitTx :: NetworkId -> UTxO' (TxOut CtxUTxO) -> Tx -> Maybe CommitObservation
observeCommitTx NetworkId
networkId UTxO' (TxOut CtxUTxO)
utxo Tx
tx = do
  -- NOTE: Instead checking to spend from initial we could be looking at the
  -- seed:
  --
  --  - We must check that participation token in output satisfies
  --      policyId = hash(mu_head(seed))
  --
  --  - This allows us to assume (by induction) the output datum at the commit
  --    script is legit
  --
  --  - Further, we need to assert / assume that only one script is spent = onle
  --    one redeemer matches the InitialRedeemer, as we do not have information
  --    which of the inputs is spending from the initial script otherwise.
  --
  --  Right now we only have the headId in the datum, so we use that in place of
  --  the seed -> THIS CAN NOT BE TRUSTED.
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isSpendingFromInitial

  (TxIn
commitIn, TxOut CtxTx Era
commitOut) <- AddressInEra -> Tx -> Maybe (TxIn, TxOut CtxTx Era)
forall era.
AddressInEra era -> Tx era -> Maybe (TxIn, TxOut CtxTx era)
findTxOutByAddress AddressInEra
commitAddress Tx
tx
  HashableScriptData
dat <- TxOut CtxTx Era -> Maybe HashableScriptData
forall era. TxOut CtxTx era -> Maybe HashableScriptData
txOutScriptData TxOut CtxTx Era
commitOut
  (Party
onChainParty, [Commit]
onChainCommits, CurrencySymbol
headId) :: Commit.DatumType <- HashableScriptData -> Maybe DatumType
forall a. FromScriptData a => HashableScriptData -> Maybe a
fromScriptData HashableScriptData
dat
  Party
party <- Party -> Maybe Party
forall (m :: * -> *). MonadFail m => Party -> m Party
partyFromChain Party
onChainParty

  -- NOTE: If we have the resolved inputs (utxo) then we could avoid putting
  -- the commit into the datum (+ changing the hashing strategy of
  -- collect/fanout)
  UTxO' (TxOut CtxUTxO)
committed <- do
    [(TxIn, TxOut CtxUTxO)]
committedUTxO <- (Commit -> Maybe (TxIn, TxOut CtxUTxO))
-> [Commit] -> Maybe [(TxIn, TxOut CtxUTxO)]
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)
Commit.deserializeCommit (NetworkId -> Network
toShelleyNetwork NetworkId
networkId)) [Commit]
onChainCommits
    UTxO' (TxOut CtxUTxO) -> Maybe (UTxO' (TxOut CtxUTxO))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTxO' (TxOut CtxUTxO) -> Maybe (UTxO' (TxOut CtxUTxO)))
-> ([(TxIn, TxOut CtxUTxO)] -> UTxO' (TxOut CtxUTxO))
-> [(TxIn, TxOut CtxUTxO)]
-> Maybe (UTxO' (TxOut CtxUTxO))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TxIn, TxOut CtxUTxO)] -> UTxO' (TxOut CtxUTxO)
forall out. [(TxIn, out)] -> UTxO' out
UTxO.fromList ([(TxIn, TxOut CtxUTxO)] -> Maybe (UTxO' (TxOut CtxUTxO)))
-> [(TxIn, TxOut CtxUTxO)] -> Maybe (UTxO' (TxOut CtxUTxO))
forall a b. (a -> b) -> a -> b
$ [(TxIn, TxOut CtxUTxO)]
committedUTxO

  PolicyId
policyId <- CurrencySymbol -> Maybe PolicyId
forall (m :: * -> *). MonadFail m => CurrencySymbol -> m PolicyId
fromPlutusCurrencySymbol CurrencySymbol
headId
  CommitObservation -> Maybe CommitObservation
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    CommitObservation
      { $sel:commitOutput:CommitObservation :: (TxIn, TxOut CtxUTxO)
commitOutput = (TxIn
commitIn, TxOut CtxTx Era -> TxOut CtxUTxO
forall era. TxOut CtxTx era -> TxOut CtxUTxO era
toCtxUTxOTxOut TxOut CtxTx Era
commitOut)
      , Party
$sel:party:CommitObservation :: Party
party :: Party
party
      , UTxO' (TxOut CtxUTxO)
$sel:committed:CommitObservation :: UTxO' (TxOut CtxUTxO)
committed :: UTxO' (TxOut CtxUTxO)
committed
      , $sel:headId:CommitObservation :: HeadId
headId = PolicyId -> HeadId
mkHeadId PolicyId
policyId
      }
 where
  isSpendingFromInitial :: Bool
  isSpendingFromInitial :: Bool
isSpendingFromInitial =
    (TxOut CtxUTxO -> Bool) -> UTxO' (TxOut CtxUTxO) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\TxOut CtxUTxO
o -> TxOut CtxUTxO -> AddressInEra
forall ctx. TxOut ctx -> AddressInEra
txOutAddress TxOut CtxUTxO
o AddressInEra -> AddressInEra -> Bool
forall a. Eq a => a -> a -> Bool
== AddressInEra
initialAddress) (UTxO' (TxOut CtxUTxO) -> Tx -> UTxO' (TxOut CtxUTxO)
resolveInputsUTxO UTxO' (TxOut CtxUTxO)
utxo Tx
tx)

  initialAddress :: AddressInEra
initialAddress = NetworkId -> PlutusScript PlutusScriptV3 -> AddressInEra
forall lang era.
(IsShelleyBasedEra era, IsPlutusScriptLanguage lang) =>
NetworkId -> PlutusScript lang -> AddressInEra era
mkScriptAddress NetworkId
networkId PlutusScript PlutusScriptV3
initialValidatorScript

  commitAddress :: AddressInEra
commitAddress = NetworkId -> PlutusScript PlutusScriptV3 -> AddressInEra
forall lang era.
(IsShelleyBasedEra era, IsPlutusScriptLanguage lang) =>
NetworkId -> PlutusScript lang -> AddressInEra era
mkScriptAddress NetworkId
networkId PlutusScript PlutusScriptV3
commitValidatorScript