{-# 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,
  getConwayScriptsNeeded,
  txNonDistinctRefScriptsSize,
  getConwayMinFeeTxUtxo,
) 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 l era ->
  AlonzoScriptsNeeded era
getConwayScriptsNeeded :: forall era (l :: TxLevel).
ConwayEraTxBody era =>
UTxO era -> TxBody l era -> AlonzoScriptsNeeded era
getConwayScriptsNeeded UTxO era
utxo TxBody l era
txBody =
  UTxO era -> TxBody l era -> AlonzoScriptsNeeded era
forall era (l :: TxLevel).
(AlonzoEraScript era, EraTxBody era) =>
UTxO era -> TxBody l era -> AlonzoScriptsNeeded era
getSpendingScriptsNeeded UTxO era
utxo TxBody l era
txBody
    AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
forall a. Semigroup a => a -> a -> a
<> TxBody l era -> AlonzoScriptsNeeded era
forall era (l :: TxLevel).
(AlonzoEraScript era, EraTxBody era) =>
TxBody l era -> AlonzoScriptsNeeded era
getRewardingScriptsNeeded TxBody l 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 l era -> AlonzoScriptsNeeded era
forall era (l :: TxLevel).
(AlonzoEraScript era, MaryEraTxBody era) =>
TxBody l era -> AlonzoScriptsNeeded era
getMintingScriptsNeeded TxBody l 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 l era
txBody TxBody l era
-> Getting
     (StrictSeq (TxCert era)) (TxBody l era) (StrictSeq (TxCert era))
-> StrictSeq (TxCert era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxCert era)) (TxBody l era) (StrictSeq (TxCert era))
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens' (TxBody l 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 l era
txBody TxBody l era
-> Getting
     (VotingProcedures era) (TxBody l era) (VotingProcedures era)
-> VotingProcedures era
forall s a. s -> Getting a s a -> a
^. Getting
  (VotingProcedures era) (TxBody l era) (VotingProcedures era)
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (VotingProcedures era)
forall (l :: TxLevel). Lens' (TxBody l 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 l era
txBody TxBody l era
-> Getting
     (OSet (ProposalProcedure era))
     (TxBody l era)
     (OSet (ProposalProcedure era))
-> OSet (ProposalProcedure era)
forall s a. s -> Getting a s a -> a
^. Getting
  (OSet (ProposalProcedure era))
  (TxBody l era)
  (OSet (ProposalProcedure era))
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (OSet (ProposalProcedure era))
forall (l :: TxLevel).
Lens' (TxBody l 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)
_ 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 l era ->
  Value era
conwayConsumed :: forall era (l :: TxLevel).
(EraUTxO era, ConwayEraCertState era) =>
PParams era
-> CertState era -> UTxO era -> TxBody l era -> Value era
conwayConsumed PParams era
pp CertState era
certState =
  PParams era
-> (Credential Staking -> Maybe Coin)
-> (Credential DRepRole -> Maybe Coin)
-> UTxO era
-> TxBody l era
-> Value era
forall era (t :: TxLevel).
EraUTxO era =>
PParams era
-> (Credential Staking -> Maybe Coin)
-> (Credential DRepRole -> Maybe Coin)
-> UTxO era
-> TxBody t era
-> Value era
forall (t :: TxLevel).
PParams era
-> (Credential Staking -> Maybe Coin)
-> (Credential DRepRole -> Maybe Coin)
-> UTxO era
-> TxBody t era
-> Value era
getConsumedValue
    PParams era
pp
    (DState era -> Credential Staking -> Maybe Coin
forall era.
EraAccounts 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 TopTx era ->
  Value era
conwayProducedValue :: forall era.
(ConwayEraTxBody era, Value era ~ MaryValue) =>
PParams era
-> (KeyHash StakePool -> Bool) -> TxBody TopTx era -> Value era
conwayProducedValue PParams era
pp KeyHash StakePool -> Bool
isStakePool TxBody TopTx era
txBody =
  PParams era
-> (KeyHash StakePool -> Bool) -> TxBody TopTx era -> MaryValue
forall era.
(MaryEraTxBody era, Value era ~ MaryValue) =>
PParams era
-> (KeyHash StakePool -> Bool) -> TxBody TopTx era -> MaryValue
getProducedMaryValue PParams era
pp KeyHash StakePool -> Bool
isStakePool TxBody TopTx era
txBody
    MaryValue -> MaryValue -> MaryValue
forall t. Val t => t -> t -> t
<+> Coin -> MaryValue
forall t s. Inject t s => t -> s
inject (TxBody TopTx era
txBody TxBody TopTx era -> Getting Coin (TxBody TopTx era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody TopTx era) Coin
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) Coin
forall (l :: TxLevel). Lens' (TxBody l era) Coin
treasuryDonationTxBodyL)

