{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Conway.UTxO (
  conwayConsumed,
  conwayProducedValue,
  getConwayWitsVKeyNeeded,
  txNonDistinctRefScriptsSize,
) where

import Cardano.Ledger.Alonzo.UTxO (
  AlonzoEraUTxO (..),
  AlonzoScriptsNeeded (..),
  getAlonzoScriptsHashesNeeded,
  getMintingScriptsNeeded,
  getRewardingScriptsNeeded,
  getSpendingScriptsNeeded,
  zipAsIxItem,
 )
import Cardano.Ledger.Babbage.UTxO (
  getBabbageScriptsProvided,
  getBabbageSpendingDatum,
  getBabbageSupplementalDataHashes,
  getReferenceScriptsNonDistinct,
 )
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Era (ConwayEra)
import Cardano.Ledger.Conway.Governance.Procedures (
  GovAction (..),
  ProposalProcedure (..),
  Voter (..),
  unVotingProcedures,
 )
import Cardano.Ledger.Conway.State
import Cardano.Ledger.Credential (credKeyHashWitness, credScriptHash)
import Cardano.Ledger.Keys (asWitness)
import Cardano.Ledger.Mary.UTxO (getConsumedMaryValue, getProducedMaryValue)
import Cardano.Ledger.Mary.Value (MaryValue)
import Cardano.Ledger.Shelley.UTxO (getShelleyWitsVKeyNeededNoGov)
import Cardano.Ledger.Val (Val (..), inject)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes)
import Data.Monoid (Sum (..))
import qualified Data.Set as Set
import Lens.Micro ((^.))

getConwayScriptsNeeded ::
  ConwayEraTxBody era =>
  UTxO era ->
  TxBody era ->
  AlonzoScriptsNeeded era
getConwayScriptsNeeded :: forall era.
ConwayEraTxBody era =>
UTxO era -> TxBody era -> AlonzoScriptsNeeded era
getConwayScriptsNeeded UTxO era
utxo TxBody era
txBody =
  UTxO era -> TxBody era -> AlonzoScriptsNeeded era
forall era.
(AlonzoEraScript era, EraTxBody era) =>
UTxO era -> TxBody era -> AlonzoScriptsNeeded era
getSpendingScriptsNeeded UTxO era
utxo TxBody era
txBody
    AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
forall a. Semigroup a => a -> a -> a
<> TxBody era -> AlonzoScriptsNeeded era
forall era.
(AlonzoEraScript era, EraTxBody era) =>
TxBody era -> AlonzoScriptsNeeded era
getRewardingScriptsNeeded TxBody era
txBody
    AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
forall a. Semigroup a => a -> a -> a
<> AlonzoScriptsNeeded era
certifyingScriptsNeeded
    AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
forall a. Semigroup a => a -> a -> a
<> TxBody era -> AlonzoScriptsNeeded era
forall era.
(AlonzoEraScript era, MaryEraTxBody era) =>
TxBody era -> AlonzoScriptsNeeded era
getMintingScriptsNeeded TxBody era
txBody
    AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
forall a. Semigroup a => a -> a -> a
<> AlonzoScriptsNeeded era
votingScriptsNeeded
    AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
forall a. Semigroup a => a -> a -> a
<> AlonzoScriptsNeeded era
proposingScriptsNeeded
  where
    certifyingScriptsNeeded :: AlonzoScriptsNeeded era
