module Hydra.Cardano.Api.TxBody where

import Hydra.Cardano.Api.Prelude

import Cardano.Ledger.Alonzo.TxWits qualified as Ledger
import Cardano.Ledger.Api (AlonzoPlutusPurpose (..), AsIndex, AsItem (..), 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.V2 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 AsIndex (BabbageEra StandardCrypto)
ptr <- StrictMaybe (PlutusPurpose AsIndex (BabbageEra StandardCrypto))
-> Maybe (PlutusPurpose AsIndex (BabbageEra StandardCrypto))
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (StrictMaybe (PlutusPurpose AsIndex (BabbageEra StandardCrypto))
 -> Maybe (PlutusPurpose AsIndex (BabbageEra StandardCrypto)))
-> StrictMaybe (PlutusPurpose AsIndex (BabbageEra StandardCrypto))
-> Maybe (PlutusPurpose AsIndex (BabbageEra StandardCrypto))
forall a b. (a -> b) -> a -> b
$ TxBody (BabbageEra StandardCrypto)
-> PlutusPurpose AsItem (BabbageEra StandardCrypto)
-> StrictMaybe (PlutusPurpose AsIndex (BabbageEra StandardCrypto))
forall era.
AlonzoEraTxBody era =>
TxBody era
-> PlutusPurpose AsItem era
-> StrictMaybe (PlutusPurpose AsIndex era)
redeemerPointer TxBody (ShelleyLedgerEra Era)
TxBody (BabbageEra StandardCrypto)
body (AsItem Word32 (TxIn (EraCrypto (BabbageEra StandardCrypto)))
-> AlonzoPlutusPurpose AsItem (BabbageEra StandardCrypto)
AsItem Word32 (TxIn StandardCrypto)
-> PlutusPurpose AsItem (BabbageEra StandardCrypto)
forall (f :: * -> * -> *) era.
f Word32 (TxIn (EraCrypto era)) -> AlonzoPlutusPurpose f era
AlonzoSpending (AsItem Word32 (TxIn StandardCrypto)
 -> PlutusPurpose AsItem (BabbageEra StandardCrypto))
-> (TxIn StandardCrypto -> AsItem Word32 (TxIn StandardCrypto))
-> TxIn StandardCrypto
-> PlutusPurpose AsItem (BabbageEra 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 (BabbageEra StandardCrypto))
-> TxIn StandardCrypto
-> PlutusPurpose AsItem (BabbageEra StandardCrypto)
forall a b. (a -> b) -> a -> b
$ TxIn -> TxIn StandardCrypto
toLedgerTxIn TxIn
txIn)
  PlutusPurpose AsIndex (ShelleyLedgerEra Era)
-> TxBodyScriptData Era -> Maybe a
forall a.
FromData a =>
PlutusPurpose AsIndex (ShelleyLedgerEra Era)
-> TxBodyScriptData Era -> Maybe a
lookupRedeemer PlutusPurpose AsIndex (ShelleyLedgerEra Era)
PlutusPurpose AsIndex (BabbageEra 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 AsIndex (BabbageEra StandardCrypto)
ptr <- StrictMaybe (PlutusPurpose AsIndex (BabbageEra StandardCrypto))
-> Maybe (PlutusPurpose AsIndex (BabbageEra StandardCrypto))
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (StrictMaybe (PlutusPurpose AsIndex (BabbageEra StandardCrypto))
 -> Maybe (PlutusPurpose AsIndex (BabbageEra StandardCrypto)))
-> StrictMaybe (PlutusPurpose AsIndex (BabbageEra StandardCrypto))
-> Maybe (PlutusPurpose AsIndex (BabbageEra StandardCrypto))
forall a b. (a -> b) -> a -> b
$ TxBody (BabbageEra StandardCrypto)
-> PlutusPurpose AsItem (BabbageEra StandardCrypto)
-> StrictMaybe (PlutusPurpose AsIndex (BabbageEra StandardCrypto))
forall era.
AlonzoEraTxBody era =>
TxBody era
-> PlutusPurpose AsItem era
-> StrictMaybe (PlutusPurpose AsIndex era)
redeemerPointer TxBody (ShelleyLedgerEra Era)
TxBody (BabbageEra StandardCrypto)
body (AsItem Word32 (PolicyID (EraCrypto (BabbageEra StandardCrypto)))
-> AlonzoPlutusPurpose AsItem (BabbageEra StandardCrypto)
AsItem Word32 (PolicyID StandardCrypto)
-> PlutusPurpose AsItem (BabbageEra StandardCrypto)
forall (f :: * -> * -> *) era.
f Word32 (PolicyID (EraCrypto era)) -> AlonzoPlutusPurpose f era
AlonzoMinting (AsItem Word32 (PolicyID StandardCrypto)
 -> PlutusPurpose AsItem (BabbageEra StandardCrypto))
-> (PolicyID StandardCrypto
    -> AsItem Word32 (PolicyID StandardCrypto))
-> PolicyID StandardCrypto
-> PlutusPurpose AsItem (BabbageEra 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 (BabbageEra StandardCrypto))
-> PolicyID StandardCrypto
-> PlutusPurpose AsItem (BabbageEra StandardCrypto)
forall a b. (a -> b) -> a -> b
$ PolicyId -> PolicyID StandardCrypto
toLedgerPolicyID PolicyId
pid)
  PlutusPurpose AsIndex (ShelleyLedgerEra Era)
-> TxBodyScriptData Era -> Maybe a
forall a.
FromData a =>
PlutusPurpose AsIndex (ShelleyLedgerEra Era)
-> TxBodyScriptData Era -> Maybe a
lookupRedeemer PlutusPurpose AsIndex (ShelleyLedgerEra Era)
PlutusPurpose AsIndex (BabbageEra 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 (BabbageEra StandardCrypto) -> PlutusScript lang)
-> Maybe (AlonzoScript (BabbageEra StandardCrypto))
-> Maybe (PlutusScript lang)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AlonzoScript (BabbageEra StandardCrypto) -> Bool)
-> [AlonzoScript (BabbageEra StandardCrypto)]
-> Maybe (AlonzoScript (BabbageEra 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 (BabbageEra StandardCrypto)
    -> ScriptHash StandardCrypto)
-> AlonzoScript (BabbageEra 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 (BabbageEra StandardCrypto)]
[Script (ShelleyLedgerEra Era)]
scripts
 where
  needle :: ScriptHash StandardCrypto
needle = PolicyId -> ScriptHash StandardCrypto
toLedgerScriptHash PolicyId
pid

--
-- Internals
--

lookupRedeemer ::
  Plutus.FromData a =>
  PlutusPurpose AsIndex LedgerEra ->
  TxBodyScriptData Era ->
  Maybe a
lookupRedeemer :: forall a.
FromData a =>
PlutusPurpose AsIndex (ShelleyLedgerEra Era)
-> TxBodyScriptData Era -> Maybe a
lookupRedeemer PlutusPurpose AsIndex (ShelleyLedgerEra Era)
ptr TxBodyScriptData Era
scriptData = do
  (Data (BabbageEra StandardCrypto)
d, ExUnits
_exUnits) <- AlonzoPlutusPurpose AsIndex (BabbageEra StandardCrypto)
-> Map
     (AlonzoPlutusPurpose AsIndex (BabbageEra StandardCrypto))
     (Data (BabbageEra StandardCrypto), ExUnits)
-> Maybe (Data (BabbageEra StandardCrypto), ExUnits)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PlutusPurpose AsIndex (ShelleyLedgerEra Era)
AlonzoPlutusPurpose AsIndex (BabbageEra StandardCrypto)
ptr Map
  (AlonzoPlutusPurpose AsIndex (BabbageEra StandardCrypto))
  (Data (BabbageEra 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 (BabbageEra StandardCrypto) -> Data
forall era. Data era -> Data
Ledger.getPlutusData Data (BabbageEra StandardCrypto)
d
 where
  redeemers :: Map
  (AlonzoPlutusPurpose AsIndex (BabbageEra StandardCrypto))
  (Data (BabbageEra StandardCrypto), ExUnits)
redeemers = case TxBodyScriptData Era
scriptData of
    TxBodyScriptData Era
TxBodyNoScriptData ->
      Map
  (AlonzoPlutusPurpose AsIndex (BabbageEra StandardCrypto))
  (Data (BabbageEra StandardCrypto), ExUnits)
forall a. Monoid a => a
mempty
    TxBodyScriptData AlonzoEraOnwards Era
_ TxDats (ShelleyLedgerEra Era)
_ (Ledger.Redeemers Map
  (PlutusPurpose AsIndex (BabbageEra StandardCrypto))
  (Data (BabbageEra StandardCrypto), ExUnits)
rs) ->
      Map
  (PlutusPurpose AsIndex (BabbageEra StandardCrypto))
  (Data (BabbageEra StandardCrypto), ExUnits)
Map
  (AlonzoPlutusPurpose AsIndex (BabbageEra StandardCrypto))
  (Data (BabbageEra StandardCrypto), ExUnits)
rs