{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DerivingVia         #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE PolyKinds           #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}
{-| The chain index' version of a transaction
-}
module Plutus.ChainIndex.Tx(
    ChainIndexTx(..)
    , ChainIndexTxOutputs(..)
    , ChainIndexTxOut(..)
    , ReferenceScript(..)
    , Address(..)
    , OutputDatum(..)
    , Value(..)
    , fromOnChainTx
    , txOuts
    , txOutRefs
    , txOutsWithRef
    , txOutRefMap
    , txOutRefMapForAddr
    , txRedeemersWithHash
    , validityFromChainIndex
    -- ** Lenses
    , citxTxId
    , citxInputs
    , citxOutputs
    , citxValidRange
    , citxData
    , citxRedeemers
    , citxScripts
    , citxCardanoTx
    , _InvalidTx
    , _ValidTx
    ) where

import Data.List (sort)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (mapMaybe)
import Data.Tuple (swap)
import Ledger (OnChainTx (..), ScriptTag (Cert, Mint, Reward), SomeCardanoApiTx (SomeTx), Tx (..),
               TxInput (txInputType), TxOut (getTxOut), TxOutRef (..), onCardanoTx, txCertifyingRedeemers, txId,
               txMintingRedeemers, txRewardingRedeemers)
import Ledger.Address (CardanoAddress)
import Ledger.Scripts (Redeemer, RedeemerHash)
import Ledger.Tx (TxInputType (TxScriptAddress), fillTxInputWitnesses)
import Plutus.ChainIndex.Types
import Plutus.Contract.CardanoAPI (fromCardanoTx, fromCardanoTxOut, setValidity)
import Plutus.Script.Utils.Scripts (redeemerHash)
import Plutus.V1.Ledger.Tx (RedeemerPtr (RedeemerPtr), Redeemers, ScriptTag (Spend))
import Plutus.V2.Ledger.Api (Address (..), OutputDatum (..), Value (..))

-- | Get tx outputs from tx.
txOuts :: ChainIndexTx -> [ChainIndexTxOut]
txOuts :: ChainIndexTx -> [ChainIndexTxOut]
txOuts ChainIndexTx { _citxOutputs :: ChainIndexTx -> ChainIndexTxOutputs
_citxOutputs = ValidTx [ChainIndexTxOut]
outputs }         = [ChainIndexTxOut]
outputs
txOuts ChainIndexTx { _citxOutputs :: ChainIndexTx -> ChainIndexTxOutputs
_citxOutputs = InvalidTx (Just ChainIndexTxOut
output) } = [ ChainIndexTxOut
output ]
txOuts ChainIndexTx { _citxOutputs :: ChainIndexTx -> ChainIndexTxOutputs
_citxOutputs = InvalidTx Maybe ChainIndexTxOut
Nothing }       = []

-- | Get tx output references from tx.
txOutRefs :: ChainIndexTx -> [TxOutRef]
txOutRefs :: ChainIndexTx -> [TxOutRef]
txOutRefs ChainIndexTx
tx = [ TxId -> Integer -> TxOutRef
TxOutRef (ChainIndexTx -> TxId
_citxTxId ChainIndexTx
tx) (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) | Int
idx <- [Int
0 .. [ChainIndexTxOut] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ChainIndexTx -> [ChainIndexTxOut]
txOuts ChainIndexTx
tx) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ]

-- | Get tx output references and tx outputs from tx.
txOutsWithRef :: ChainIndexTx -> [(ChainIndexTxOut, TxOutRef)]
txOutsWithRef :: ChainIndexTx -> [(ChainIndexTxOut, TxOutRef)]
txOutsWithRef ChainIndexTx
tx = [ChainIndexTxOut] -> [TxOutRef] -> [(ChainIndexTxOut, TxOutRef)]
forall a b. [a] -> [b] -> [(a, b)]
zip (ChainIndexTx -> [ChainIndexTxOut]
txOuts ChainIndexTx
tx) (ChainIndexTx -> [TxOutRef]
txOutRefs ChainIndexTx
tx)

-- | Get 'Map' of tx outputs references to tx.
txOutRefMap :: ChainIndexTx -> Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
txOutRefMap :: ChainIndexTx -> Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
txOutRefMap ChainIndexTx
tx =
    (ChainIndexTxOut -> (ChainIndexTxOut, ChainIndexTx))
-> Map TxOutRef ChainIndexTxOut
-> Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, ChainIndexTx
tx) (Map TxOutRef ChainIndexTxOut
 -> Map TxOutRef (ChainIndexTxOut, ChainIndexTx))
