module Hydra.Cardano.Api.TxBody where

import Hydra.Cardano.Api.Prelude

import Cardano.Ledger.Alonzo.TxWits qualified as Ledger
import Cardano.Ledger.Api (
  AsItem (..),
  AsIx,
  ConwayPlutusPurpose (..),
  PlutusPurpose,
 )
import Cardano.Ledger.Babbage.Core (redeemerPointer)
import Cardano.Ledger.BaseTypes (strictMaybeToMaybe)
import Cardano.Ledger.Plutus.Data qualified as Ledger
import Data.Map qualified as Map
import Hydra.Cardano.Api.TxIn (toLedgerTxIn)
import PlutusLedgerApi.V3 qualified as Plutus

-- | Find and deserialise from 'ScriptData', a redeemer from the transaction
-- associated to the given input.
findRedeemerSpending ::
  Plutus.FromData a =>
  Tx Era ->
  TxIn ->
  Maybe a
findRedeemerSpending :: forall a. FromData a => Tx Era -> TxIn -> Maybe a
findRedeemerSpending (Tx Era -> TxBody Era
forall era. Tx era -> TxBody era
getTxBody -> ShelleyTxBody ShelleyBasedEra Era
_ TxBody (ShelleyLedgerEra Era)
body [Script (ShelleyLedgerEra Era)]
_ TxBodyScriptData Era
scriptData Maybe (TxAuxData (ShelleyLedgerEra Era))
_ TxScriptValidity Era
_) TxIn
txIn = do
  PlutusPurpose AsIx (ConwayEra StandardCrypto)
ptr <- StrictMaybe (PlutusPurpose AsIx (ConwayEra StandardCrypto))
-> Maybe (PlutusPurpose AsIx (ConwayEra StandardCrypto))
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (StrictMaybe (PlutusPurpose AsIx (ConwayEra StandardCrypto))
 -> Maybe (PlutusPurpose AsIx (ConwayEra StandardCrypto)))
-> StrictMaybe (PlutusPurpose AsIx (ConwayEra StandardCrypto))
-> Maybe (PlutusPurpose AsIx (ConwayEra StandardCrypto))
forall a b. (a -> b) -> a -> b
$ TxBody (ConwayEra StandardCrypto)
-> PlutusPurpose AsItem (ConwayEra StandardCrypto)
-> StrictMaybe (PlutusPurpose AsIx (ConwayEra StandardCrypto))
forall era.
AlonzoEraTxBody era =>
TxBody era
-> PlutusPurpose AsItem era -> StrictMaybe (PlutusPurpose AsIx era)
redeemerPointer TxBody (ShelleyLedgerEra Era)
TxBody (ConwayEra StandardCrypto)
body (AsItem Word32 (TxIn (EraCrypto (ConwayEra StandardCrypto)))
-> ConwayPlutusPurpose AsItem (ConwayEra StandardCrypto)
AsItem Word32 (TxIn StandardCrypto)
-> PlutusPurpose AsItem (ConwayEra StandardCrypto)
forall (f :: * -> * -> *) era.
f Word32 (TxIn (EraCrypto era)) -> ConwayPlutusPurpose f era
ConwaySpending (AsItem Word32 (TxIn StandardCrypto)
 -> PlutusPurpose AsItem (ConwayEra StandardCrypto))
-> (TxIn StandardCrypto -> AsItem Word32 (TxIn StandardCrypto))
-> TxIn StandardCrypto
-> PlutusPurpose AsItem (ConwayEra StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn StandardCrypto -> AsItem Word32 (TxIn StandardCrypto)
forall ix it. it -> AsItem ix it
AsItem (TxIn StandardCrypto
 -> PlutusPurpose AsItem (ConwayEra StandardCrypto))
-> TxIn StandardCrypto
-> PlutusPurpose AsItem (ConwayEra StandardCrypto)
forall a b. (a -> b) -> a -> b
$ TxIn -> TxIn StandardCrypto
toLedgerTxIn TxIn
txIn)
  PlutusPurpose AsIx (ShelleyLedgerEra Era)
-> TxBodyScriptData Era -> Maybe a
forall a.
FromData a =>
PlutusPurpose AsIx (ShelleyLedgerEra Era)
-> TxBodyScriptData Era -> Maybe a
lookupRedeemer PlutusPurpose AsIx (ShelleyLedgerEra Era)
PlutusPurpose AsIx (ConwayEra StandardCrypto)
ptr TxBodyScriptData Era
scriptData

--
-- Internals
--

lookupRedeemer ::
  Plutus.FromData a =>
  PlutusPurpose AsIx LedgerEra ->
  TxBodyScriptData Era ->
  Maybe a
lookupRedeemer :: forall a.
FromData a =>
PlutusPurpose AsIx (ShelleyLedgerEra Era)
-> TxBodyScriptData Era -> Maybe a
lookupRedeemer PlutusPurpose AsIx (ShelleyLedgerEra Era)
ptr TxBodyScriptData Era
scriptData = do
  (Data (ConwayEra StandardCrypto)
d, ExUnits
_exUnits) <- ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto)
-> Map
     (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
     (Data (ConwayEra StandardCrypto), ExUnits)
-> Maybe (Data (ConwayEra StandardCrypto), ExUnits)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PlutusPurpose AsIx (ShelleyLedgerEra Era)
ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto)
ptr Map
  (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
  (Data (ConwayEra StandardCrypto), ExUnits)
redeemers
  Data -> Maybe a
forall a. FromData a => Data -> Maybe a
Plutus.fromData (Data -> Maybe a) -> Data -> Maybe a
forall a b. (a -> b) -> a -> b
$ Data (ConwayEra StandardCrypto) -> Data
forall era. Data era -> Data
Ledger.getPlutusData Data (ConwayEra StandardCrypto)
d
 where
  redeemers :: Map
  (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
  (Data (ConwayEra StandardCrypto), ExUnits)
redeemers = case TxBodyScriptData Era
scriptData of
    TxBodyScriptData Era
TxBodyNoScriptData ->
      Map
  (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
  (Data (ConwayEra StandardCrypto), ExUnits)
forall a. Monoid a => a
mempty
    TxBodyScriptData AlonzoEraOnwards Era
_ TxDats (ShelleyLedgerEra Era)
_ (Ledger.Redeemers Map
  (PlutusPurpose AsIx (ConwayEra StandardCrypto))
  (Data (ConwayEra StandardCrypto), ExUnits)
rs) ->
      Map
  (PlutusPurpose AsIx (ConwayEra StandardCrypto))
  (Data (ConwayEra StandardCrypto), ExUnits)
Map
  (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
  (Data (ConwayEra StandardCrypto), ExUnits)
rs