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.Core qualified as Ledger
import Cardano.Ledger.Plutus.Data qualified as Ledger
import Data.List (find)
import Data.Map qualified as Map
import Hydra.Cardano.Api.PlutusScript (fromLedgerScript)
import Hydra.Cardano.Api.PolicyId (toLedgerPolicyID, toLedgerScriptHash)
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

findRedeemerMinting ::
  Plutus.FromData a =>
  Tx Era ->
  PolicyId ->
  Maybe a
findRedeemerMinting :: forall a. FromData a => Tx Era -> PolicyId -> Maybe a
findRedeemerMinting (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
_) PolicyId
pid = 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 (PolicyID (EraCrypto (ConwayEra StandardCrypto)))
-> ConwayPlutusPurpose AsItem (ConwayEra StandardCrypto)
AsItem Word32 (PolicyID StandardCrypto)
-> PlutusPurpose AsItem (ConwayEra StandardCrypto)
forall (f :: * -> * -> *) era.
f Word32 (PolicyID (EraCrypto era)) -> ConwayPlutusPurpose f era
ConwayMinting (AsItem Word32 (PolicyID StandardCrypto)
 -> PlutusPurpose AsItem (ConwayEra StandardCrypto))
-> (PolicyID StandardCrypto
    -> AsItem Word32 (PolicyID StandardCrypto))
-> PolicyID StandardCrypto
-> PlutusPurpose AsItem (ConwayEra StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolicyID StandardCrypto -> AsItem Word32 (PolicyID StandardCrypto)
forall ix it. it -> AsItem ix it
AsItem (PolicyID StandardCrypto
 -> PlutusPurpose AsItem (ConwayEra StandardCrypto))
-> PolicyID StandardCrypto
-> PlutusPurpose AsItem (ConwayEra StandardCrypto)
forall a b. (a -> b) -> a -> b
$ PolicyId -> PolicyID StandardCrypto
toLedgerPolicyID PolicyId
pid)
  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

findScriptMinting ::
  forall lang.
  () =>
  Tx Era ->
  PolicyId ->
  Maybe (PlutusScript lang)
findScriptMinting :: forall lang. Tx Era -> PolicyId -> Maybe (PlutusScript lang)
findScriptMinting (Tx Era -> TxBody Era
forall era. Tx era -> TxBody era
getTxBody -> ShelleyTxBody ShelleyBasedEra Era
_ TxBody (ShelleyLedgerEra Era)
_ [Script (ShelleyLedgerEra Era)]
scripts TxBodyScriptData Era
_ Maybe (TxAuxData (ShelleyLedgerEra Era))
_ TxScriptValidity Era
_) PolicyId
pid = do
  forall era lang.
(HasCallStack, AlonzoEraScript era) =>
AlonzoScript era -> PlutusScript lang
fromLedgerScript @_ @lang
    (AlonzoScript (ConwayEra StandardCrypto) -> PlutusScript lang)
-> Maybe (AlonzoScript (ConwayEra StandardCrypto))
-> Maybe (PlutusScript lang)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AlonzoScript (ConwayEra StandardCrypto) -> Bool)
-> [AlonzoScript (ConwayEra StandardCrypto)]
-> Maybe (AlonzoScript (ConwayEra StandardCrypto))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((ScriptHash StandardCrypto -> ScriptHash StandardCrypto -> Bool
forall a. Eq a => a -> a -> Bool
== ScriptHash StandardCrypto
needle) (ScriptHash StandardCrypto -> Bool)
-> (AlonzoScript (ConwayEra StandardCrypto)
    -> ScriptHash StandardCrypto)
-> AlonzoScript (ConwayEra StandardCrypto)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
Ledger.hashScript @(ShelleyLedgerEra Era)) [AlonzoScript (ConwayEra StandardCrypto)]
[Script (ShelleyLedgerEra Era)]
scripts
 where
  needle :: ScriptHash StandardCrypto
needle = PolicyId -> ScriptHash StandardCrypto
toLedgerScriptHash PolicyId
pid

--
-- 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