-> Map TxOutRef ChainIndexTxOut
-> Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
forall a b. (a -> b) -> a -> b
$ [(TxOutRef, ChainIndexTxOut)] -> Map TxOutRef ChainIndexTxOut
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxOutRef, ChainIndexTxOut)] -> Map TxOutRef ChainIndexTxOut)
-> [(TxOutRef, ChainIndexTxOut)] -> Map TxOutRef ChainIndexTxOut
forall a b. (a -> b) -> a -> b
$ ((ChainIndexTxOut, TxOutRef) -> (TxOutRef, ChainIndexTxOut))
-> [(ChainIndexTxOut, TxOutRef)] -> [(TxOutRef, ChainIndexTxOut)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ChainIndexTxOut, TxOutRef) -> (TxOutRef, ChainIndexTxOut)
forall a b. (a, b) -> (b, a)
swap ([(ChainIndexTxOut, TxOutRef)] -> [(TxOutRef, ChainIndexTxOut)])
-> [(ChainIndexTxOut, TxOutRef)] -> [(TxOutRef, ChainIndexTxOut)]
forall a b. (a -> b) -> a -> b
$ ChainIndexTx -> [(ChainIndexTxOut, TxOutRef)]
txOutsWithRef ChainIndexTx
tx

-- | Get 'Map' of tx outputs from tx for a specific address.
txOutRefMapForAddr :: CardanoAddress -> ChainIndexTx -> Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
txOutRefMapForAddr :: CardanoAddress
-> ChainIndexTx -> Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
txOutRefMapForAddr CardanoAddress
addr ChainIndexTx
tx =
    ((ChainIndexTxOut, ChainIndexTx) -> Bool)
-> Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
-> Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (CardanoAddress -> CardanoAddress -> Bool
forall a. Eq a => a -> a -> Bool
(==) CardanoAddress
addr (CardanoAddress -> Bool)
-> ((ChainIndexTxOut, ChainIndexTx) -> CardanoAddress)
-> (ChainIndexTxOut, ChainIndexTx)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainIndexTxOut -> CardanoAddress
citoAddress (ChainIndexTxOut -> CardanoAddress)
-> ((ChainIndexTxOut, ChainIndexTx) -> ChainIndexTxOut)
-> (ChainIndexTxOut, ChainIndexTx)
-> CardanoAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainIndexTxOut, ChainIndexTx) -> ChainIndexTxOut
forall a b. (a, b) -> a
fst) (Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
 -> Map TxOutRef (ChainIndexTxOut, ChainIndexTx))
-> Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
-> Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
forall a b. (a -> b) -> a -> b
$ ChainIndexTx -> Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
txOutRefMap ChainIndexTx
tx

validityFromChainIndex :: ChainIndexTx -> TxValidity
validityFromChainIndex :: ChainIndexTx -> TxValidity
validityFromChainIndex ChainIndexTx
tx =
  case ChainIndexTx -> ChainIndexTxOutputs
_citxOutputs ChainIndexTx
tx of
    InvalidTx Maybe ChainIndexTxOut
_ -> TxValidity
TxInvalid
    ValidTx [ChainIndexTxOut]
_   -> TxValidity
TxValid

-- | Convert a 'OnChainTx' to a 'ChainIndexTx'. An invalid 'OnChainTx' will not
-- produce any 'ChainIndexTx' outputs and the collateral inputs of the
-- 'OnChainTx' will be the inputs of the 'ChainIndexTx'.
fromOnChainTx :: OnChainTx -> ChainIndexTx
fromOnChainTx :: OnChainTx -> ChainIndexTx
fromOnChainTx = \case
    Valid CardanoTx
ctx ->
        (Tx -> ChainIndexTx)