instance EraUTxO ConwayEra where
  type ScriptsNeeded ConwayEra = AlonzoScriptsNeeded ConwayEra

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

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

  getProducedValue :: forall (t :: TxLevel).
PParams ConwayEra
-> (KeyHash StakePool -> Bool)
-> TxBody t ConwayEra
-> Value ConwayEra
getProducedValue PParams ConwayEra
pp KeyHash StakePool -> Bool
isRegPoolId TxBody t ConwayEra
txBody =
    TxBody t ConwayEra
-> (TxBody TopTx ConwayEra -> MaryValue) -> MaryValue
forall (t :: TxLevel -> * -> *) era (l :: TxLevel) a.
(HasEraTxLevel t era, STxLevel l era ~ STxTopLevel l era) =>
t l era -> (t TopTx era -> a) -> a
withTopTxLevelOnly TxBody t ConwayEra
txBody (PParams ConwayEra
-> (KeyHash StakePool -> Bool)
-> TxBody TopTx ConwayEra
-> Value ConwayEra
forall era.
(ConwayEraTxBody era, Value era ~ MaryValue) =>
PParams era
-> (KeyHash StakePool -> Bool) -> TxBody TopTx era -> Value era
conwayProducedValue PParams ConwayEra
pp KeyHash StakePool -> Bool
isRegPoolId)

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

  getScriptsNeeded :: forall (t :: TxLevel).
UTxO ConwayEra -> TxBody t ConwayEra -> ScriptsNeeded ConwayEra
getScriptsNeeded = UTxO ConwayEra -> TxBody t ConwayEra -> ScriptsNeeded ConwayEra
UTxO ConwayEra
-> TxBody t ConwayEra -> AlonzoScriptsNeeded ConwayEra
forall era (l :: TxLevel).
ConwayEraTxBody era =>
UTxO era -> TxBody l 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 :: forall (t :: TxLevel).
CertState ConwayEra
-> UTxO ConwayEra -> TxBody t ConwayEra -> Set (KeyHash Witness)
getWitsVKeyNeeded CertState ConwayEra
_ = UTxO ConwayEra -> TxBody t ConwayEra -> Set (KeyHash Witness)
forall era (l :: TxLevel).
(EraTx era, ConwayEraTxBody era) =>
UTxO era -> TxBody l era -> Set (KeyHash Witness)
getConwayWitsVKeyNeeded

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

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

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

getConwayMinFeeTxUtxo ::
  ( EraTx era
  , BabbageEraTxBody era
  ) =>
  PParams era ->
  Tx l era ->
  UTxO era ->
  Coin
getConwayMinFeeTxUtxo :: forall era (l :: TxLevel).
(EraTx era, BabbageEraTxBody era) =>
PParams era -> Tx l era -> UTxO era -> Coin
getConwayMinFeeTxUtxo PParams era
pparams Tx l era
tx UTxO era
utxo =
  PParams era -> Tx l era -> Int -> Coin
forall era (l :: TxLevel).
EraTx era =>
PParams era -> Tx l era -> Int -> Coin
forall (l :: TxLevel). PParams era -> Tx l era -> Int -> Coin
getMinFeeTx PParams era
pparams Tx l era
tx (Int -> Coin) -> Int -> Coin
forall a b. (a -> b) -> a -> b
$ UTxO era -> Tx l era -> Int
forall era (l :: TxLevel).
(EraTx era, BabbageEraTxBody era) =>
UTxO era -> Tx l era -> Int
txNonDistinctRefScriptsSize UTxO era
utxo Tx l 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 l era -> Int
txNonDistinctRefScriptsSize :: forall era (l :: TxLevel).
(EraTx era, BabbageEraTxBody era) =>
UTxO era -> Tx l era -> Int
txNonDistinctRefScriptsSize UTxO era
utxo Tx l 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 l era
tx Tx l era -> Getting (Set TxIn) (Tx l era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. (TxBody l era -> Const (Set TxIn) (TxBody l era))
-> Tx l era -> Const (Set TxIn) (Tx l era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody l era -> Const (Set TxIn) (TxBody l era))
 -> Tx l era -> Const (Set TxIn) (Tx l era))
