{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.Ledger.Alonzo.PlutusScriptApi
  ( -- Figure 8
    getSpendingTxIn,
    getDatumAlonzo,
    evalScripts,
    -- Figure 12
    scriptsNeeded,
    scriptsNeededFromBody,
    language,
    CollectError (..),
    collectTwoPhaseScriptInputs,
    knownToNotBe1Phase,
  )
where

import Cardano.Binary (FromCBOR (..), ToCBOR (..))
import Cardano.Ledger.Alonzo.Data (getPlutusData)
import Cardano.Ledger.Alonzo.Language (Language (..))
import Cardano.Ledger.Alonzo.Scripts (CostModel, CostModels (..), ExUnits (..))
import qualified Cardano.Ledger.Alonzo.Scripts as AlonzoScript (Script (..))
import Cardano.Ledger.Alonzo.Tx
  ( Data,
    DataHash,
    ScriptPurpose (..),
    indexedRdmrs,
    txdats',
  )
import Cardano.Ledger.Alonzo.TxInfo
  ( ExtendedUTxO (..),
    ScriptResult (..),
    TranslationError (..),
    runPLCScript,
    valContext,
  )
import Cardano.Ledger.Alonzo.TxWitness (TxWitness, unTxDats)
import Cardano.Ledger.BaseTypes (ProtVer, StrictMaybe (..))
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Credential (Credential (ScriptHashObj))
import qualified Cardano.Ledger.Crypto as CC (Crypto)
import Cardano.Ledger.Era (Era (..))
import Cardano.Ledger.Mary.Value (PolicyID (..))
import Cardano.Ledger.Shelley.Delegation.Certificates (DCert (..))
import Cardano.Ledger.Shelley.Scripts (ScriptHash (..))
import Cardano.Ledger.Shelley.TxBody
  ( DelegCert (..),
    Delegation (..),
    Wdrl (..),
    getRwdCred,
  )
import Cardano.Ledger.Shelley.UTxO (UTxO (..), getScriptHash, scriptCred)
import Cardano.Ledger.ShelleyMA.TxBody (ValidityInterval)
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.Slotting.EpochInfo (EpochInfo)
import Cardano.Slotting.Time (SystemStart)
import Data.ByteString.Short (ShortByteString)
import Data.Coders
import Data.Foldable (foldl')
import Data.List (intercalate)
import qualified Data.Map.Strict as Map
import Data.Maybe (mapMaybe)
import Data.Proxy (Proxy (..))
import Data.Sequence.Strict (StrictSeq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import Debug.Trace (traceEvent)
import GHC.Generics
import GHC.Records (HasField (..))
import NoThunks.Class (NoThunks)

-- ===============================================================
-- From the specification, Figure 8 "Scripts and their Arguments"
-- ===============================================================

-- | Only the Spending ScriptPurpose contains TxIn
getSpendingTxIn :: ScriptPurpose crypto -> Maybe (TxIn crypto)
getSpendingTxIn :: ScriptPurpose crypto -> Maybe (TxIn crypto)
getSpendingTxIn = \case
  Spending TxIn crypto
txin -> TxIn crypto -> Maybe (TxIn crypto)
forall a. a -> Maybe a
Just TxIn crypto
txin
  Minting PolicyID crypto
_policyid -> Maybe (TxIn crypto)
forall a. Maybe a
Nothing
  Rewarding RewardAcnt crypto
_rewaccnt -> Maybe (TxIn crypto)
forall a. Maybe a
Nothing
  Certifying DCert crypto
_dcert -> Maybe (TxIn crypto)
forall a. Maybe a
Nothing

-- | Get the Data associated with a ScriptPurpose. Only the Spending
--   ScriptPurpose contains Data. The null list is returned for the other kinds.
getDatumAlonzo ::
  forall era tx.
  ( HasField "datahash" (Core.TxOut era) (StrictMaybe (DataHash (Crypto era))),
    HasField "wits" tx (TxWitness era)
  ) =>
  tx ->
  UTxO era ->
  ScriptPurpose (Crypto era) ->
  Maybe (Data era)
getDatumAlonzo :: tx -> UTxO era -> ScriptPurpose (Crypto era) -> Maybe (Data era)
getDatumAlonzo tx
tx (UTxO Map (TxIn (Crypto era)) (TxOut era)
m) ScriptPurpose (Crypto era)
sp = do
  TxIn (Crypto era)
txIn <- ScriptPurpose (Crypto era) -> Maybe (TxIn (Crypto era))
forall crypto. ScriptPurpose crypto -> Maybe (TxIn crypto)
getSpendingTxIn ScriptPurpose (Crypto era)
sp
  TxOut era
txOut <- TxIn (Crypto era)
-> Map (TxIn (Crypto era)) (TxOut era) -> Maybe (TxOut era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn (Crypto era)
txIn Map (TxIn (Crypto era)) (TxOut era)
m
  SJust DataHash (Crypto era)
hash <- StrictMaybe (DataHash (Crypto era))
-> Maybe (StrictMaybe (DataHash (Crypto era)))
forall a. a -> Maybe a
Just (StrictMaybe (DataHash (Crypto era))
 -> Maybe (StrictMaybe (DataHash (Crypto era))))
-> StrictMaybe (DataHash (Crypto era))
-> Maybe (StrictMaybe (DataHash (Crypto era)))
forall a b. (a -> b) -> a -> b
$ TxOut era -> StrictMaybe (DataHash (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"datahash" TxOut era
txOut
  DataHash (Crypto era)
-> Map (DataHash (Crypto era)) (Data era) -> Maybe (Data era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DataHash (Crypto era)
hash (TxDats era -> Map (DataHash (Crypto era)) (Data era)
forall era. TxDats era -> Map (DataHash (Crypto era)) (Data era)
unTxDats (TxDats era -> Map (DataHash (Crypto era)) (Data era))
-> TxDats era -> Map (DataHash (Crypto era)) (Data era)
forall a b. (a -> b) -> a -> b
$ TxWitness era -> TxDats era
forall era. TxWitness era -> TxDats era
txdats' (tx -> TxWitness era
forall k (x :: k) r a. HasField x r a => r -> a
getField @"wits" tx
tx))

-- ========================================================================

-- | When collecting inputs for twophase scripts, 3 things can go wrong.
data CollectError crypto
  = NoRedeemer !(ScriptPurpose crypto)
  | NoWitness !(ScriptHash crypto)
  | NoCostModel !Language
  | BadTranslation !(TranslationError crypto)
  deriving (CollectError crypto -> CollectError crypto -> Bool
(CollectError crypto -> CollectError crypto -> Bool)
-> (CollectError crypto -> CollectError crypto -> Bool)
-> Eq (CollectError crypto)
forall crypto. CollectError crypto -> CollectError crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CollectError crypto -> CollectError crypto -> Bool
$c/= :: forall crypto. CollectError crypto -> CollectError crypto -> Bool
== :: CollectError crypto -> CollectError crypto -> Bool
$c== :: forall crypto. CollectError crypto -> CollectError crypto -> Bool
Eq, Int -> CollectError crypto -> ShowS
[CollectError crypto] -> ShowS
CollectError crypto -> String
(Int -> CollectError crypto -> ShowS)
-> (CollectError crypto -> String)
-> ([CollectError crypto] -> ShowS)
-> Show (CollectError crypto)
forall crypto. Int -> CollectError crypto -> ShowS
forall crypto. [CollectError crypto] -> ShowS
forall crypto. CollectError crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CollectError crypto] -> ShowS
$cshowList :: forall crypto. [CollectError crypto] -> ShowS
show :: CollectError crypto -> String
$cshow :: forall crypto. CollectError crypto -> String
showsPrec :: Int -> CollectError crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> CollectError crypto -> ShowS
Show, (forall x. CollectError crypto -> Rep (CollectError crypto) x)
-> (forall x. Rep (CollectError crypto) x -> CollectError crypto)
-> Generic (CollectError crypto)
forall x. Rep (CollectError crypto) x -> CollectError crypto
forall x. CollectError crypto -> Rep (CollectError crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (CollectError crypto) x -> CollectError crypto
forall crypto x. CollectError crypto -> Rep (CollectError crypto) x
$cto :: forall crypto x. Rep (CollectError crypto) x -> CollectError crypto
$cfrom :: forall crypto x. CollectError crypto -> Rep (CollectError crypto) x
Generic, Context -> CollectError crypto -> IO (Maybe ThunkInfo)
Proxy (CollectError crypto) -> String
(Context -> CollectError crypto -> IO (Maybe ThunkInfo))
-> (Context -> CollectError crypto -> IO (Maybe ThunkInfo))
-> (Proxy (CollectError crypto) -> String)
-> NoThunks (CollectError crypto)
forall crypto.
Context -> CollectError crypto -> IO (Maybe ThunkInfo)
forall crypto. Proxy (CollectError crypto) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (CollectError crypto) -> String
$cshowTypeOf :: forall crypto. Proxy (CollectError crypto) -> String
wNoThunks :: Context -> CollectError crypto -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto.
Context -> CollectError crypto -> IO (Maybe ThunkInfo)
noThunks :: Context -> CollectError crypto -> IO (Maybe ThunkInfo)
$cnoThunks :: forall crypto.
Context -> CollectError crypto -> IO (Maybe ThunkInfo)
NoThunks)

instance (CC.Crypto crypto) => ToCBOR (CollectError crypto) where
  toCBOR :: CollectError crypto -> Encoding
toCBOR (NoRedeemer ScriptPurpose crypto
x) = Encode 'Open (CollectError crypto) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open (CollectError crypto) -> Encoding)
-> Encode 'Open (CollectError crypto) -> Encoding
forall a b. (a -> b) -> a -> b
$ (ScriptPurpose crypto -> CollectError crypto)
-> Word
-> Encode 'Open (ScriptPurpose crypto -> CollectError crypto)
forall t. t -> Word -> Encode 'Open t
Sum ScriptPurpose crypto -> CollectError crypto
forall crypto. ScriptPurpose crypto -> CollectError crypto
NoRedeemer Word
0 Encode 'Open (ScriptPurpose crypto -> CollectError crypto)
-> Encode ('Closed 'Dense) (ScriptPurpose crypto)
-> Encode 'Open (CollectError crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ScriptPurpose crypto
-> Encode ('Closed 'Dense) (ScriptPurpose crypto)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To ScriptPurpose crypto
x
  toCBOR (NoWitness ScriptHash crypto
x) = Encode 'Open (CollectError crypto) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open (CollectError crypto) -> Encoding)
-> Encode 'Open (CollectError crypto) -> Encoding
forall a b. (a -> b) -> a -> b
$ (ScriptHash crypto -> CollectError crypto)
-> Word -> Encode 'Open (ScriptHash crypto -> CollectError crypto)
forall t. t -> Word -> Encode 'Open t
Sum ScriptHash crypto -> CollectError crypto
forall crypto. ScriptHash crypto -> CollectError crypto
NoWitness Word
1 Encode 'Open (ScriptHash crypto -> CollectError crypto)
-> Encode ('Closed 'Dense) (ScriptHash crypto)
-> Encode 'Open (CollectError crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ScriptHash crypto -> Encode ('Closed 'Dense) (ScriptHash crypto)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To ScriptHash crypto
x
  toCBOR (NoCostModel Language
x) = Encode 'Open (CollectError Any) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open (CollectError Any) -> Encoding)
-> Encode 'Open (CollectError Any) -> Encoding
forall a b. (a -> b) -> a -> b
$ (Language -> CollectError Any)
-> Word -> Encode 'Open (Language -> CollectError Any)
forall t. t -> Word -> Encode 'Open t
Sum Language -> CollectError Any
forall crypto. Language -> CollectError crypto
NoCostModel Word
2 Encode 'Open (Language -> CollectError Any)
-> Encode ('Closed 'Dense) Language
-> Encode 'Open (CollectError Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Language -> Encode ('Closed 'Dense) Language
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Language
x
  toCBOR (BadTranslation TranslationError crypto
x) = Encode 'Open (CollectError crypto) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open (CollectError crypto) -> Encoding)
-> Encode 'Open (CollectError crypto) -> Encoding
forall a b. (a -> b) -> a -> b
$ (TranslationError crypto -> CollectError crypto)
-> Word
-> Encode 'Open (TranslationError crypto -> CollectError crypto)
forall t. t -> Word -> Encode 'Open t
Sum TranslationError crypto -> CollectError crypto
forall crypto. TranslationError crypto -> CollectError crypto
BadTranslation Word
3 Encode 'Open (TranslationError crypto -> CollectError crypto)
-> Encode ('Closed 'Dense) (TranslationError crypto)
-> Encode 'Open (CollectError crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> TranslationError crypto
-> Encode ('Closed 'Dense) (TranslationError crypto)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To TranslationError crypto
x

instance (CC.Crypto crypto) => FromCBOR (CollectError crypto) where
  fromCBOR :: Decoder s (CollectError crypto)
fromCBOR = Decode ('Closed 'Dense) (CollectError crypto)
-> Decoder s (CollectError crypto)
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (String
-> (Word -> Decode 'Open (CollectError crypto))
-> Decode ('Closed 'Dense) (CollectError crypto)
forall t.
String -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands String
"CollectError" Word -> Decode 'Open (CollectError crypto)
forall crypto.
Crypto crypto =>
Word -> Decode 'Open (CollectError crypto)
dec)
    where
      dec :: Word -> Decode 'Open (CollectError crypto)
dec Word
0 = (ScriptPurpose crypto -> CollectError crypto)
-> Decode 'Open (ScriptPurpose crypto -> CollectError crypto)
forall t. t -> Decode 'Open t
SumD ScriptPurpose crypto -> CollectError crypto
forall crypto. ScriptPurpose crypto -> CollectError crypto
NoRedeemer Decode 'Open (ScriptPurpose crypto -> CollectError crypto)
-> Decode ('Closed Any) (ScriptPurpose crypto)
-> Decode 'Open (CollectError crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (ScriptPurpose crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      dec Word
1 = (ScriptHash crypto -> CollectError crypto)
-> Decode 'Open (ScriptHash crypto -> CollectError crypto)
forall t. t -> Decode 'Open t
SumD ScriptHash crypto -> CollectError crypto
forall crypto. ScriptHash crypto -> CollectError crypto
NoWitness Decode 'Open (ScriptHash crypto -> CollectError crypto)
-> Decode ('Closed Any) (ScriptHash crypto)
-> Decode 'Open (CollectError crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (ScriptHash crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      dec Word
2 = (Language -> CollectError crypto)
-> Decode 'Open (Language -> CollectError crypto)
forall t. t -> Decode 'Open t
SumD Language -> CollectError crypto
forall crypto. Language -> CollectError crypto
NoCostModel Decode 'Open (Language -> CollectError crypto)
-> Decode ('Closed Any) Language
-> Decode 'Open (CollectError crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Language
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      dec Word
3 = (TranslationError crypto -> CollectError crypto)
-> Decode 'Open (TranslationError crypto -> CollectError crypto)
forall t. t -> Decode 'Open t
SumD TranslationError crypto -> CollectError crypto
forall crypto. TranslationError crypto -> CollectError crypto
BadTranslation Decode 'Open (TranslationError crypto -> CollectError crypto)
-> Decode ('Closed Any) (TranslationError crypto)
-> Decode 'Open (CollectError crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (TranslationError crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      dec Word
n = Word -> Decode 'Open (CollectError crypto)
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

-- Given a script purpose and a script hash, determine if it is *not*
-- a simple 1-phase script by looking up the script hash in a mapping
-- of script hashes to labeled scripts.
-- If the script is determined to not be a 1-phase script, we return
-- a triple: the script purpose, the language, and the script bytes.
--
-- The formal spec achieves the same filtering as knownToNotBe1Phase
-- by use of the (partial) language function, which is not defined on 1-phase scripts.
knownToNotBe1Phase ::
  Map.Map (ScriptHash (Crypto era)) (AlonzoScript.Script era) ->
  (ScriptPurpose (Crypto era), ScriptHash (Crypto era)) ->
  Maybe (ScriptPurpose (Crypto era), Language, ShortByteString)
knownToNotBe1Phase :: Map (ScriptHash (Crypto era)) (Script era)
-> (ScriptPurpose (Crypto era), ScriptHash (Crypto era))
-> Maybe (ScriptPurpose (Crypto era), Language, ShortByteString)
knownToNotBe1Phase Map (ScriptHash (Crypto era)) (Script era)
scriptsAvailable (ScriptPurpose (Crypto era)
sp, ScriptHash (Crypto era)
sh) = do
  AlonzoScript.PlutusScript Language
lang ShortByteString
script <- ScriptHash (Crypto era)
sh ScriptHash (Crypto era)
-> Map (ScriptHash (Crypto era)) (Script era) -> Maybe (Script era)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map (ScriptHash (Crypto era)) (Script era)
scriptsAvailable
  (ScriptPurpose (Crypto era), Language, ShortByteString)
-> Maybe (ScriptPurpose (Crypto era), Language, ShortByteString)
forall a. a -> Maybe a
Just (ScriptPurpose (Crypto era)
sp, Language
lang, ShortByteString
script)

-- | Collect the inputs for twophase scripts. If any script can't find ist data return
--     a list of CollectError, if all goes well return a list of quadruples with the inputs.
--     Previous PredicateFailure tests should ensure we find Data for every script, BUT
--     the consequences of not finding Data means scripts can get dropped, so things
--     might validate that shouldn't. So we double check that every Script has its Data, and
--     if that is not the case, a PredicateFailure is raised in the Utxos rule.
collectTwoPhaseScriptInputs ::
  forall era.
  ( Era era,
    ExtendedUTxO era,
    Core.Script era ~ AlonzoScript.Script era,
    HasField "_costmdls" (Core.PParams era) CostModels,
    HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)),
    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
    HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
    HasField "wits" (Core.Tx era) (TxWitness era)
  ) =>
  EpochInfo (Either Text) ->
  SystemStart ->
  Core.PParams era ->
  Core.Tx era ->
  UTxO era ->
  Either [CollectError (Crypto era)] [(ShortByteString, Language, [Data era], ExUnits, CostModel)]
collectTwoPhaseScriptInputs :: EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> Tx era
-> UTxO era
-> Either
     [CollectError (Crypto era)]
     [(ShortByteString, Language, [Data era], ExUnits, CostModel)]
collectTwoPhaseScriptInputs EpochInfo (Either Text)
ei SystemStart
sysS PParams era
pp Tx era
tx UTxO era
utxo =
  let usedLanguages :: Set Language
usedLanguages = [Language] -> Set Language
forall a. Ord a => [a] -> Set a
Set.fromList [Language
lang | (ScriptPurpose (Crypto era)
_, Language
lang, ShortByteString
_) <- [(ScriptPurpose (Crypto era), Language, ShortByteString)]
neededAndConfirmedToBePlutus]
      costModels :: Map Language CostModel
costModels = CostModels -> Map Language CostModel
unCostModels (CostModels -> Map Language CostModel)
-> CostModels -> Map Language CostModel
forall a b. (a -> b) -> a -> b
$ PParams era -> CostModels
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_costmdls" PParams era
pp
      missingCMs :: Set Language
missingCMs = (Language -> Bool) -> Set Language -> Set Language
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Language -> Map Language CostModel -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.notMember` Map Language CostModel
costModels) Set Language
usedLanguages
   in case Set Language -> Maybe Language
forall a. Set a -> Maybe a
Set.lookupMin Set Language
missingCMs of
        Just Language
l -> [CollectError (Crypto era)]
-> Either
     [CollectError (Crypto era)]
     [(ShortByteString, Language, [Data era], ExUnits, CostModel)]
forall a b. a -> Either a b
Left [Language -> CollectError (Crypto era)
forall crypto. Language -> CollectError crypto
NoCostModel Language
l]
        Maybe Language
Nothing ->
          ((Language, ScriptPurpose (Crypto era), Data era, ExUnits)
 -> ShortByteString
 -> Either
      (CollectError (Crypto era))
      (ShortByteString, Language, [Data era], ExUnits, CostModel))
-> [Either
      (CollectError (Crypto era))
      (Language, ScriptPurpose (Crypto era), Data era, ExUnits)]
-> [ShortByteString]
-> Either
     [CollectError (Crypto era)]
     [(ShortByteString, Language, [Data era], ExUnits, CostModel)]
-> Either
     [CollectError (Crypto era)]
     [(ShortByteString, Language, [Data era], ExUnits, CostModel)]
forall t1 t2 a1 a2.
(t1 -> t2 -> Either a2 a1)
-> [Either a2 t1] -> [t2] -> Either [a2] [a1] -> Either [a2] [a1]
merge
            (Map Language CostModel
-> (Language, ScriptPurpose (Crypto era), Data era, ExUnits)
-> ShortByteString
-> Either
     (CollectError (Crypto era))
     (ShortByteString, Language, [Data era], ExUnits, CostModel)
apply Map Language CostModel
costModels)
            (((ScriptPurpose (Crypto era), Language, ShortByteString)
 -> Either
      (CollectError (Crypto era))
      (Language, ScriptPurpose (Crypto era), Data era, ExUnits))
-> [(ScriptPurpose (Crypto era), Language, ShortByteString)]
-> [Either
      (CollectError (Crypto era))
      (Language, ScriptPurpose (Crypto era), Data era, ExUnits)]
forall a b. (a -> b) -> [a] -> [b]
map (ScriptPurpose (Crypto era), Language, ShortByteString)
-> Either
     (CollectError (Crypto era))
     (Language, ScriptPurpose (Crypto era), Data era, ExUnits)
redeemer [(ScriptPurpose (Crypto era), Language, ShortByteString)]
neededAndConfirmedToBePlutus)
            (((ScriptPurpose (Crypto era), Language, ShortByteString)
 -> ShortByteString)
-> [(ScriptPurpose (Crypto era), Language, ShortByteString)]
-> [ShortByteString]
forall a b. (a -> b) -> [a] -> [b]
map (ScriptPurpose (Crypto era), Language, ShortByteString)
-> ShortByteString
forall a b c. (a, b, c) -> c
getscript [(ScriptPurpose (Crypto era), Language, ShortByteString)]
neededAndConfirmedToBePlutus)
            ([(ShortByteString, Language, [Data era], ExUnits, CostModel)]
-> Either
     [CollectError (Crypto era)]
     [(ShortByteString, Language, [Data era], ExUnits, CostModel)]
forall a b. b -> Either a b
Right [])
  where
    scriptsAvailable :: Map (ScriptHash (Crypto era)) (Script era)
scriptsAvailable = UTxO era -> Tx era -> Map (ScriptHash (Crypto era)) (Script era)
forall era.
ExtendedUTxO era =>
UTxO era -> Tx era -> Map (ScriptHash (Crypto era)) (Script era)
txscripts UTxO era
utxo Tx era
tx
    txinfo :: Language -> Either (TranslationError (Crypto era)) VersionedTxInfo
txinfo Language
lang = PParams era
-> Language
-> EpochInfo (Either Text)
-> SystemStart
-> UTxO era
-> Tx era
-> Either (TranslationError (Crypto era)) VersionedTxInfo
forall era.
ExtendedUTxO era =>
PParams era
-> Language
-> EpochInfo (Either Text)
-> SystemStart
-> UTxO era
-> Tx era
-> Either (TranslationError (Crypto era)) VersionedTxInfo
txInfo PParams era
pp Language
lang EpochInfo (Either Text)
ei SystemStart
sysS UTxO era
utxo Tx era
tx
    neededAndConfirmedToBePlutus :: [(ScriptPurpose (Crypto era), Language, ShortByteString)]
neededAndConfirmedToBePlutus =
      ((ScriptPurpose (Crypto era), ScriptHash (Crypto era))
 -> Maybe (ScriptPurpose (Crypto era), Language, ShortByteString))
-> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
-> [(ScriptPurpose (Crypto era), Language, ShortByteString)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Map (ScriptHash (Crypto era)) (Script era)
-> (ScriptPurpose (Crypto era), ScriptHash (Crypto era))
-> Maybe (ScriptPurpose (Crypto era), Language, ShortByteString)
forall era.
Map (ScriptHash (Crypto era)) (Script era)
-> (ScriptPurpose (Crypto era), ScriptHash (Crypto era))
-> Maybe (ScriptPurpose (Crypto era), Language, ShortByteString)
knownToNotBe1Phase Map (ScriptHash (Crypto era)) (Script era)
Map (ScriptHash (Crypto era)) (Script era)
scriptsAvailable) ([(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
 -> [(ScriptPurpose (Crypto era), Language, ShortByteString)])
-> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
-> [(ScriptPurpose (Crypto era), Language, ShortByteString)]
forall a b. (a -> b) -> a -> b
$ UTxO era
-> Tx era
-> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
forall era tx.
(Era era, HasField "inputs" (TxBody era) (Set (TxIn (Crypto era))),
 HasField "wdrls" (TxBody era) (Wdrl (Crypto era)),
 HasField "certs" (TxBody era) (StrictSeq (DCert (Crypto era))),
 HasField "body" tx (TxBody era)) =>
UTxO era
-> tx -> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
scriptsNeeded UTxO era
utxo Tx era
tx
    redeemer :: (ScriptPurpose (Crypto era), Language, ShortByteString)
-> Either
     (CollectError (Crypto era))
     (Language, ScriptPurpose (Crypto era), Data era, ExUnits)
redeemer (ScriptPurpose (Crypto era)
sp, Language
lang, ShortByteString
_) =
      case Tx era -> ScriptPurpose (Crypto era) -> Maybe (Data era, ExUnits)
forall era tx.
(Era era, HasField "inputs" (TxBody era) (Set (TxIn (Crypto era))),
 HasField "wdrls" (TxBody era) (Wdrl (Crypto era)),
 HasField "certs" (TxBody era) (StrictSeq (DCert (Crypto era))),
 HasField "wits" tx (TxWitness era),
 HasField "body" tx (TxBody era)) =>
tx -> ScriptPurpose (Crypto era) -> Maybe (Data era, ExUnits)
indexedRdmrs Tx era
tx ScriptPurpose (Crypto era)
sp of
        Just (Data era
d, ExUnits
eu) -> (Language, ScriptPurpose (Crypto era), Data era, ExUnits)
-> Either
     (CollectError (Crypto era))
     (Language, ScriptPurpose (Crypto era), Data era, ExUnits)
forall a b. b -> Either a b
Right (Language
lang, ScriptPurpose (Crypto era)
sp, Data era
d, ExUnits
eu)
        Maybe (Data era, ExUnits)
Nothing -> CollectError (Crypto era)
-> Either
     (CollectError (Crypto era))
     (Language, ScriptPurpose (Crypto era), Data era, ExUnits)
forall a b. a -> Either a b
Left (ScriptPurpose (Crypto era) -> CollectError (Crypto era)
forall crypto. ScriptPurpose crypto -> CollectError crypto
NoRedeemer ScriptPurpose (Crypto era)
sp)
    getscript :: (a, b, c) -> c
getscript (a
_, b
_, c
script) = c
script
    apply :: Map Language CostModel
-> (Language, ScriptPurpose (Crypto era), Data era, ExUnits)
-> ShortByteString
-> Either
     (CollectError (Crypto era))
     (ShortByteString, Language, [Data era], ExUnits, CostModel)
apply Map Language CostModel
costs (Language
lang, ScriptPurpose (Crypto era)
sp, Data era
d, ExUnits
eu) ShortByteString
script =
      case Language -> Either (TranslationError (Crypto era)) VersionedTxInfo
txinfo Language
lang of
        Right VersionedTxInfo
inf ->
          let datums :: [Data era]
datums = ([Data era] -> [Data era])
-> (Data era -> [Data era] -> [Data era])
-> Maybe (Data era)
-> [Data era]
-> [Data era]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Data era] -> [Data era]
forall a. a -> a
id (:) (Tx era
-> UTxO era -> ScriptPurpose (Crypto era) -> Maybe (Data era)
forall era.
ExtendedUTxO era =>
Tx era
-> UTxO era -> ScriptPurpose (Crypto era) -> Maybe (Data era)
getDatum Tx era
tx UTxO era
utxo ScriptPurpose (Crypto era)
sp) [Data era
d, VersionedTxInfo -> ScriptPurpose (Crypto era) -> Data era
forall era.
VersionedTxInfo -> ScriptPurpose (Crypto era) -> Data era
valContext VersionedTxInfo
inf ScriptPurpose (Crypto era)
sp]
           in (ShortByteString, Language, [Data era], ExUnits, CostModel)
-> Either
     (CollectError (Crypto era))
     (ShortByteString, Language, [Data era], ExUnits, CostModel)
forall a b. b -> Either a b
Right (ShortByteString
script, Language
lang, [Data era]
datums, ExUnits
eu, Map Language CostModel
costs Map Language CostModel -> Language -> CostModel
forall k a. Ord k => Map k a -> k -> a
Map.! Language
lang)
        Left TranslationError (Crypto era)
te -> CollectError (Crypto era)
-> Either
     (CollectError (Crypto era))
     (ShortByteString, Language, [Data era], ExUnits, CostModel)
forall a b. a -> Either a b
Left (CollectError (Crypto era)
 -> Either
      (CollectError (Crypto era))
      (ShortByteString, Language, [Data era], ExUnits, CostModel))
-> CollectError (Crypto era)
-> Either
     (CollectError (Crypto era))
     (ShortByteString, Language, [Data era], ExUnits, CostModel)
forall a b. (a -> b) -> a -> b
$ TranslationError (Crypto era) -> CollectError (Crypto era)
forall crypto. TranslationError crypto -> CollectError crypto
BadTranslation TranslationError (Crypto era)
te

-- | Merge two lists (the first of which may have failures, i.e. (Left _)), collect all the failures
--   but if there are none, use 'f' to construct a success.
merge :: forall t1 t2 a1 a2. (t1 -> t2 -> Either a2 a1) -> [Either a2 t1] -> [t2] -> Either [a2] [a1] -> Either [a2] [a1]
merge :: (t1 -> t2 -> Either a2 a1)
-> [Either a2 t1] -> [t2] -> Either [a2] [a1] -> Either [a2] [a1]
merge t1 -> t2 -> Either a2 a1
_f [] [] Either [a2] [a1]
answer = Either [a2] [a1]
answer
merge t1 -> t2 -> Either a2 a1
_f [] (t2
_ : [t2]
_) Either [a2] [a1]
answer = Either [a2] [a1]
answer
merge t1 -> t2 -> Either a2 a1
_f (Either a2 t1
_ : [Either a2 t1]
_) [] Either [a2] [a1]
answer = Either [a2] [a1]
answer
merge t1 -> t2 -> Either a2 a1
f (Either a2 t1
x : [Either a2 t1]
xs) (t2
y : [t2]
ys) Either [a2] [a1]
zs = (t1 -> t2 -> Either a2 a1)
-> [Either a2 t1] -> [t2] -> Either [a2] [a1] -> Either [a2] [a1]
forall t1 t2 a1 a2.
(t1 -> t2 -> Either a2 a1)
-> [Either a2 t1] -> [t2] -> Either [a2] [a1] -> Either [a2] [a1]
merge t1 -> t2 -> Either a2 a1
f [Either a2 t1]
xs [t2]
ys (Either a2 t1 -> t2 -> Either [a2] [a1] -> Either [a2] [a1]
gg Either a2 t1
x t2
y Either [a2] [a1]
zs)
  where
    gg :: Either a2 t1 -> t2 -> Either [a2] [a1] -> Either [a2] [a1]
    gg :: Either a2 t1 -> t2 -> Either [a2] [a1] -> Either [a2] [a1]
gg (Right t1
a) t2
b (Right [a1]
cs) =
      case t1 -> t2 -> Either a2 a1
f t1
a t2
b of
        Right a1
c -> [a1] -> Either [a2] [a1]
forall a b. b -> Either a b
Right ([a1] -> Either [a2] [a1]) -> [a1] -> Either [a2] [a1]
forall a b. (a -> b) -> a -> b
$ a1
c a1 -> [a1] -> [a1]
forall a. a -> [a] -> [a]
: [a1]
cs
        Left a2
e -> [a2] -> Either [a2] [a1]
forall a b. a -> Either a b
Left [a2
e]
    gg (Left a2
a) t2
_ (Right [a1]
_) = [a2] -> Either [a2] [a1]
forall a b. a -> Either a b
Left [a2
a]
    gg (Right t1
_) t2
_ (Left [a2]
cs) = [a2] -> Either [a2] [a1]
forall a b. a -> Either a b
Left [a2]
cs
    gg (Left a2
a) t2
_ (Left [a2]
cs) = [a2] -> Either [a2] [a1]
forall a b. a -> Either a b
Left (a2
a a2 -> [a2] -> [a2]
forall a. a -> [a] -> [a]
: [a2]
cs)

language :: AlonzoScript.Script era -> Maybe Language
language :: Script era -> Maybe Language
language (AlonzoScript.PlutusScript Language
lang ShortByteString
_) = Language -> Maybe Language
forall a. a -> Maybe a
Just Language
lang
language (AlonzoScript.TimelockScript Timelock (Crypto era)
_) = Maybe Language
forall a. Maybe a
Nothing

-- | evaluate a list of scripts, All scripts in the list must be True.
--   There are two kinds of scripts, evaluate each kind using the
--   appropriate mechanism.
evalScripts ::
  forall era tx.
  ( Era era,
    Show (AlonzoScript.Script era),
    HasField "body" tx (Core.TxBody era),
    HasField "wits" tx (TxWitness era),
    HasField "vldt" (Core.TxBody era) ValidityInterval
  ) =>
  ProtVer ->
  tx ->
  [(ShortByteString, Language, [Data era], ExUnits, CostModel)] ->
  ScriptResult
evalScripts :: ProtVer
-> tx
-> [(ShortByteString, Language, [Data era], ExUnits, CostModel)]
-> ScriptResult
evalScripts ProtVer
_pv tx
_tx [] = ScriptResult
forall a. Monoid a => a
mempty
evalScripts ProtVer
pv tx
tx ((ShortByteString
pscript, Language
lang, [Data era]
ds, ExUnits
units, CostModel
cost) : [(ShortByteString, Language, [Data era], ExUnits, CostModel)]
rest) =
  let beginMsg :: String
beginMsg =
        String -> Context -> String
forall a. [a] -> [[a]] -> [a]
intercalate
          String
","
          [ String
"[LEDGER][PLUTUS_SCRIPT]",
            String
"BEGIN"
          ]
      !res :: ScriptResult
res = String -> ScriptResult -> ScriptResult
forall a. String -> a -> a
traceEvent String
beginMsg (ScriptResult -> ScriptResult) -> ScriptResult -> ScriptResult
forall a b. (a -> b) -> a -> b
$ Proxy era
-> ProtVer
-> Language
-> CostModel
-> ShortByteString
-> ExUnits
-> [Data]
-> ScriptResult
forall era.
Show (Script era) =>
Proxy era
-> ProtVer
-> Language
-> CostModel
-> ShortByteString
-> ExUnits
-> [Data]
-> ScriptResult
runPLCScript (Proxy era
forall k (t :: k). Proxy t
Proxy @era) ProtVer
pv Language
lang CostModel
cost ShortByteString
pscript ExUnits
units ((Data era -> Data) -> [Data era] -> [Data]
forall a b. (a -> b) -> [a] -> [b]
map Data era -> Data
forall era. Data era -> Data
getPlutusData [Data era]
ds)
      endMsg :: String
endMsg =
        String -> Context -> String
forall a. [a] -> [[a]] -> [a]
intercalate
          String
","
          [ String
"[LEDGER][PLUTUS_SCRIPT]",
            String
"END"
          ]
   in String -> ScriptResult -> ScriptResult
forall a. String -> a -> a
traceEvent String
endMsg ScriptResult
res ScriptResult -> ScriptResult -> ScriptResult
forall a. Semigroup a => a -> a -> a
<> ProtVer
-> tx
-> [(ShortByteString, Language, [Data era], ExUnits, CostModel)]
-> ScriptResult
forall era tx.
(Era era, Show (Script era), HasField "body" tx (TxBody era),
 HasField "wits" tx (TxWitness era),
 HasField "vldt" (TxBody era) ValidityInterval) =>
ProtVer
-> tx
-> [(ShortByteString, Language, [Data era], ExUnits, CostModel)]
-> ScriptResult
evalScripts ProtVer
pv tx
tx [(ShortByteString, Language, [Data era], ExUnits, CostModel)]
rest

-- Collect information (purpose and ScriptHash) about all the
-- Credentials that refer to scripts, that might be run in a Tx.
-- THE SPEC CALLS FOR A SET, BUT THAT NEEDS A BUNCH OF ORD INSTANCES (DCert)
-- See additional comments about 'scriptsNeededFromBody' below.
scriptsNeeded ::
  forall era tx.
  ( Era era,
    HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
    HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)),
    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
    HasField "body" tx (Core.TxBody era)
  ) =>
  UTxO era ->
  tx ->
  [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
scriptsNeeded :: UTxO era
-> tx -> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
scriptsNeeded UTxO era
utxo tx
tx = UTxO era
-> TxBody era
-> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
forall era.
(Era era, HasField "inputs" (TxBody era) (Set (TxIn (Crypto era))),
 HasField "wdrls" (TxBody era) (Wdrl (Crypto era)),
 HasField "certs" (TxBody era) (StrictSeq (DCert (Crypto era)))) =>
UTxO era
-> TxBody era
-> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
scriptsNeededFromBody UTxO era
utxo (tx -> TxBody era
forall k (x :: k) r a. HasField x r a => r -> a
getField @"body" tx
tx)

-- We only find certificate witnesses in Delegating and Deregistration DCerts
-- that have ScriptHashObj credentials.
addOnlyCwitness ::
  [(ScriptPurpose crypto, ScriptHash crypto)] ->
  DCert crypto ->
  [(ScriptPurpose crypto, ScriptHash crypto)]
addOnlyCwitness :: [(ScriptPurpose crypto, ScriptHash crypto)]
-> DCert crypto -> [(ScriptPurpose crypto, ScriptHash crypto)]
addOnlyCwitness ![(ScriptPurpose crypto, ScriptHash crypto)]
ans (DCertDeleg c :: DelegCert crypto
c@(DeRegKey (ScriptHashObj ScriptHash crypto
hk))) =
  (DCert crypto -> ScriptPurpose crypto
forall crypto. DCert crypto -> ScriptPurpose crypto
Certifying (DCert crypto -> ScriptPurpose crypto)
-> DCert crypto -> ScriptPurpose crypto
forall a b. (a -> b) -> a -> b
$ DelegCert crypto -> DCert crypto
forall crypto. DelegCert crypto -> DCert crypto
DCertDeleg DelegCert crypto
c, ScriptHash crypto
hk) (ScriptPurpose crypto, ScriptHash crypto)
-> [(ScriptPurpose crypto, ScriptHash crypto)]
-> [(ScriptPurpose crypto, ScriptHash crypto)]
forall a. a -> [a] -> [a]
: [(ScriptPurpose crypto, ScriptHash crypto)]
ans
addOnlyCwitness ![(ScriptPurpose crypto, ScriptHash crypto)]
ans (DCertDeleg c :: DelegCert crypto
c@(Delegate (Delegation (ScriptHashObj ScriptHash crypto
hk) KeyHash 'StakePool crypto
_dpool))) =
  (DCert crypto -> ScriptPurpose crypto
forall crypto. DCert crypto -> ScriptPurpose crypto
Certifying (DCert crypto -> ScriptPurpose crypto)
-> DCert crypto -> ScriptPurpose crypto
forall a b. (a -> b) -> a -> b
$ DelegCert crypto -> DCert crypto
forall crypto. DelegCert crypto -> DCert crypto
DCertDeleg DelegCert crypto
c, ScriptHash crypto
hk) (ScriptPurpose crypto, ScriptHash crypto)
-> [(ScriptPurpose crypto, ScriptHash crypto)]
-> [(ScriptPurpose crypto, ScriptHash crypto)]
forall a. a -> [a] -> [a]
: [(ScriptPurpose crypto, ScriptHash crypto)]
ans
addOnlyCwitness ![(ScriptPurpose crypto, ScriptHash crypto)]
ans DCert crypto
_ = [(ScriptPurpose crypto, ScriptHash crypto)]
ans

-- |
-- Uses of inputs in ‘txscripts’ and ‘neededScripts’
-- There are currently 3 sets of inputs (spending, collateral, reference). A particular TxInput
-- can appear in more than one of the sets. Even in all three at the same, but that may not be
-- a really useful case. Inputs are where you find scripts with the 'Spending' purpose.
--
-- 1) Collateral inputs are only spent if phase two fails. Their corresponding TxOut can only have
--    Key (not Script) Pay credentials, so ‘neededScripts’ does not look there.
-- 2) Reference inputs are not spent in the current Tx, unless that same input also appears in one
--    of the other sets. If that is not the case, their credentials are never needed, so anyone can
--    access the inline datums and scripts in their corresponding TxOut, without needing any
--    authorizing credentials. So ‘neededScripts’ does not look there.
-- 3) Spending inputs are always spent. So their Pay credentials are always needed.
--
-- Collect information (purpose and ScriptHash) about all the Credentials that refer to scripts
-- that will be needed to run in a TxBody in the Utxow rule. Note there may be credentials that
-- cannot be run, so are not collected. In Babbage, reference inputs, fit that description.
-- Purposes include
-- 1) Spending (payment script credentials, but NOT staking scripts) in the Addr of a TxOut, pointed
--    to by some input that needs authorization. Be sure (getField @"inputs" txb) gets all such inputs.
--    In some Eras there may be multiple sets of inputs, which ones should be included? Currently that
--    is only the spending inputs. Because collateral inputs can only have key-locked credentials,
--    and reference inputs are never authorized. That might not always be the case.
-- 2) Rewarding (Withdrawals),
-- 3) Minting (minted field), and
-- 4) Certifying (Delegating) scripts.
--
-- 'scriptsNeeded' is an aggregation of the needed Credentials referring to Scripts used in Utxow rule.
-- The flip side of 'scriptsNeeded' (which collects script hashes) is 'txscripts' which finds the
-- actual scripts. We maintain an invariant that every script credential refers to some actual script.
-- This is tested in the test function 'validateMissingScripts' in the Utxow rule.
scriptsNeededFromBody ::
  forall era.
  ( Era era,
    HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
    HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)),
    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era)))
  ) =>
  UTxO era ->
  Core.TxBody era ->
  [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
scriptsNeededFromBody :: UTxO era
-> TxBody era
-> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
scriptsNeededFromBody (UTxO Map (TxIn (Crypto era)) (TxOut era)
u) TxBody era
txb = [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
spend [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
-> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
-> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
forall a. [a] -> [a] -> [a]
++ [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
reward [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
-> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
-> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
forall a. [a] -> [a] -> [a]
++ [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
cert [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
-> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
-> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
forall a. [a] -> [a] -> [a]
++ [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
minted
  where
    collect :: TxIn (Crypto era) -> Maybe (ScriptPurpose (Crypto era), ScriptHash (Crypto era))
    collect :: TxIn (Crypto era)
-> Maybe (ScriptPurpose (Crypto era), ScriptHash (Crypto era))
collect !TxIn (Crypto era)
i = do
      Addr (Crypto era)
addr <- TxOut era -> Addr (Crypto era)
forall e. Era e => TxOut e -> Addr (Crypto e)
getTxOutAddr (TxOut era -> Addr (Crypto era))
-> Maybe (TxOut era) -> Maybe (Addr (Crypto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxIn (Crypto era)
-> Map (TxIn (Crypto era)) (TxOut era) -> Maybe (TxOut era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn (Crypto era)
i Map (TxIn (Crypto era)) (TxOut era)
u
      ScriptHash (Crypto era)
hash <- Addr (Crypto era) -> Maybe (ScriptHash (Crypto era))
forall crypto. Addr crypto -> Maybe (ScriptHash crypto)
getScriptHash Addr (Crypto era)
addr
      (ScriptPurpose (Crypto era), ScriptHash (Crypto era))
-> Maybe (ScriptPurpose (Crypto era), ScriptHash (Crypto era))
forall (m :: * -> *) a. Monad m => a -> m a
return (TxIn (Crypto era) -> ScriptPurpose (Crypto era)
forall crypto. TxIn crypto -> ScriptPurpose crypto
Spending TxIn (Crypto era)
i, ScriptHash (Crypto era)
hash)

    !spend :: [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
spend = (TxIn (Crypto era)
 -> Maybe (ScriptPurpose (Crypto era), ScriptHash (Crypto era)))
-> [TxIn (Crypto era)]
-> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TxIn (Crypto era)
-> Maybe (ScriptPurpose (Crypto era), ScriptHash (Crypto era))
collect (Set (TxIn (Crypto era)) -> [TxIn (Crypto era)]
forall a. Set a -> [a]
Set.toList (Set (TxIn (Crypto era)) -> [TxIn (Crypto era)])
-> Set (TxIn (Crypto era)) -> [TxIn (Crypto era)]
forall a b. (a -> b) -> a -> b
$ TxBody era -> Set (TxIn (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"inputs" TxBody era
txb)

    !reward :: [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
reward = (RewardAcnt (Crypto era)
 -> Maybe (ScriptPurpose (Crypto era), ScriptHash (Crypto era)))
-> [RewardAcnt (Crypto era)]
-> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe RewardAcnt (Crypto era)
-> Maybe (ScriptPurpose (Crypto era), ScriptHash (Crypto era))
forall crypto.
RewardAcnt crypto
-> Maybe (ScriptPurpose crypto, ScriptHash crypto)
fromRwd (Map (RewardAcnt (Crypto era)) Coin -> [RewardAcnt (Crypto era)]
forall k a. Map k a -> [k]
Map.keys Map (RewardAcnt (Crypto era)) Coin
withdrawals)
      where
        withdrawals :: Map (RewardAcnt (Crypto era)) Coin
withdrawals = Wdrl (Crypto era) -> Map (RewardAcnt (Crypto era)) Coin
forall crypto. Wdrl crypto -> Map (RewardAcnt crypto) Coin
unWdrl (Wdrl (Crypto era) -> Map (RewardAcnt (Crypto era)) Coin)
-> Wdrl (Crypto era) -> Map (RewardAcnt (Crypto era)) Coin
forall a b. (a -> b) -> a -> b
$ TxBody era -> Wdrl (Crypto era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"wdrls" TxBody era
txb
        fromRwd :: RewardAcnt crypto
-> Maybe (ScriptPurpose crypto, ScriptHash crypto)
fromRwd RewardAcnt crypto
accnt = do
          ScriptHash crypto
hash <- Credential 'Staking crypto -> Maybe (ScriptHash crypto)
forall (kr :: KeyRole) crypto.
Credential kr crypto -> Maybe (ScriptHash crypto)
scriptCred (Credential 'Staking crypto -> Maybe (ScriptHash crypto))
-> Credential 'Staking crypto -> Maybe (ScriptHash crypto)
forall a b. (a -> b) -> a -> b
$ RewardAcnt crypto -> Credential 'Staking crypto
forall crypto. RewardAcnt crypto -> Credential 'Staking crypto
getRwdCred RewardAcnt crypto
accnt
          (ScriptPurpose crypto, ScriptHash crypto)
-> Maybe (ScriptPurpose crypto, ScriptHash crypto)
forall (m :: * -> *) a. Monad m => a -> m a
return (RewardAcnt crypto -> ScriptPurpose crypto
forall crypto. RewardAcnt crypto -> ScriptPurpose crypto
Rewarding RewardAcnt crypto
accnt, ScriptHash crypto
hash)

    !cert :: [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
cert = ([(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
 -> DCert (Crypto era)
 -> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))])
-> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
-> StrictSeq (DCert (Crypto era))
-> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
-> DCert (Crypto era)
-> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
forall crypto.
[(ScriptPurpose crypto, ScriptHash crypto)]
-> DCert crypto -> [(ScriptPurpose crypto, ScriptHash crypto)]
addOnlyCwitness [] (TxBody era -> StrictSeq (DCert (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"certs" TxBody era
txb)

    !minted :: [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
minted = (ScriptHash (Crypto era)
 -> (ScriptPurpose (Crypto era), ScriptHash (Crypto era)))
-> [ScriptHash (Crypto era)]
-> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
forall a b. (a -> b) -> [a] -> [b]
map (\ScriptHash (Crypto era)
hash -> (PolicyID (Crypto era) -> ScriptPurpose (Crypto era)
forall crypto. PolicyID crypto -> ScriptPurpose crypto
Minting (ScriptHash (Crypto era) -> PolicyID (Crypto era)
forall crypto. ScriptHash crypto -> PolicyID crypto
PolicyID ScriptHash (Crypto era)
hash), ScriptHash (Crypto era)
hash)) ([ScriptHash (Crypto era)]
 -> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))])
-> [ScriptHash (Crypto era)]
-> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
forall a b. (a -> b) -> a -> b
$ Set (ScriptHash (Crypto era)) -> [ScriptHash (Crypto era)]
forall a. Set a -> [a]
Set.toList (Set (ScriptHash (Crypto era)) -> [ScriptHash (Crypto era)])
-> Set (ScriptHash (Crypto era)) -> [ScriptHash (Crypto era)]
forall a b. (a -> b) -> a -> b
$ TxBody era -> Set (ScriptHash (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"minted" TxBody era
txb