-> (SomeCardanoApiTx -> ChainIndexTx) -> CardanoTx -> ChainIndexTx
forall r. (Tx -> r) -> (SomeCardanoApiTx -> r) -> CardanoTx -> r
onCardanoTx
            (\case tx :: Tx
tx@Tx{[TxInput]
txInputs :: Tx -> [TxInput]
txInputs :: [TxInput]
txInputs, [TxOut]
txOutputs :: Tx -> [TxOut]
txOutputs :: [TxOut]
txOutputs, SlotRange
txValidRange :: Tx -> SlotRange
txValidRange :: SlotRange
txValidRange, Map DatumHash Datum
txData :: Tx -> Map DatumHash Datum
txData :: Map DatumHash Datum
txData, ScriptsMap
txScripts :: Tx -> ScriptsMap
txScripts :: ScriptsMap
txScripts} ->
                    ChainIndexTx :: TxId
-> [TxIn]
-> ChainIndexTxOutputs
-> SlotRange
-> Map DatumHash Datum
-> Redeemers
-> ScriptsMap
-> Maybe SomeCardanoApiTx
-> ChainIndexTx
ChainIndexTx
                        { _citxTxId :: TxId
_citxTxId = Tx -> TxId
txId Tx
tx
                        , _citxInputs :: [TxIn]
_citxInputs = (TxInput -> TxIn) -> [TxInput] -> [TxIn]
forall a b. (a -> b) -> [a] -> [b]
map (Tx -> TxInput -> TxIn
fillTxInputWitnesses Tx
tx) [TxInput]
txInputs
                        , _citxOutputs :: ChainIndexTxOutputs
_citxOutputs = [ChainIndexTxOut] -> ChainIndexTxOutputs
ValidTx ([ChainIndexTxOut] -> ChainIndexTxOutputs)
-> [ChainIndexTxOut] -> ChainIndexTxOutputs
forall a b. (a -> b) -> a -> b
$ (TxOut -> ChainIndexTxOut) -> [TxOut] -> [ChainIndexTxOut]
forall a b. (a -> b) -> [a] -> [b]
map (TxOut CtxTx BabbageEra -> ChainIndexTxOut
forall era. IsCardanoEra era => TxOut CtxTx era -> ChainIndexTxOut
fromCardanoTxOut (TxOut CtxTx BabbageEra -> ChainIndexTxOut)
-> (TxOut -> TxOut CtxTx BabbageEra) -> TxOut -> ChainIndexTxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> TxOut CtxTx BabbageEra
getTxOut) [TxOut]
txOutputs
                        , _citxValidRange :: SlotRange
_citxValidRange = SlotRange
txValidRange
                        , _citxData :: Map DatumHash Datum
_citxData = Map DatumHash Datum
txData
                        , _citxRedeemers :: Redeemers
_citxRedeemers = Tx -> Redeemers
calculateRedeemerPointers Tx
tx
                        , _citxScripts :: ScriptsMap
_citxScripts = ScriptsMap
txScripts
                        , _citxCardanoTx :: Maybe SomeCardanoApiTx
_citxCardanoTx = Maybe SomeCardanoApiTx
forall a. Maybe a
Nothing
                        }
            )
            (Bool -> SomeCardanoApiTx -> ChainIndexTx
fromOnChainCardanoTx Bool
True)
            CardanoTx
ctx
    Invalid CardanoTx
ctx ->
        (Tx -> ChainIndexTx)