certifyingScriptsNeeded =
      [(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
forall era.
[(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
AlonzoScriptsNeeded ([(PlutusPurpose AsIxItem era, ScriptHash)]
 -> AlonzoScriptsNeeded era)
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
forall a b. (a -> b) -> a -> b
$
        [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
 -> [(PlutusPurpose AsIxItem era, ScriptHash)])
-> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
forall a b. (a -> b) -> a -> b
$
          StrictSeq (TxCert era)
-> (AsIxItem Word32 (TxCert era)
    -> Maybe (PlutusPurpose AsIxItem era, ScriptHash))
-> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
forall (f :: * -> *) it c.
Foldable f =>
f it -> (AsIxItem Word32 it -> c) -> [c]
zipAsIxItem (TxBody era
txBody TxBody era
-> Getting
     (StrictSeq (TxCert era)) (TxBody era) (StrictSeq (TxCert era))
-> StrictSeq (TxCert era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxCert era)) (TxBody era) (StrictSeq (TxCert era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL) ((AsIxItem Word32 (TxCert era)
  -> Maybe (PlutusPurpose AsIxItem era, ScriptHash))
 -> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)])
-> (AsIxItem Word32 (TxCert era)
    -> Maybe (PlutusPurpose AsIxItem era, ScriptHash))
-> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
forall a b. (a -> b) -> a -> b
$
            \asIxItem :: AsIxItem Word32 (TxCert era)
asIxItem@(AsIxItem Word32
_ TxCert era
txCert) ->
              (AsIxItem Word32 (TxCert era) -> PlutusPurpose AsIxItem era
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 (TxCert era) -> PlutusPurpose f era
CertifyingPurpose AsIxItem Word32 (TxCert era)
asIxItem,) (ScriptHash -> (PlutusPurpose AsIxItem era, ScriptHash))
-> Maybe ScriptHash
-> Maybe (PlutusPurpose AsIxItem era, ScriptHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxCert era -> Maybe ScriptHash
forall era. EraTxCert era => TxCert era -> Maybe ScriptHash
getScriptWitnessTxCert TxCert era
txCert

    votingScriptsNeeded :: AlonzoScriptsNeeded era
votingScriptsNeeded =
      [(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
forall era.
[(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
AlonzoScriptsNeeded ([(PlutusPurpose AsIxItem era, ScriptHash)]
 -> AlonzoScriptsNeeded era)
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
forall a b. (a -> b) -> a -> b
$
        [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
 -> [(PlutusPurpose AsIxItem era, ScriptHash)])
-> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
forall a b. (a -> b) -> a -> b
$
          [Voter]
-> (AsIxItem Word32 Voter
    -> Maybe (PlutusPurpose AsIxItem era, ScriptHash))
-> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
forall (f :: * -> *) it c.
Foldable f =>
f it -> (AsIxItem Word32 it -> c) -> [c]
zipAsIxItem (Map Voter (Map GovActionId (VotingProcedure era)) -> [Voter]
forall k a. Map k a -> [k]
Map.keys (VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
forall era.
VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
unVotingProcedures (TxBody era
txBody TxBody era
-> Getting
     (VotingProcedures era) (TxBody era) (VotingProcedures era)
-> VotingProcedures era
forall s a. s -> Getting a s a -> a
^. Getting (VotingProcedures era) (TxBody era) (VotingProcedures era)
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (VotingProcedures era)
Lens' (TxBody era) (VotingProcedures era)
votingProceduresTxBodyL))) ((AsIxItem Word32 Voter
  -> Maybe (PlutusPurpose AsIxItem era, ScriptHash))
 -> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)])
-> (AsIxItem Word32 Voter
    -> Maybe (PlutusPurpose AsIxItem era, ScriptHash))
-> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
forall a b. (a -> b) -> a -> b
$
            \asIxItem :: AsIxItem Word32 Voter
asIxItem@(AsIxItem Word32
_ Voter
voter) ->
              (AsIxItem Word32 Voter -> PlutusPurpose AsIxItem era
forall era (f :: * -> * -> *).
ConwayEraScript era =>
f Word32 Voter -> PlutusPurpose f era
VotingPurpose AsIxItem Word32 Voter
asIxItem,) (ScriptHash -> (PlutusPurpose AsIxItem era, ScriptHash))
-> Maybe ScriptHash
-> Maybe (PlutusPurpose AsIxItem era, ScriptHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Voter -> Maybe ScriptHash
getVoterScriptHash Voter
voter
      where
        getVoterScriptHash :: Voter -> Maybe ScriptHash
getVoterScriptHash = \case
          CommitteeVoter Credential 'HotCommitteeRole
cred -> Credential 'HotCommitteeRole -> Maybe ScriptHash
forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash Credential 'HotCommitteeRole
cred
          DRepVoter Credential 'DRepRole
cred -> Credential 'DRepRole -> Maybe ScriptHash
forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash Credential 'DRepRole
cred
          StakePoolVoter KeyHash 'StakePool
_ -> Maybe ScriptHash
forall a. Maybe a
Nothing

    proposingScriptsNeeded :: AlonzoScriptsNeeded era
proposingScriptsNeeded =
      [(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
forall era.
[(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
AlonzoScriptsNeeded ([(PlutusPurpose AsIxItem era, ScriptHash)]
 -> AlonzoScriptsNeeded era)
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
forall a b. (a -> b) -> a -> b
$
        [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
 -> [(PlutusPurpose AsIxItem era, ScriptHash)])
-> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
forall a b. (a -> b) -> a -> b
$
          OSet (ProposalProcedure era)
-> (AsIxItem Word32 (ProposalProcedure era)
    -> Maybe (PlutusPurpose AsIxItem era, ScriptHash))
-> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
forall (f :: * -> *) it c.
Foldable f =>
f it -> (AsIxItem Word32 it -> c) -> [c]
zipAsIxItem (TxBody era
txBody TxBody era
-> Getting
     (OSet (ProposalProcedure era))
     (TxBody era)
     (OSet (ProposalProcedure era))
-> OSet (ProposalProcedure era)
forall s a. s -> Getting a s a -> a
^. Getting
  (OSet (ProposalProcedure era))
  (TxBody era)
  (OSet (ProposalProcedure era))
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (OSet (ProposalProcedure era))
Lens' (TxBody era) (OSet (ProposalProcedure era))
proposalProceduresTxBodyL) ((AsIxItem Word32 (ProposalProcedure era)
  -> Maybe (PlutusPurpose AsIxItem era, ScriptHash))
 -> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)])
-> (AsIxItem Word32 (ProposalProcedure era)
    -> Maybe (PlutusPurpose AsIxItem era, ScriptHash))
-> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
forall a b. (a -> b) -> a -> b
$
            \asIxItem :: AsIxItem Word32 (ProposalProcedure era)
asIxItem@(AsIxItem Word32
_ ProposalProcedure era
proposal) ->
              (AsIxItem Word32 (ProposalProcedure era)
-> PlutusPurpose AsIxItem era
forall era (f :: * -> * -> *).
ConwayEraScript era =>
f Word32 (ProposalProcedure era) -> PlutusPurpose f era
ProposingPurpose AsIxItem Word32 (ProposalProcedure era)
asIxItem,) (ScriptHash -> (PlutusPurpose AsIxItem era, ScriptHash))
-> Maybe ScriptHash
-> Maybe (PlutusPurpose AsIxItem era, ScriptHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProposalProcedure era -> Maybe ScriptHash
forall {era}. ProposalProcedure era -> Maybe ScriptHash
getProposalScriptHash ProposalProcedure era
proposal
      where
        getProposalScriptHash :: ProposalProcedure era -> Maybe ScriptHash
getProposalScriptHash ProposalProcedure {GovAction era
pProcGovAction :: GovAction era
pProcGovAction :: forall era. ProposalProcedure era -> GovAction era
pProcGovAction} =
          case GovAction era
pProcGovAction of
            ParameterChange StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
_ PParamsUpdate era
_ (SJust ScriptHash
govPolicyHash) -> ScriptHash -> Maybe ScriptHash
forall a. a -> Maybe a
Just ScriptHash
govPolicyHash
            TreasuryWithdrawals Map RewardAccount Coin
_ (SJust ScriptHash
govPolicyHash) -> ScriptHash -> Maybe ScriptHash
forall a. a -> Maybe a
Just ScriptHash
govPolicyHash
            GovAction era
_ -> Maybe ScriptHash
forall a. Maybe a
Nothing

conwayConsumed ::
  (EraUTxO era, ConwayEraCertState era) =>
  PParams era ->
  CertState era ->
  UTxO era ->
  TxBody era ->
  Value era
conwayConsumed :: forall era.
(EraUTxO era, ConwayEraCertState era) =>
PParams era -> CertState era -> UTxO era -> TxBody era -> Value era
conwayConsumed PParams era
pp CertState era
certState =
  PParams era
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> UTxO era
-> TxBody era
-> Value era
forall era.
EraUTxO era =>
PParams era
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> UTxO era
-> TxBody era
-> Value era
getConsumedValue
    PParams era
pp
    (DState era -> Credential 'Staking -> Maybe Coin
forall era. DState era -> Credential 'Staking -> Maybe Coin
lookupDepositDState (DState era -> Credential 'Staking -> Maybe Coin)
-> DState era -> Credential 'Staking -> Maybe Coin
forall a b. (a -> b) -> a -> b
$ CertState era
certState CertState era
-> Getting (DState era) (CertState era) (DState era) -> DState era
forall s a. s -> Getting a s a -> a
^. Getting (DState era) (CertState era) (DState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL)
    (VState era -> Credential 'DRepRole -> Maybe Coin
forall era. VState era -> Credential 'DRepRole -> Maybe Coin
lookupDepositVState (VState era -> Credential 'DRepRole -> Maybe Coin)
-> VState era -> Credential 'DRepRole -> Maybe Coin
forall a b. (a -> b) -> a -> b
$ CertState era
certState CertState era
-> Getting (VState era) (CertState era) (VState era) -> VState era
forall s a. s -> Getting a s a -> a
^. Getting (VState era) (CertState era) (VState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL)

conwayProducedValue ::
  (ConwayEraTxBody era, Value era ~ MaryValue) =>
  PParams era ->
  (KeyHash 'StakePool -> Bool) ->
  TxBody era ->
  Value era
conwayProducedValue :: forall era.
(ConwayEraTxBody era, Value era ~ MaryValue) =>
PParams era
-> (KeyHash 'StakePool -> Bool) -> TxBody era -> Value era
conwayProducedValue PParams era
pp KeyHash 'StakePool -> Bool
isStakePool TxBody era
txBody =
  PParams era
-> (KeyHash 'StakePool -> Bool) -> TxBody era -> MaryValue
forall era.
(MaryEraTxBody era, Value era ~ MaryValue) =>
PParams era
-> (KeyHash 'StakePool -> Bool) -> TxBody era -> MaryValue
getProducedMaryValue PParams era
pp KeyHash 'StakePool -> Bool
isStakePool TxBody era
txBody
    MaryValue -> MaryValue -> MaryValue
forall t. Val t => t -> t -> t
<+> Coin -> MaryValue
forall t s. Inject t s => t -> s
inject (TxBody era
txBody TxBody era -> Getting Coin (TxBody era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody era) Coin
forall era. ConwayEraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
treasuryDonationTxBodyL)

instance EraUTxO ConwayEra where
  type ScriptsNeeded ConwayEra = AlonzoScriptsNeeded ConwayEra

  consumed :: PParams ConwayEra
-> CertState ConwayEra
-> UTxO ConwayEra
-> TxBody ConwayEra
-> Value ConwayEra
consumed = PParams ConwayEra
-> CertState ConwayEra
-> UTxO ConwayEra
-> TxBody ConwayEra
-> Value ConwayEra
forall era.
(EraUTxO era, ConwayEraCertState era) =>
PParams era -> CertState era -> UTxO era -> TxBody era -> Value era
conwayConsumed

  getConsumedValue :: PParams ConwayEra
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> UTxO ConwayEra
-> TxBody ConwayEra
-> Value ConwayEra
getConsumedValue = PParams ConwayEra
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> UTxO ConwayEra
-> TxBody ConwayEra
-> Value ConwayEra
PParams ConwayEra
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> UTxO ConwayEra
-> TxBody ConwayEra
-> MaryValue
forall era.
(MaryEraTxBody era, Value era ~ MaryValue) =>
PParams era
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> UTxO era
-> TxBody era
-> MaryValue
getConsumedMaryValue

  getProducedValue :: PParams ConwayEra
-> (KeyHash 'StakePool -> Bool)
-> TxBody ConwayEra
-> Value ConwayEra
getProducedValue = PParams ConwayEra
-> (KeyHash 'StakePool -> Bool)
-> TxBody ConwayEra
-> Value ConwayEra
forall era.
(ConwayEraTxBody era, Value era ~ MaryValue) =>
PParams era
-> (KeyHash 'StakePool -> Bool) -> TxBody era -> Value era
conwayProducedValue

  getScriptsProvided :: UTxO ConwayEra -> Tx ConwayEra -> ScriptsProvided ConwayEra
getScriptsProvided = UTxO ConwayEra -> Tx ConwayEra -> ScriptsProvided ConwayEra
forall era.
(EraTx era, BabbageEraTxBody era) =>
UTxO era -> Tx era -> ScriptsProvided era
getBabbageScriptsProvided

  getScriptsNeeded :: UTxO ConwayEra -> TxBody ConwayEra -> ScriptsNeeded ConwayEra
getScriptsNeeded = UTxO ConwayEra -> TxBody ConwayEra -> ScriptsNeeded ConwayEra
UTxO ConwayEra -> TxBody ConwayEra -> AlonzoScriptsNeeded ConwayEra
forall era.
ConwayEraTxBody era =>
UTxO era -> TxBody era -> AlonzoScriptsNeeded era
getConwayScriptsNeeded

  getScriptsHashesNeeded :: ScriptsNeeded ConwayEra -> Set ScriptHash
getScriptsHashesNeeded = ScriptsNeeded ConwayEra -> Set ScriptHash
AlonzoScriptsNeeded ConwayEra -> Set ScriptHash
forall era. AlonzoScriptsNeeded era -> Set ScriptHash
getAlonzoScriptsHashesNeeded -- TODO: This also changes for Conway

  getWitsVKeyNeeded :: CertState ConwayEra
-> UTxO ConwayEra -> TxBody ConwayEra -> Set (KeyHash 'Witness)
getWitsVKeyNeeded CertState ConwayEra
_ = UTxO ConwayEra -> TxBody ConwayEra -> Set (KeyHash 'Witness)
forall era.
(EraTx era, ConwayEraTxBody era) =>
UTxO era -> TxBody era -> Set (KeyHash 'Witness)
getConwayWitsVKeyNeeded

  getMinFeeTxUtxo :: PParams ConwayEra -> Tx ConwayEra -> UTxO ConwayEra -> Coin
getMinFeeTxUtxo = PParams ConwayEra -> Tx ConwayEra -> UTxO ConwayEra -> Coin
forall era.
(EraTx era, BabbageEraTxBody era) =>
PParams era -> Tx era -> UTxO era -> Coin
getConwayMinFeeTxUtxo

instance AlonzoEraUTxO ConwayEra where
  getSupplementalDataHashes :: UTxO ConwayEra -> TxBody ConwayEra -> Set DataHash
getSupplementalDataHashes = UTxO ConwayEra -> TxBody ConwayEra -> Set DataHash
forall era.
BabbageEraTxBody era =>
UTxO era -> TxBody era -> Set DataHash
getBabbageSupplementalDataHashes

  getSpendingDatum :: UTxO ConwayEra
-> Tx ConwayEra
-> PlutusPurpose AsItem ConwayEra
-> Maybe (Data ConwayEra)
getSpendingDatum = UTxO ConwayEra
-> Tx ConwayEra
-> PlutusPurpose AsItem ConwayEra
-> Maybe (Data ConwayEra)
forall era.
(AlonzoEraTx era, BabbageEraTxOut era) =>
UTxO era -> Tx era -> PlutusPurpose AsItem era -> Maybe (Data era)
getBabbageSpendingDatum

getConwayMinFeeTxUtxo ::
  ( EraTx era
  , BabbageEraTxBody era
  ) =>
  PParams era ->
  Tx era ->
  UTxO era ->
  Coin
getConwayMinFeeTxUtxo :: forall era.
(EraTx era, BabbageEraTxBody era) =>
PParams era -> Tx era -> UTxO era -> Coin
getConwayMinFeeTxUtxo PParams era
pparams Tx era
tx UTxO era
utxo =
  PParams era -> Tx era -> Int -> Coin
forall era. EraTx era => PParams era -> Tx era -> Int -> Coin
getMinFeeTx PParams era
pparams Tx era
tx (Int -> Coin) -> Int -> Coin
forall a b. (a -> b) -> a -> b
$ UTxO era -> Tx era -> Int
forall era.
(EraTx era, BabbageEraTxBody era) =>
UTxO era -> Tx era -> Int
txNonDistinctRefScriptsSize UTxO era
utxo Tx era
tx

-- | Calculate the total size of reference scripts used by the transactions. Duplicate
-- scripts will be counted as many times as they occur, since there is never a reason to
-- include an input with the same reference script.
--
-- Any input that appears in both regular inputs and reference inputs of a transaction is
-- only used once in this computation.
txNonDistinctRefScriptsSize :: (EraTx era, BabbageEraTxBody era) => UTxO era -> Tx era -> Int
txNonDistinctRefScriptsSize :: forall era.
(EraTx era, BabbageEraTxBody era) =>
UTxO era -> Tx era -> Int
txNonDistinctRefScriptsSize UTxO era
utxo Tx era
tx = Sum Int -> Int
forall a. Sum a -> a
getSum (Sum Int -> Int) -> Sum Int -> Int
forall a b. (a -> b) -> a -> b
$ ((ScriptHash, Script era) -> Sum Int)
-> [(ScriptHash, Script era)] -> Sum Int
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int -> Sum Int
forall a. a -> Sum a
Sum (Int -> Sum Int)
-> ((ScriptHash, Script era) -> Int)
-> (ScriptHash, Script era)
-> Sum Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script era -> Int
forall t. SafeToHash t => t -> Int
originalBytesSize (Script era -> Int)
-> ((ScriptHash, Script era) -> Script era)
-> (ScriptHash, Script era)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScriptHash, Script era) -> Script era
forall a b. (a, b) -> b
snd) [(ScriptHash, Script era)]
refScripts
  where
    inputs :: Set TxIn
inputs = (Tx era
tx Tx era -> Getting (Set TxIn) (Tx era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. (TxBody era -> Const (Set TxIn) (TxBody era))
-> Tx era -> Const (Set TxIn) (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Const (Set TxIn) (TxBody era))
 -> Tx era -> Const (Set TxIn) (Tx era))
-> ((Set TxIn -> Const (Set TxIn) (Set TxIn))
    -> TxBody era -> Const (Set TxIn) (TxBody era))
-> Getting (Set TxIn) (Tx era) (Set TxIn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxIn -> Const (Set TxIn) (Set TxIn))
-> TxBody era -> Const (Set TxIn) (TxBody era)
forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
referenceInputsTxBodyL) Set TxIn -> Set TxIn -> Set TxIn
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` (Tx era
tx Tx era -> Getting (Set TxIn) (Tx era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. (TxBody era -> Const (Set TxIn) (TxBody era))
-> Tx era -> Const (Set TxIn) (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Const (Set TxIn) (TxBody era))
 -> Tx era -> Const (Set TxIn) (Tx era))
-> ((Set TxIn -> Const (Set TxIn) (Set TxIn))
    -> TxBody era -> Const (Set TxIn) (TxBody era))
-> Getting (Set TxIn) (Tx era) (Set TxIn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxIn -> Const (Set TxIn) (Set TxIn))
-> TxBody era -> Const (Set TxIn) (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL)
    refScripts :: [(ScriptHash, Script era)]
refScripts = UTxO era -> Set TxIn -> [(ScriptHash, Script era)]
forall era.
BabbageEraTxOut era =>
UTxO era -> Set TxIn -> [(ScriptHash, Script era)]
getReferenceScriptsNonDistinct UTxO era
utxo Set TxIn
inputs

getConwayWitsVKeyNeeded ::
  (EraTx era, ConwayEraTxBody era) =>
  UTxO era ->
  TxBody era ->
  Set.Set (KeyHash 'Witness)
getConwayWitsVKeyNeeded :: forall era.
(EraTx era, ConwayEraTxBody era) =>
UTxO era -> TxBody era -> Set (KeyHash 'Witness)
getConwayWitsVKeyNeeded UTxO era
utxo TxBody era
txBody =
  UTxO era -> TxBody era -> Set (KeyHash 'Witness)
forall era.
EraTx era =>
UTxO era -> TxBody era -> Set (KeyHash 'Witness)
getShelleyWitsVKeyNeededNoGov UTxO era
utxo TxBody era
txBody
    Set (KeyHash 'Witness)
-> Set (KeyHash 'Witness) -> Set (KeyHash 'Witness)
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` (TxBody era
txBody TxBody era
-> Getting
     (Set (KeyHash 'Witness)) (TxBody era) (Set (KeyHash 'Witness))
-> Set (KeyHash 'Witness)
forall s a. s -> Getting a s a -> a
^. Getting
  (Set (KeyHash 'Witness)) (TxBody era) (Set (KeyHash 'Witness))
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (KeyHash 'Witness))
Lens' (TxBody era) (Set (KeyHash 'Witness))
reqSignerHashesTxBodyL)
    Set (KeyHash 'Witness)
-> Set (KeyHash 'Witness) -> Set (KeyHash 'Witness)
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` TxBody era -> Set (KeyHash 'Witness)
forall era.
ConwayEraTxBody era =>
TxBody era -> Set (KeyHash 'Witness)
voterWitnesses TxBody era
txBody

voterWitnesses ::
  ConwayEraTxBody era =>
  TxBody era ->
  Set.Set (KeyHash 'Witness)
voterWitnesses :: forall era.
ConwayEraTxBody era =>
TxBody era -> Set (KeyHash 'Witness)
voterWitnesses TxBody era
txb =
  (Voter
 -> Map GovActionId (VotingProcedure era)
 -> Set (KeyHash 'Witness)
 -> Set (KeyHash 'Witness))
-> Set (KeyHash 'Witness)
-> Map Voter (Map GovActionId (VotingProcedure era))
-> Set (KeyHash 'Witness)
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey' Voter
-> Map GovActionId (VotingProcedure era)
-> Set (KeyHash 'Witness)
-> Set (KeyHash 'Witness)
forall {p}.
Voter -> p -> Set (KeyHash 'Witness) -> Set (KeyHash 'Witness)
accum Set (KeyHash 'Witness)
forall a. Monoid a => a
mempty (VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
forall era.
VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
unVotingProcedures (TxBody era
txb TxBody era
-> Getting
     (VotingProcedures era) (TxBody era) (VotingProcedures era)
-> VotingProcedures era
forall s a. s -> Getting a s a -> a
^. Getting (VotingProcedures era) (TxBody era) (VotingProcedures era)
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (VotingProcedures era)
Lens' (TxBody era) (VotingProcedures era)
votingProceduresTxBodyL))
  where
    accum :: Voter -> p -> Set (KeyHash 'Witness) -> Set (KeyHash 'Witness)
accum Voter
voter p
_ Set (KeyHash 'Witness)
khs =
      Set (KeyHash 'Witness)
-> (KeyHash 'Witness -> Set (KeyHash 'Witness))
-> Maybe (KeyHash 'Witness)
-> Set (KeyHash 'Witness)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set (KeyHash 'Witness)
khs (KeyHash 'Witness
-> Set (KeyHash 'Witness) -> Set (KeyHash 'Witness)
forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set (KeyHash 'Witness)
khs) (Maybe (KeyHash 'Witness) -> Set (KeyHash 'Witness))
-> Maybe (KeyHash 'Witness) -> Set (KeyHash 'Witness)
forall a b. (a -> b) -> a -> b
$
        case Voter
voter of
          CommitteeVoter Credential 'HotCommitteeRole
cred -> Credential 'HotCommitteeRole -> Maybe (KeyHash 'Witness)
forall (r :: KeyRole). Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness Credential 'HotCommitteeRole
cred
          DRepVoter Credential 'DRepRole
cred -> Credential 'DRepRole -> Maybe (KeyHash 'Witness)
forall (r :: KeyRole). Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness Credential 'DRepRole
cred
          StakePoolVoter KeyHash 'StakePool
poolId -> KeyHash 'Witness -> Maybe (KeyHash 'Witness)
forall a. a -> Maybe a
Just (KeyHash 'Witness -> Maybe (KeyHash 'Witness))
-> KeyHash 'Witness -> Maybe (KeyHash 'Witness)
forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool -> KeyHash 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyHash 'StakePool
poolId