-> ((Set TxIn -> Const (Set TxIn) (Set TxIn))
    -> TxBody l era -> Const (Set TxIn) (TxBody l era))
-> Getting (Set TxIn) (Tx l era) (Set TxIn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxIn -> Const (Set TxIn) (Set TxIn))
-> TxBody l era -> Const (Set TxIn) (TxBody l era)
forall era (l :: TxLevel).
BabbageEraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l era) (Set TxIn)
referenceInputsTxBodyL) Set TxIn -> Set TxIn -> Set TxIn
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` (Tx l era
tx Tx l era -> Getting (Set TxIn) (Tx l era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. (TxBody l era -> Const (Set TxIn) (TxBody l era))
-> Tx l era -> Const (Set TxIn) (Tx l era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody l era -> Const (Set TxIn) (TxBody l era))
 -> Tx l era -> Const (Set TxIn) (Tx l era))
-> ((Set TxIn -> Const (Set TxIn) (Set TxIn))
    -> TxBody l era -> Const (Set TxIn) (TxBody l era))
-> Getting (Set TxIn) (Tx l era) (Set TxIn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxIn -> Const (Set TxIn) (Set TxIn))
-> TxBody l era -> Const (Set TxIn) (TxBody l era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l 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 l era ->
  Set.Set (KeyHash Witness)
getConwayWitsVKeyNeeded :: forall era (l :: TxLevel).
(EraTx era, ConwayEraTxBody era) =>
UTxO era -> TxBody l era -> Set (KeyHash Witness)
getConwayWitsVKeyNeeded UTxO era
utxo TxBody l era
txBody =
  UTxO era -> TxBody l era -> Set (KeyHash Witness)
forall era (l :: TxLevel).
EraTx era =>
UTxO era -> TxBody l era -> Set (KeyHash Witness)
getShelleyWitsVKeyNeededNoGov UTxO era
utxo TxBody l era
txBody
    Set (KeyHash Witness)
-> Set (KeyHash Witness) -> Set (KeyHash Witness)
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` (KeyHash Guard -> KeyHash Witness)
-> Set (KeyHash Guard) -> Set (KeyHash Witness)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map KeyHash Guard -> KeyHash Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness (TxBody l era
txBody TxBody l era
-> Getting
     (Set (KeyHash Guard)) (TxBody l era) (Set (KeyHash Guard))
-> Set (KeyHash Guard)
forall s a. s -> Getting a s a -> a
^. Getting (Set (KeyHash Guard)) (TxBody l era) (Set (KeyHash Guard))
forall era (l :: TxLevel).
AlonzoEraTxBody era =>
SimpleGetter (TxBody l era) (Set (KeyHash Guard))
forall (l :: TxLevel).
SimpleGetter (TxBody l era) (Set (KeyHash Guard))
reqSignerHashesTxBodyG)
    Set (KeyHash Witness)
-> Set (KeyHash Witness) -> Set (KeyHash Witness)
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` TxBody l era -> Set (KeyHash Witness)
forall era (l :: TxLevel).
ConwayEraTxBody era =>
TxBody l era -> Set (KeyHash Witness)
voterWitnesses TxBody l era
txBody

voterWitnesses ::
  ConwayEraTxBody era =>
  TxBody l era ->
  Set.Set (KeyHash Witness)
voterWitnesses :: forall era (l :: TxLevel).
ConwayEraTxBody era =>
TxBody l era -> Set (KeyHash Witness)
voterWitnesses TxBody l 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 l era
txb TxBody l era
-> Getting
     (VotingProcedures era) (TxBody l era) (VotingProcedures era)
-> VotingProcedures era
forall s a. s -> Getting a s a -> a
^. Getting
  (VotingProcedures era) (TxBody l era) (VotingProcedures era)
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (VotingProcedures era)
forall (l :: TxLevel). Lens' (TxBody l 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