-> (SomeCardanoApiTx -> ChainIndexTx) -> CardanoTx -> ChainIndexTx
forall r. (Tx -> r) -> (SomeCardanoApiTx -> r) -> CardanoTx -> r
onCardanoTx
            (\case tx :: Tx
tx@Tx{[TxInput]
txCollateralInputs :: Tx -> [TxInput]
txCollateralInputs :: [TxInput]
txCollateralInputs, Maybe TxOut
txReturnCollateral :: Tx -> Maybe TxOut
txReturnCollateral :: Maybe TxOut
txReturnCollateral, SlotRange
txValidRange :: SlotRange
txValidRange :: Tx -> SlotRange
txValidRange, Map DatumHash Datum
txData :: Map DatumHash Datum
txData :: Tx -> Map DatumHash Datum
txData, ScriptsMap
txScripts :: ScriptsMap
txScripts :: Tx -> ScriptsMap
txScripts} ->
                    ChainIndexTx :: TxId
-> [TxIn]
-> ChainIndexTxOutputs
-> SlotRange
-> Map DatumHash Datum
-> Redeemers
-> ScriptsMap
-> Maybe SomeCardanoApiTx
-> ChainIndexTx
ChainIndexTx
                        { _citxTxId :: TxId
_citxTxId = Tx -> TxId
txId Tx
tx
                        , _citxInputs :: [TxIn]
_citxInputs = (TxInput -> TxIn) -> [TxInput] -> [TxIn]
forall a b. (a -> b) -> [a] -> [b]
map (Tx -> TxInput -> TxIn
fillTxInputWitnesses Tx
tx) [TxInput]
txCollateralInputs
                        , _citxOutputs :: ChainIndexTxOutputs
_citxOutputs = Maybe ChainIndexTxOut -> ChainIndexTxOutputs
InvalidTx (Maybe ChainIndexTxOut -> ChainIndexTxOutputs)
-> Maybe ChainIndexTxOut -> ChainIndexTxOutputs
forall a b. (a -> b) -> a -> b
$ (TxOut -> ChainIndexTxOut) -> Maybe TxOut -> Maybe ChainIndexTxOut
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxOut CtxTx BabbageEra -> ChainIndexTxOut
forall era. IsCardanoEra era => TxOut CtxTx era -> ChainIndexTxOut
fromCardanoTxOut (TxOut CtxTx BabbageEra -> ChainIndexTxOut)
-> (TxOut -> TxOut CtxTx BabbageEra) -> TxOut -> ChainIndexTxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> TxOut CtxTx BabbageEra
getTxOut) Maybe TxOut
txReturnCollateral
                        , _citxValidRange :: SlotRange
_citxValidRange = SlotRange
txValidRange
                        , _citxData :: Map DatumHash Datum
_citxData = Map DatumHash Datum
txData
                        , _citxRedeemers :: Redeemers
_citxRedeemers = Tx -> Redeemers
calculateRedeemerPointers Tx
tx
                        , _citxScripts :: ScriptsMap
_citxScripts = ScriptsMap
txScripts
                        , _citxCardanoTx :: Maybe SomeCardanoApiTx
_citxCardanoTx = Maybe SomeCardanoApiTx
forall a. Maybe a
Nothing
                        }
            )
            (Bool -> SomeCardanoApiTx -> ChainIndexTx
fromOnChainCardanoTx Bool
False)
            CardanoTx
ctx

txRedeemersWithHash :: ChainIndexTx -> Map RedeemerHash Redeemer
txRedeemersWithHash :: ChainIndexTx -> Map RedeemerHash Redeemer
txRedeemersWithHash ChainIndexTx{Redeemers
_citxRedeemers :: Redeemers
_citxRedeemers :: ChainIndexTx -> Redeemers
_citxRedeemers} = [(RedeemerHash, Redeemer)] -> Map RedeemerHash Redeemer
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    ([(RedeemerHash, Redeemer)] -> Map RedeemerHash Redeemer)
-> [(RedeemerHash, Redeemer)] -> Map RedeemerHash Redeemer
forall a b. (a -> b) -> a -> b
$ (Redeemer -> (RedeemerHash, Redeemer))
-> [Redeemer] -> [(RedeemerHash, Redeemer)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Redeemer
r -> (Redeemer -> RedeemerHash
redeemerHash Redeemer
r, Redeemer
r))
    ([Redeemer] -> [(RedeemerHash, Redeemer)])
-> [Redeemer] -> [(RedeemerHash, Redeemer)]
forall a b. (a -> b) -> a -> b
$ Redeemers -> [Redeemer]
forall k a. Map k a -> [a]
Map.elems Redeemers
_citxRedeemers

-- Cardano api transactions store validity internally. Our emulated blockchain stores validity outside of the transactions,
-- so we need to make sure these match up. Once we only have cardano api txs this can be removed.
fromOnChainCardanoTx :: Bool -> SomeCardanoApiTx -> ChainIndexTx
fromOnChainCardanoTx :: Bool -> SomeCardanoApiTx -> ChainIndexTx
fromOnChainCardanoTx Bool
validity (SomeTx Tx era
tx EraInMode era CardanoMode
era) = EraInMode era CardanoMode -> Tx era -> ChainIndexTx
forall era.
IsCardanoEra era =>
EraInMode era CardanoMode -> Tx era -> ChainIndexTx
fromCardanoTx EraInMode era CardanoMode
era (Tx era -> ChainIndexTx) -> Tx era -> ChainIndexTx
forall a b. (a -> b) -> a -> b
$ Bool -> Tx era -> Tx era
forall era. Bool -> Tx era -> Tx era
setValidity Bool
validity Tx era
tx

-- TODO: the index of the txin is probably incorrect as we take it from the set.
-- To determine the proper index we have to convert the plutus's `TxIn` to cardano-api `TxIn` and
-- sort them by using the standard `Ord` instance.
calculateRedeemerPointers :: Tx -> Redeemers
calculateRedeemerPointers :: Tx -> Redeemers
calculateRedeemerPointers Tx
tx = Redeemers
spends Redeemers -> Redeemers -> Redeemers
forall a. Semigroup a => a -> a -> a
<> Redeemers
rewards Redeemers -> Redeemers -> Redeemers
forall a. Semigroup a => a -> a -> a
<> Redeemers
mints Redeemers -> Redeemers -> Redeemers
forall a. Semigroup a => a -> a -> a
<> Redeemers
certs
    -- we sort the inputs to make sure that the indices match with redeemer pointers

    where
        rewards :: Redeemers
rewards = [(RedeemerPtr, Redeemer)] -> Redeemers
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(RedeemerPtr, Redeemer)] -> Redeemers)
-> [(RedeemerPtr, Redeemer)] -> Redeemers
forall a b. (a -> b) -> a -> b
$ (Integer -> (Credential, Redeemer) -> (RedeemerPtr, Redeemer))
-> [Integer]
-> [(Credential, Redeemer)]
-> [(RedeemerPtr, Redeemer)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Integer
n (Credential
_, Redeemer
rd) -> (ScriptTag -> Integer -> RedeemerPtr
RedeemerPtr ScriptTag
Reward Integer
n, Redeemer
rd)) [Integer
0..]  ([(Credential, Redeemer)] -> [(RedeemerPtr, Redeemer)])
-> [(Credential, Redeemer)] -> [(RedeemerPtr, Redeemer)]
forall a b. (a -> b) -> a -> b
$ [(Credential, Redeemer)] -> [(Credential, Redeemer)]
forall a. Ord a => [a] -> [a]
sort ([(Credential, Redeemer)] -> [(Credential, Redeemer)])
-> [(Credential, Redeemer)] -> [(Credential, Redeemer)]
forall a b. (a -> b) -> a -> b
$ Map Credential Redeemer -> [(Credential, Redeemer)]
forall k a. Map k a -> [(k, a)]
Map.assocs (Map Credential Redeemer -> [(Credential, Redeemer)])
-> Map Credential Redeemer -> [(Credential, Redeemer)]
forall a b. (a -> b) -> a -> b
$ Tx -> Map Credential Redeemer
txRewardingRedeemers Tx
tx
        mints :: Redeemers
mints   = [(RedeemerPtr, Redeemer)] -> Redeemers
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(RedeemerPtr, Redeemer)] -> Redeemers)
-> [(RedeemerPtr, Redeemer)] -> Redeemers
forall a b. (a -> b) -> a -> b
$ (Integer
 -> (MintingPolicyHash, Redeemer) -> (RedeemerPtr, Redeemer))
-> [Integer]
-> [(MintingPolicyHash, Redeemer)]
-> [(RedeemerPtr, Redeemer)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Integer
n (MintingPolicyHash
_, Redeemer
rd) -> (ScriptTag -> Integer -> RedeemerPtr
RedeemerPtr ScriptTag
Mint Integer
n, Redeemer
rd)) [Integer
0..]  ([(MintingPolicyHash, Redeemer)] -> [(RedeemerPtr, Redeemer)])
-> [(MintingPolicyHash, Redeemer)] -> [(RedeemerPtr, Redeemer)]
forall a b. (a -> b) -> a -> b
$ [(MintingPolicyHash, Redeemer)] -> [(MintingPolicyHash, Redeemer)]
forall a. Ord a => [a] -> [a]
sort ([(MintingPolicyHash, Redeemer)]
 -> [(MintingPolicyHash, Redeemer)])
-> [(MintingPolicyHash, Redeemer)]
-> [(MintingPolicyHash, Redeemer)]
forall a b. (a -> b) -> a -> b
$ Map MintingPolicyHash Redeemer -> [(MintingPolicyHash, Redeemer)]
forall k a. Map k a -> [(k, a)]
Map.assocs (Map MintingPolicyHash Redeemer -> [(MintingPolicyHash, Redeemer)])
-> Map MintingPolicyHash Redeemer
-> [(MintingPolicyHash, Redeemer)]
forall a b. (a -> b) -> a -> b
$ Tx -> Map MintingPolicyHash Redeemer
txMintingRedeemers Tx
tx
        certs :: Redeemers
certs   = [(RedeemerPtr, Redeemer)] -> Redeemers
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(RedeemerPtr, Redeemer)] -> Redeemers)
-> [(RedeemerPtr, Redeemer)] -> Redeemers
forall a b. (a -> b) -> a -> b
$ (Integer -> (DCert, Redeemer) -> (RedeemerPtr, Redeemer))
-> [Integer] -> [(DCert, Redeemer)] -> [(RedeemerPtr, Redeemer)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Integer
n (DCert
_, Redeemer
rd) -> (ScriptTag -> Integer -> RedeemerPtr
RedeemerPtr ScriptTag
Cert Integer
n, Redeemer
rd)) [Integer
0..]  ([(DCert, Redeemer)] -> [(RedeemerPtr, Redeemer)])
-> [(DCert, Redeemer)] -> [(RedeemerPtr, Redeemer)]
forall a b. (a -> b) -> a -> b
$ [(DCert, Redeemer)] -> [(DCert, Redeemer)]
forall a. Ord a => [a] -> [a]
sort ([(DCert, Redeemer)] -> [(DCert, Redeemer)])
-> [(DCert, Redeemer)] -> [(DCert, Redeemer)]
forall a b. (a -> b) -> a -> b
$ Map DCert Redeemer -> [(DCert, Redeemer)]
forall k a. Map k a -> [(k, a)]
Map.assocs (Map DCert Redeemer -> [(DCert, Redeemer)])
-> Map DCert Redeemer -> [(DCert, Redeemer)]
forall a b. (a -> b) -> a -> b
$ Tx -> Map DCert Redeemer
txCertifyingRedeemers Tx
tx
        spends :: Redeemers
spends = [(RedeemerPtr, Redeemer)] -> Redeemers
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(RedeemerPtr, Redeemer)] -> Redeemers)
-> [(RedeemerPtr, Redeemer)] -> Redeemers
forall a b. (a -> b) -> a -> b
$ ((Integer, TxInputType) -> Maybe (RedeemerPtr, Redeemer))
-> [(Integer, TxInputType)] -> [(RedeemerPtr, Redeemer)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Integer -> TxInputType -> Maybe (RedeemerPtr, Redeemer))
-> (Integer, TxInputType) -> Maybe (RedeemerPtr, Redeemer)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Integer -> TxInputType -> Maybe (RedeemerPtr, Redeemer)
getRd) ([(Integer, TxInputType)] -> [(RedeemerPtr, Redeemer)])
-> [(Integer, TxInputType)] -> [(RedeemerPtr, Redeemer)]
forall a b. (a -> b) -> a -> b
$ [Integer] -> [TxInputType] -> [(Integer, TxInputType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] ([TxInputType] -> [(Integer, TxInputType)])
-> [TxInputType] -> [(Integer, TxInputType)]
forall a b. (a -> b) -> a -> b
$ (TxInput -> TxInputType) -> [TxInput] -> [TxInputType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxInput -> TxInputType
txInputType ([TxInput] -> [TxInputType]) -> [TxInput] -> [TxInputType]
forall a b. (a -> b) -> a -> b
$ [TxInput] -> [TxInput]
forall a. Ord a => [a] -> [a]
sort ([TxInput] -> [TxInput]) -> [TxInput] -> [TxInput]
forall a b. (a -> b) -> a -> b
$ Tx -> [TxInput]
txInputs Tx
tx

        getRd :: Integer -> TxInputType -> Maybe (RedeemerPtr, Redeemer)
getRd Integer
n = \case
            TxScriptAddress Redeemer
rd Either ValidatorHash (Versioned TxOutRef)
_ Maybe DatumHash
_ -> (RedeemerPtr, Redeemer) -> Maybe (RedeemerPtr, Redeemer)
forall a. a -> Maybe a
Just (ScriptTag -> Integer -> RedeemerPtr
RedeemerPtr ScriptTag
Spend Integer
n, Redeemer
rd)
            TxInputType
_                      -> Maybe (RedeemerPtr, Redeemer)
forall a. Maybe a
Nothing