{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Functions in this module take a (Proof era) as their first
--   parameter and do something potentially different in each Era.
module Test.Cardano.Ledger.Generic.Functions where

import Cardano.Ledger.Address (Addr (..))
import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusContext, mkSupportedLanguageM)
import Cardano.Ledger.Alonzo.Scripts (plutusScriptLanguage)
import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..), IsValid (..))
import Cardano.Ledger.Alonzo.TxBody (AlonzoTxOut (..))
import Cardano.Ledger.Babbage.TxBody (BabbageTxOut (..))
import Cardano.Ledger.Babbage.UTxO (getReferenceScripts)
import Cardano.Ledger.BaseTypes (
  BlocksMade (BlocksMade),
  Globals (epochInfo),
  ProtVer (..),
  natVersion,
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.State (ChainAccountState (..), VState (..))
import Cardano.Ledger.Credential (Credential, StakeReference (..))
import Cardano.Ledger.Plutus.Data (Datum (..), binaryDataToData, hashData)
import Cardano.Ledger.Plutus.ExUnits (ExUnits (..))
import Cardano.Ledger.Plutus.Language (Language (..))
import Cardano.Ledger.Shelley.AdaPots (AdaPots (..), totalAdaPotsES)
import Cardano.Ledger.Shelley.LedgerState (
  CertState,
  DState (..),
  EpochState (..),
  LedgerState (..),
  NewEpochState (..),
  PState (..),
  UTxOState (..),
 )
import Cardano.Ledger.Shelley.State (ShelleyCertState (..))
import Cardano.Ledger.Shelley.TxOut (ShelleyTxOut (..))
import Cardano.Ledger.State (EraUTxO (..), UTxO (..), sumCoinUTxO, unScriptsProvided)
import Cardano.Ledger.TxIn (TxIn (..))
import qualified Cardano.Ledger.UMap as UM
import Cardano.Ledger.Val (Val ((<+>), (<->)), inject)
import Cardano.Slotting.EpochInfo.API (epochInfoSize)
import Control.Monad.Reader (runReader)
import Control.Monad.Trans.Fail.String (errorFail)
import Data.Default (Default (def))
import qualified Data.Foldable as Fold (fold, toList)
import qualified Data.List as List
import Data.Map (Map, keysSet, restrictKeys)
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict (StrictMaybe (..))
import Data.Sequence.Strict (StrictSeq)
import Data.Set (Set)
import qualified Data.Set as Set
import Lens.Micro
import Numeric.Natural
import Test.Cardano.Ledger.Alonzo.Arbitrary (alwaysFailsLang, alwaysSucceedsLang)
import Test.Cardano.Ledger.Generic.Fields (TxOutField (..))
import Test.Cardano.Ledger.Generic.ModelState (MUtxo, Model, ModelNewEpochState (..))
import Test.Cardano.Ledger.Generic.Proof (Proof (..), Reflect (..))
import Test.Cardano.Ledger.Generic.Scriptic (Scriptic (..))
import qualified Test.Cardano.Ledger.Generic.Scriptic as Scriptic
import Test.Cardano.Ledger.Shelley.Rewards (RewardUpdateOld, createRUpdOld_)
import Test.Cardano.Ledger.Shelley.Utils (testGlobals)

-- ====================================================================
-- Era agnostic actions on (PParams era) (TxOut era) and
-- other XX types Mostly by pattern matching against Proof objects

maxCollateralInputs' :: Proof era -> PParams era -> Natural
maxCollateralInputs' :: forall era. Proof era -> PParams era -> Natural
maxCollateralInputs' Proof era
Alonzo PParams era
pp = PParams era
pp PParams era -> Getting Natural (PParams era) Natural -> Natural
forall s a. s -> Getting a s a -> a
^. Getting Natural (PParams era) Natural
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams era) Natural
ppMaxCollateralInputsL
maxCollateralInputs' Proof era
Babbage PParams era
pp = PParams era
pp PParams era -> Getting Natural (PParams era) Natural -> Natural
forall s a. s -> Getting a s a -> a
^. Getting Natural (PParams era) Natural
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams era) Natural
ppMaxCollateralInputsL
maxCollateralInputs' Proof era
Conway PParams era
pp = PParams era
pp PParams era -> Getting Natural (PParams era) Natural -> Natural
forall s a. s -> Getting a s a -> a
^. Getting Natural (PParams era) Natural
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams era) Natural
ppMaxCollateralInputsL
maxCollateralInputs' Proof era
_proof PParams era
_pp = Natural
0
{-# NOINLINE maxCollateralInputs' #-}

maxTxExUnits' :: Proof era -> PParams era -> ExUnits
maxTxExUnits' :: forall era. Proof era -> PParams era -> ExUnits
maxTxExUnits' Proof era
Alonzo PParams era
pp = PParams era
pp PParams era -> Getting ExUnits (PParams era) ExUnits -> ExUnits
forall s a. s -> Getting a s a -> a
^. Getting ExUnits (PParams era) ExUnits
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams era) ExUnits
ppMaxTxExUnitsL
maxTxExUnits' Proof era
Babbage PParams era
pp = PParams era
pp PParams era -> Getting ExUnits (PParams era) ExUnits -> ExUnits
forall s a. s -> Getting a s a -> a
^. Getting ExUnits (PParams era) ExUnits
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams era) ExUnits
ppMaxTxExUnitsL
maxTxExUnits' Proof era
Conway PParams era
pp = PParams era
pp PParams era -> Getting ExUnits (PParams era) ExUnits -> ExUnits
forall s a. s -> Getting a s a -> a
^. Getting ExUnits (PParams era) ExUnits
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams era) ExUnits
ppMaxTxExUnitsL
maxTxExUnits' Proof era
_proof PParams era
_x = ExUnits
forall a. Monoid a => a
mempty
{-# NOINLINE maxTxExUnits' #-}

collateralPercentage' :: Proof era -> PParams era -> Natural
collateralPercentage' :: forall era. Proof era -> PParams era -> Natural
collateralPercentage' Proof era
Alonzo PParams era
pp = PParams era
pp PParams era -> Getting Natural (PParams era) Natural -> Natural
forall s a. s -> Getting a s a -> a
^. Getting Natural (PParams era) Natural
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams era) Natural
ppCollateralPercentageL
collateralPercentage' Proof era
Babbage PParams era
pp = PParams era
pp PParams era -> Getting Natural (PParams era) Natural -> Natural
forall s a. s -> Getting a s a -> a
^. Getting Natural (PParams era) Natural
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams era) Natural
ppCollateralPercentageL
collateralPercentage' Proof era
Conway PParams era
pp = PParams era
pp PParams era -> Getting Natural (PParams era) Natural -> Natural
forall s a. s -> Getting a s a -> a
^. Getting Natural (PParams era) Natural
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams era) Natural
ppCollateralPercentageL
collateralPercentage' Proof era
_proof PParams era
_pp = Natural
0
{-# NOINLINE collateralPercentage' #-}

protocolVersion :: Proof era -> ProtVer
protocolVersion :: forall era. Proof era -> ProtVer
protocolVersion Proof era
Conway = Version -> Natural -> ProtVer
ProtVer (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9) Natural
0
protocolVersion Proof era
Babbage = Version -> Natural -> ProtVer
ProtVer (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @7) Natural
0
protocolVersion Proof era
Alonzo = Version -> Natural -> ProtVer
ProtVer (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @6) Natural
0
protocolVersion Proof era
Mary = Version -> Natural -> ProtVer
ProtVer (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @4) Natural
0
protocolVersion Proof era
Allegra = Version -> Natural -> ProtVer
ProtVer (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @3) Natural
0
protocolVersion Proof era
Shelley = Version -> Natural -> ProtVer
ProtVer (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @2) Natural
0
{-# NOINLINE protocolVersion #-}

-- | Positive numbers are "deposits owed", negative amounts are "refunds gained"
depositsAndRefunds ::
  (EraPParams era, ShelleyEraTxCert era) =>
  PParams era ->
  [TxCert era] ->
  Map (Credential 'Staking) Coin ->
  Coin
depositsAndRefunds :: forall era.
(EraPParams era, ShelleyEraTxCert era) =>
PParams era
-> [TxCert era] -> Map (Credential 'Staking) Coin -> Coin
depositsAndRefunds PParams era
pp [TxCert era]
certificates Map (Credential 'Staking) Coin
keydeposits = (Coin -> TxCert era -> Coin) -> Coin -> [TxCert era] -> Coin
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Coin -> TxCert era -> Coin
accum (Integer -> Coin
Coin Integer
0) [TxCert era]
certificates
  where
    accum :: Coin -> TxCert era -> Coin
accum Coin
ans (RegTxCert Credential 'Staking
_) = PParams era
pp PParams era -> Getting Coin (PParams era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams era) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
ans
    accum Coin
ans (UnRegTxCert Credential 'Staking
hk) =
      case Credential 'Staking -> Map (Credential 'Staking) Coin -> Maybe Coin
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'Staking
hk Map (Credential 'Staking) Coin
keydeposits of
        Maybe Coin
Nothing -> Coin
ans
        Just Coin
c -> Coin
ans Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
c
    accum Coin
ans (RegPoolTxCert PoolParams
_) = PParams era
pp PParams era -> Getting Coin (PParams era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams era) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppPoolDepositL Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
ans
    accum Coin
ans (RetirePoolTxCert KeyHash 'StakePool
_ EpochNo
_) = Coin
ans -- The pool reward is refunded at the end of the epoch
    accum Coin
ans TxCert era
_ = Coin
ans

-- | Compute the set of ScriptHashes for which there should be ScriptWitnesses. In Babbage
--  Era and later, where inline Scripts are allowed, they should not appear in this set.
scriptWitsNeeded' :: Proof era -> MUtxo era -> TxBody era -> Set ScriptHash
scriptWitsNeeded' :: forall era. Proof era -> MUtxo era -> TxBody era -> Set ScriptHash
scriptWitsNeeded' Proof era
Conway MUtxo era
utxo TxBody era
txBody = Set ScriptHash
regularScripts Set ScriptHash -> Set ScriptHash -> Set ScriptHash
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set ScriptHash
inlineScripts
  where
    theUtxo :: UTxO era
theUtxo = MUtxo era -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO MUtxo era
utxo
    inputs :: Set TxIn
inputs = TxBody era
txBody TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL
    inlineScripts :: Set ScriptHash
inlineScripts = Map ScriptHash (AlonzoScript ConwayEra) -> Set ScriptHash
forall k a. Map k a -> Set k
keysSet (Map ScriptHash (AlonzoScript ConwayEra) -> Set ScriptHash)
-> Map ScriptHash (AlonzoScript ConwayEra) -> Set ScriptHash
forall a b. (a -> b) -> a -> b
$ UTxO era -> Set TxIn -> Map ScriptHash (Script era)
forall era.
BabbageEraTxOut era =>
UTxO era -> Set TxIn -> Map ScriptHash (Script era)
getReferenceScripts UTxO era
theUtxo Set TxIn
inputs
    regularScripts :: Set ScriptHash
regularScripts = ScriptsNeeded ConwayEra -> Set ScriptHash
forall era. EraUTxO era => ScriptsNeeded era -> Set ScriptHash
getScriptsHashesNeeded (UTxO era -> TxBody era -> ScriptsNeeded era
forall era.
EraUTxO era =>
UTxO era -> TxBody era -> ScriptsNeeded era
getScriptsNeeded UTxO era
theUtxo TxBody era
txBody)
scriptWitsNeeded' Proof era
Babbage MUtxo era
utxo TxBody era
txBody = Set ScriptHash
regularScripts Set ScriptHash -> Set ScriptHash -> Set ScriptHash
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set ScriptHash
inlineScripts
  where
    theUtxo :: UTxO era
theUtxo = MUtxo era -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO MUtxo era
utxo
    inputs :: Set TxIn
inputs = (TxBody era
txBody TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL) Set TxIn -> Set TxIn -> Set TxIn
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` (TxBody era
txBody TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
referenceInputsTxBodyL)
    inlineScripts :: Set ScriptHash
inlineScripts = Map ScriptHash (AlonzoScript BabbageEra) -> Set ScriptHash
forall k a. Map k a -> Set k
keysSet (Map ScriptHash (AlonzoScript BabbageEra) -> Set ScriptHash)
-> Map ScriptHash (AlonzoScript BabbageEra) -> Set ScriptHash
forall a b. (a -> b) -> a -> b
$ UTxO era -> Set TxIn -> Map ScriptHash (Script era)
forall era.
BabbageEraTxOut era =>
UTxO era -> Set TxIn -> Map ScriptHash (Script era)
getReferenceScripts UTxO era
theUtxo Set TxIn
inputs
    regularScripts :: Set ScriptHash
regularScripts = ScriptsNeeded BabbageEra -> Set ScriptHash
forall era. EraUTxO era => ScriptsNeeded era -> Set ScriptHash
getScriptsHashesNeeded (UTxO era -> TxBody era -> ScriptsNeeded era
forall era.
EraUTxO era =>
UTxO era -> TxBody era -> ScriptsNeeded era
getScriptsNeeded UTxO era
theUtxo TxBody era
txBody)
scriptWitsNeeded' Proof era
Alonzo MUtxo era
utxo TxBody era
txBody =
  ScriptsNeeded AlonzoEra -> Set ScriptHash
forall era. EraUTxO era => ScriptsNeeded era -> Set ScriptHash
getScriptsHashesNeeded (UTxO era -> TxBody era -> ScriptsNeeded era
forall era.
EraUTxO era =>
UTxO era -> TxBody era -> ScriptsNeeded era
getScriptsNeeded (MUtxo era -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO MUtxo era
utxo) TxBody era
txBody)
scriptWitsNeeded' Proof era
Mary MUtxo era
utxo TxBody era
txBody =
  ScriptsNeeded MaryEra -> Set ScriptHash
forall era. EraUTxO era => ScriptsNeeded era -> Set ScriptHash
getScriptsHashesNeeded (UTxO era -> TxBody era -> ScriptsNeeded era
forall era.
EraUTxO era =>
UTxO era -> TxBody era -> ScriptsNeeded era
getScriptsNeeded (MUtxo era -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO MUtxo era
utxo) TxBody era
txBody)
scriptWitsNeeded' Proof era
Allegra MUtxo era
utxo TxBody era
txBody =
  ScriptsNeeded AllegraEra -> Set ScriptHash
forall era. EraUTxO era => ScriptsNeeded era -> Set ScriptHash
getScriptsHashesNeeded (UTxO era -> TxBody era -> ScriptsNeeded era
forall era.
EraUTxO era =>
UTxO era -> TxBody era -> ScriptsNeeded era
getScriptsNeeded (MUtxo era -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO MUtxo era
utxo) TxBody era
txBody)
scriptWitsNeeded' Proof era
Shelley MUtxo era
utxo TxBody era
txBody =
  ScriptsNeeded ShelleyEra -> Set ScriptHash
forall era. EraUTxO era => ScriptsNeeded era -> Set ScriptHash
getScriptsHashesNeeded (UTxO era -> TxBody era -> ScriptsNeeded era
forall era.
EraUTxO era =>
UTxO era -> TxBody era -> ScriptsNeeded era
getScriptsNeeded (MUtxo era -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO MUtxo era
utxo) TxBody era
txBody)
{-# NOINLINE scriptWitsNeeded' #-}

scriptsNeeded' :: Proof era -> MUtxo era -> TxBody era -> Set ScriptHash
scriptsNeeded' :: forall era. Proof era -> MUtxo era -> TxBody era -> Set ScriptHash
scriptsNeeded' Proof era
Conway MUtxo era
utxo TxBody era
txBody =
  ScriptsNeeded ConwayEra -> Set ScriptHash
forall era. EraUTxO era => ScriptsNeeded era -> Set ScriptHash
getScriptsHashesNeeded (UTxO era -> TxBody era -> ScriptsNeeded era
forall era.
EraUTxO era =>
UTxO era -> TxBody era -> ScriptsNeeded era
getScriptsNeeded (MUtxo era -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO MUtxo era
utxo) TxBody era
txBody)
scriptsNeeded' Proof era
Babbage MUtxo era
utxo TxBody era
txBody =
  ScriptsNeeded BabbageEra -> Set ScriptHash
forall era. EraUTxO era => ScriptsNeeded era -> Set ScriptHash
getScriptsHashesNeeded (UTxO era -> TxBody era -> ScriptsNeeded era
forall era.
EraUTxO era =>
UTxO era -> TxBody era -> ScriptsNeeded era
getScriptsNeeded (MUtxo era -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO MUtxo era
utxo) TxBody era
txBody)
scriptsNeeded' Proof era
Alonzo MUtxo era
utxo TxBody era
txBody =
  ScriptsNeeded AlonzoEra -> Set ScriptHash
forall era. EraUTxO era => ScriptsNeeded era -> Set ScriptHash
getScriptsHashesNeeded (UTxO era -> TxBody era -> ScriptsNeeded era
forall era.
EraUTxO era =>
UTxO era -> TxBody era -> ScriptsNeeded era
getScriptsNeeded (MUtxo era -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO MUtxo era
utxo) TxBody era
txBody)
scriptsNeeded' Proof era
Mary MUtxo era
utxo TxBody era
txBody =
  ScriptsNeeded MaryEra -> Set ScriptHash
forall era. EraUTxO era => ScriptsNeeded era -> Set ScriptHash
getScriptsHashesNeeded (UTxO era -> TxBody era -> ScriptsNeeded era
forall era.
EraUTxO era =>
UTxO era -> TxBody era -> ScriptsNeeded era
getScriptsNeeded (MUtxo era -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO MUtxo era
utxo) TxBody era
txBody)
scriptsNeeded' Proof era
Allegra MUtxo era
utxo TxBody era
txBody =
  ScriptsNeeded AllegraEra -> Set ScriptHash
forall era. EraUTxO era => ScriptsNeeded era -> Set ScriptHash
getScriptsHashesNeeded (UTxO era -> TxBody era -> ScriptsNeeded era
forall era.
EraUTxO era =>
UTxO era -> TxBody era -> ScriptsNeeded era
getScriptsNeeded (MUtxo era -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO MUtxo era
utxo) TxBody era
txBody)
scriptsNeeded' Proof era
Shelley MUtxo era
utxo TxBody era
txBody =
  ScriptsNeeded ShelleyEra -> Set ScriptHash
forall era. EraUTxO era => ScriptsNeeded era -> Set ScriptHash
getScriptsHashesNeeded (UTxO era -> TxBody era -> ScriptsNeeded era
forall era.
EraUTxO era =>
UTxO era -> TxBody era -> ScriptsNeeded era
getScriptsNeeded (MUtxo era -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO MUtxo era
utxo) TxBody era
txBody)
{-# NOINLINE scriptsNeeded' #-}

txInBalance ::
  forall era.
  EraTxOut era =>
  Set TxIn ->
  MUtxo era ->
  Coin
txInBalance :: forall era. EraTxOut era => Set TxIn -> MUtxo era -> Coin
txInBalance Set TxIn
txinSet MUtxo era
m = UTxO era -> Coin
forall era. EraTxOut era => UTxO era -> Coin
sumCoinUTxO (MUtxo era -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (MUtxo era -> Set TxIn -> MUtxo era
forall k a. Ord k => Map k a -> Set k -> Map k a
restrictKeys MUtxo era
m Set TxIn
txinSet))

-- | Break a TxOut into its mandatory and optional parts
txoutFields :: Proof era -> TxOut era -> (Addr, Value era, [TxOutField era])
txoutFields :: forall era.
Proof era -> TxOut era -> (Addr, Value era, [TxOutField era])
txoutFields Proof era
Conway (BabbageTxOut Addr
addr Value era
val Datum era
d StrictMaybe (Script era)
h) = (Addr
addr, Value era
val, [Datum era -> TxOutField era
forall era. Datum era -> TxOutField era
FDatum Datum era
d, StrictMaybe (Script era) -> TxOutField era
forall era. StrictMaybe (Script era) -> TxOutField era
RefScript StrictMaybe (Script era)
h])
txoutFields Proof era
Babbage (BabbageTxOut Addr
addr Value era
val Datum era
d StrictMaybe (Script era)
h) = (Addr
addr, Value era
val, [Datum era -> TxOutField era
forall era. Datum era -> TxOutField era
FDatum Datum era
d, StrictMaybe (Script era) -> TxOutField era
forall era. StrictMaybe (Script era) -> TxOutField era
RefScript StrictMaybe (Script era)
h])
txoutFields Proof era
Alonzo (AlonzoTxOut Addr
addr Value AlonzoEra
val StrictMaybe DataHash
dh) = (Addr
addr, Value era
Value AlonzoEra
val, [StrictMaybe DataHash -> TxOutField era
forall era. StrictMaybe DataHash -> TxOutField era
DHash StrictMaybe DataHash
dh])
txoutFields Proof era
Mary (ShelleyTxOut Addr
addr Value MaryEra
val) = (Addr
addr, Value era
Value MaryEra
val, [])
txoutFields Proof era
Allegra (ShelleyTxOut Addr
addr Value AllegraEra
val) = (Addr
addr, Value era
Value AllegraEra
val, [])
txoutFields Proof era
Shelley (ShelleyTxOut Addr
addr Value ShelleyEra
val) = (Addr
addr, Value era
Value ShelleyEra
val, [])
{-# NOINLINE txoutFields #-}

injectFee :: EraTxOut era => Proof era -> Coin -> TxOut era -> TxOut era
injectFee :: forall era.
EraTxOut era =>
Proof era -> Coin -> TxOut era -> TxOut era
injectFee Proof era
_ Coin
fee TxOut era
txOut = TxOut era
txOut TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (Value era -> Identity (Value era))
-> TxOut era -> Identity (TxOut era)
forall era. EraTxOut era => Lens' (TxOut era) (Value era)
Lens' (TxOut era) (Value era)
valueTxOutL ((Value era -> Identity (Value era))
 -> TxOut era -> Identity (TxOut era))
-> (Value era -> Value era) -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Value era -> Value era -> Value era
forall t. Val t => t -> t -> t
<+> Coin -> Value era
forall t s. Inject t s => t -> s
inject Coin
fee)

getTxOutRefScript :: Proof era -> TxOut era -> StrictMaybe (Script era)
getTxOutRefScript :: forall era. Proof era -> TxOut era -> StrictMaybe (Script era)
getTxOutRefScript Proof era
Conway (BabbageTxOut Addr
_ Value ConwayEra
_ Datum ConwayEra
_ StrictMaybe (Script ConwayEra)
ms) = StrictMaybe (Script era)
StrictMaybe (Script ConwayEra)
ms
getTxOutRefScript Proof era
Babbage (BabbageTxOut Addr
_ Value BabbageEra
_ Datum BabbageEra
_ StrictMaybe (Script BabbageEra)
ms) = StrictMaybe (Script era)
StrictMaybe (Script BabbageEra)
ms
getTxOutRefScript Proof era
_ TxOut era
_ = StrictMaybe (Script era)
forall a. StrictMaybe a
SNothing
{-# NOINLINE getTxOutRefScript #-}

emptyPPUPstate :: forall era. Proof era -> ShelleyGovState era
emptyPPUPstate :: forall era. Proof era -> ShelleyGovState era
emptyPPUPstate Proof era
Conway = ShelleyGovState era
forall a. Default a => a
def
emptyPPUPstate Proof era
Babbage = ShelleyGovState era
forall a. Default a => a
def
emptyPPUPstate Proof era
Alonzo = ShelleyGovState era
forall a. Default a => a
def
emptyPPUPstate Proof era
Mary = ShelleyGovState era
forall a. Default a => a
def
emptyPPUPstate Proof era
Allegra = ShelleyGovState era
forall a. Default a => a
def
emptyPPUPstate Proof era
Shelley = ShelleyGovState era
forall a. Default a => a
def
{-# NOINLINE emptyPPUPstate #-}

maxRefInputs :: Proof era -> Int
maxRefInputs :: forall era. Proof era -> Int
maxRefInputs Proof era
Babbage = Int
3
maxRefInputs Proof era
_ = Int
0

isValid' :: Proof era -> Tx era -> IsValid
isValid' :: forall era. Proof era -> Tx era -> IsValid
isValid' Proof era
Conway Tx era
x = AlonzoTx ConwayEra -> IsValid
forall era. AlonzoTx era -> IsValid
isValid Tx era
AlonzoTx ConwayEra
x
isValid' Proof era
Babbage Tx era
x = AlonzoTx BabbageEra -> IsValid
forall era. AlonzoTx era -> IsValid
isValid Tx era
AlonzoTx BabbageEra
x
isValid' Proof era
Alonzo Tx era
x = AlonzoTx AlonzoEra -> IsValid
forall era. AlonzoTx era -> IsValid
isValid Tx era
AlonzoTx AlonzoEra
x
isValid' Proof era
_ Tx era
_ = Bool -> IsValid
IsValid Bool
True
{-# NOINLINE isValid' #-}

-- | Does the TxOut have evidence of credentials and data.
--   Evidence of data is either ScriptHash or (in Babbage) an inline Datum
--   Evidence of credentials can come from the Addr
txoutEvidence ::
  forall era.
  Proof era ->
  TxOut era ->
  ([Credential 'Payment], Maybe DataHash)
txoutEvidence :: forall era.
Proof era -> TxOut era -> ([Credential 'Payment], Maybe DataHash)
txoutEvidence Proof era
Alonzo (AlonzoTxOut Addr
addr Value AlonzoEra
_ (SJust DataHash
dh)) =
  (Addr -> [Credential 'Payment]
addrCredentials Addr
addr, DataHash -> Maybe DataHash
forall a. a -> Maybe a
Just DataHash
dh)
txoutEvidence Proof era
Alonzo (AlonzoTxOut Addr
addr Value AlonzoEra
_ StrictMaybe DataHash
SNothing) =
  (Addr -> [Credential 'Payment]
addrCredentials Addr
addr, Maybe DataHash
forall a. Maybe a
Nothing)
txoutEvidence Proof era
Conway (BabbageTxOut Addr
addr Value ConwayEra
_ Datum ConwayEra
NoDatum StrictMaybe (Script ConwayEra)
_) =
  (Addr -> [Credential 'Payment]
addrCredentials Addr
addr, Maybe DataHash
forall a. Maybe a
Nothing)
txoutEvidence Proof era
Conway (BabbageTxOut Addr
addr Value ConwayEra
_ (DatumHash DataHash
dh) StrictMaybe (Script ConwayEra)
_) =
  (Addr -> [Credential 'Payment]
addrCredentials Addr
addr, DataHash -> Maybe DataHash
forall a. a -> Maybe a
Just DataHash
dh)
txoutEvidence Proof era
Conway (BabbageTxOut Addr
addr Value era
_ (Datum BinaryData era
_d) StrictMaybe (Script era)
_) =
  (Addr -> [Credential 'Payment]
addrCredentials Addr
addr, DataHash -> Maybe DataHash
forall a. a -> Maybe a
Just (forall era. Data era -> DataHash
hashData @era (BinaryData era -> Data era
forall era. Era era => BinaryData era -> Data era
binaryDataToData BinaryData era
_d)))
txoutEvidence Proof era
Babbage (BabbageTxOut Addr
addr Value BabbageEra
_ Datum BabbageEra
NoDatum StrictMaybe (Script BabbageEra)
_) =
  (Addr -> [Credential 'Payment]
addrCredentials Addr
addr, Maybe DataHash
forall a. Maybe a
Nothing)
txoutEvidence Proof era
Babbage (BabbageTxOut Addr
addr Value BabbageEra
_ (DatumHash DataHash
dh) StrictMaybe (Script BabbageEra)
_) =
  (Addr -> [Credential 'Payment]
addrCredentials Addr
addr, DataHash -> Maybe DataHash
forall a. a -> Maybe a
Just DataHash
dh)
txoutEvidence Proof era
Babbage (BabbageTxOut Addr
addr Value era
_ (Datum BinaryData era
_d) StrictMaybe (Script era)
_) =
  (Addr -> [Credential 'Payment]
addrCredentials Addr
addr, DataHash -> Maybe DataHash
forall a. a -> Maybe a
Just (forall era. Data era -> DataHash
hashData @era (BinaryData era -> Data era
forall era. Era era => BinaryData era -> Data era
binaryDataToData BinaryData era
_d)))
txoutEvidence Proof era
Mary (ShelleyTxOut Addr
addr Value MaryEra
_) =
  (Addr -> [Credential 'Payment]
addrCredentials Addr
addr, Maybe DataHash
forall a. Maybe a
Nothing)
txoutEvidence Proof era
Allegra (ShelleyTxOut Addr
addr Value AllegraEra
_) =
  (Addr -> [Credential 'Payment]
addrCredentials Addr
addr, Maybe DataHash
forall a. Maybe a
Nothing)
txoutEvidence Proof era
Shelley (ShelleyTxOut Addr
addr Value ShelleyEra
_) =
  (Addr -> [Credential 'Payment]
addrCredentials Addr
addr, Maybe DataHash
forall a. Maybe a
Nothing)
{-# NOINLINE txoutEvidence #-}

addrCredentials :: Addr -> [Credential 'Payment]
addrCredentials :: Addr -> [Credential 'Payment]
addrCredentials Addr
addr = [Credential 'Payment]
-> (Credential 'Payment -> [Credential 'Payment])
-> Maybe (Credential 'Payment)
-> [Credential 'Payment]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Credential 'Payment
-> [Credential 'Payment] -> [Credential 'Payment]
forall a. a -> [a] -> [a]
: []) (Addr -> Maybe (Credential 'Payment)
paymentCredAddr Addr
addr)

paymentCredAddr :: Addr -> Maybe (Credential 'Payment)
paymentCredAddr :: Addr -> Maybe (Credential 'Payment)
paymentCredAddr (Addr Network
_ Credential 'Payment
cred StakeReference
_) = Credential 'Payment -> Maybe (Credential 'Payment)
forall a. a -> Maybe a
Just Credential 'Payment
cred
paymentCredAddr Addr
_ = Maybe (Credential 'Payment)
forall a. Maybe a
Nothing

stakeCredAddr :: Addr -> Maybe (Credential 'Staking)
stakeCredAddr :: Addr -> Maybe (Credential 'Staking)
stakeCredAddr (Addr Network
_ Credential 'Payment
_ (StakeRefBase Credential 'Staking
cred)) = Credential 'Staking -> Maybe (Credential 'Staking)
forall a. a -> Maybe a
Just Credential 'Staking
cred
stakeCredAddr Addr
_ = Maybe (Credential 'Staking)
forall a. Maybe a
Nothing

getBody :: EraTx era => Proof era -> Tx era -> TxBody era
getBody :: forall era. EraTx era => Proof era -> Tx era -> TxBody era
getBody Proof era
_ Tx era
tx = Tx era
tx Tx era -> Getting (TxBody era) (Tx era) (TxBody era) -> TxBody era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody era) (Tx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL

getCollateralInputs :: Proof era -> TxBody era -> Set TxIn
getCollateralInputs :: forall era. Proof era -> TxBody era -> Set TxIn
getCollateralInputs Proof era
Conway TxBody era
txBody = TxBody era
txBody TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
collateralInputsTxBodyL
getCollateralInputs Proof era
Babbage TxBody era
txBody = TxBody era
txBody TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
collateralInputsTxBodyL
getCollateralInputs Proof era
Alonzo TxBody era
txBody = TxBody era
txBody TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
collateralInputsTxBodyL
getCollateralInputs Proof era
Mary TxBody era
_ = Set TxIn
forall a. Set a
Set.empty
getCollateralInputs Proof era
Allegra TxBody era
_ = Set TxIn
forall a. Set a
Set.empty
getCollateralInputs Proof era
Shelley TxBody era
_ = Set TxIn
forall a. Set a
Set.empty
{-# NOINLINE getCollateralInputs #-}

getCollateralOutputs :: Proof era -> TxBody era -> [TxOut era]
getCollateralOutputs :: forall era. Proof era -> TxBody era -> [TxOut era]
getCollateralOutputs Proof era
Conway TxBody era
txBody =
  case TxBody era
txBody TxBody era
-> Getting
     (StrictMaybe (BabbageTxOut ConwayEra))
     (TxBody era)
     (StrictMaybe (BabbageTxOut ConwayEra))
-> StrictMaybe (BabbageTxOut ConwayEra)
forall s a. s -> Getting a s a -> a
^. (StrictMaybe (TxOut era)
 -> Const
      (StrictMaybe (BabbageTxOut ConwayEra)) (StrictMaybe (TxOut era)))
-> TxBody era
-> Const (StrictMaybe (BabbageTxOut ConwayEra)) (TxBody era)
Getting
  (StrictMaybe (BabbageTxOut ConwayEra))
  (TxBody era)
  (StrictMaybe (BabbageTxOut ConwayEra))
forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (TxOut era))
Lens' (TxBody era) (StrictMaybe (TxOut era))
collateralReturnTxBodyL of
    StrictMaybe (BabbageTxOut ConwayEra)
SNothing -> []
    SJust BabbageTxOut ConwayEra
x -> [TxOut era
BabbageTxOut ConwayEra
x]
getCollateralOutputs Proof era
Babbage TxBody era
txBody =
  case TxBody era
txBody TxBody era
-> Getting
     (StrictMaybe (BabbageTxOut BabbageEra))
     (TxBody era)
     (StrictMaybe (BabbageTxOut BabbageEra))
-> StrictMaybe (BabbageTxOut BabbageEra)
forall s a. s -> Getting a s a -> a
^. (StrictMaybe (TxOut era)
 -> Const
      (StrictMaybe (BabbageTxOut BabbageEra)) (StrictMaybe (TxOut era)))
-> TxBody era
-> Const (StrictMaybe (BabbageTxOut BabbageEra)) (TxBody era)
Getting
  (StrictMaybe (BabbageTxOut BabbageEra))
  (TxBody era)
  (StrictMaybe (BabbageTxOut BabbageEra))
forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (TxOut era))
Lens' (TxBody era) (StrictMaybe (TxOut era))
collateralReturnTxBodyL of
    StrictMaybe (BabbageTxOut BabbageEra)
SNothing -> []
    SJust BabbageTxOut BabbageEra
x -> [TxOut era
BabbageTxOut BabbageEra
x]
getCollateralOutputs Proof era
Alonzo TxBody era
_ = []
getCollateralOutputs Proof era
Mary TxBody era
_ = []
getCollateralOutputs Proof era
Allegra TxBody era
_ = []
getCollateralOutputs Proof era
Shelley TxBody era
_ = []
{-# NOINLINE getCollateralOutputs #-}

getInputs :: EraTxBody era => Proof era -> TxBody era -> Set TxIn
getInputs :: forall era. EraTxBody era => Proof era -> TxBody era -> Set TxIn
getInputs Proof era
_ TxBody era
tx = TxBody era
tx TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL

getOutputs :: EraTxBody era => Proof era -> TxBody era -> StrictSeq (TxOut era)
getOutputs :: forall era.
EraTxBody era =>
Proof era -> TxBody era -> StrictSeq (TxOut era)
getOutputs Proof era
_ TxBody era
tx = TxBody era
tx TxBody era
-> Getting
     (StrictSeq (TxOut era)) (TxBody era) (StrictSeq (TxOut era))
-> StrictSeq (TxOut era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxOut era)) (TxBody era) (StrictSeq (TxOut era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL

getScriptWits ::
  EraTxWits era => Proof era -> TxWits era -> Map ScriptHash (Script era)
getScriptWits :: forall era.
EraTxWits era =>
Proof era -> TxWits era -> Map ScriptHash (Script era)
getScriptWits Proof era
_ TxWits era
tx = TxWits era
tx TxWits era
-> Getting
     (Map ScriptHash (Script era))
     (TxWits era)
     (Map ScriptHash (Script era))
-> Map ScriptHash (Script era)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map ScriptHash (Script era))
  (TxWits era)
  (Map ScriptHash (Script era))
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL

allInputs :: EraTxBody era => Proof era -> TxBody era -> Set TxIn
allInputs :: forall era. EraTxBody era => Proof era -> TxBody era -> Set TxIn
allInputs Proof era
_ TxBody era
txb = TxBody era
txb TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. EraTxBody era => SimpleGetter (TxBody era) (Set TxIn)
SimpleGetter (TxBody era) (Set TxIn)
allInputsTxBodyF

getWitnesses :: EraTx era => Proof era -> Tx era -> TxWits era
getWitnesses :: forall era. EraTx era => Proof era -> Tx era -> TxWits era
getWitnesses Proof era
_ Tx era
tx = Tx era
tx Tx era -> Getting (TxWits era) (Tx era) (TxWits era) -> TxWits era
forall s a. s -> Getting a s a -> a
^. Getting (TxWits era) (Tx era) (TxWits era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL

primaryLanguage :: Proof era -> Maybe Language
primaryLanguage :: forall era. Proof era -> Maybe Language
primaryLanguage Proof era
Conway = Language -> Maybe Language
forall a. a -> Maybe a
Just Language
PlutusV2
primaryLanguage Proof era
Babbage = Language -> Maybe Language
forall a. a -> Maybe a
Just Language
PlutusV2
primaryLanguage Proof era
Alonzo = Language -> Maybe Language
forall a. a -> Maybe a
Just Language
PlutusV1
primaryLanguage Proof era
_ = Maybe Language
forall a. Maybe a
Nothing
{-# NOINLINE primaryLanguage #-}

alwaysSucceedsLang' :: forall era. EraPlutusContext era => Language -> Natural -> Script era
alwaysSucceedsLang' :: forall era.
EraPlutusContext era =>
Language -> Natural -> Script era
alwaysSucceedsLang' Language
l =
  PlutusScript era -> Script era
forall era. AlonzoEraScript era => PlutusScript era -> Script era
fromPlutusScript (PlutusScript era -> Script era)
-> (Natural -> PlutusScript era) -> Natural -> Script era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SupportedLanguage era -> Natural -> PlutusScript era
forall era. SupportedLanguage era -> Natural -> PlutusScript era
alwaysSucceedsLang (Fail (SupportedLanguage era) -> SupportedLanguage era
forall a. HasCallStack => Fail a -> a
errorFail (forall era (m :: * -> *).
(EraPlutusContext era, MonadFail m) =>
Language -> m (SupportedLanguage era)
mkSupportedLanguageM @era Language
l))

alwaysFailsLang' :: forall era. EraPlutusContext era => Language -> Natural -> Script era
alwaysFailsLang' :: forall era.
EraPlutusContext era =>
Language -> Natural -> Script era
alwaysFailsLang' Language
l =
  PlutusScript era -> Script era
forall era. AlonzoEraScript era => PlutusScript era -> Script era
fromPlutusScript (PlutusScript era -> Script era)
-> (Natural -> PlutusScript era) -> Natural -> Script era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SupportedLanguage era -> Natural -> PlutusScript era
forall era. SupportedLanguage era -> Natural -> PlutusScript era
alwaysFailsLang (Fail (SupportedLanguage era) -> SupportedLanguage era
forall a. HasCallStack => Fail a -> a
errorFail (forall era (m :: * -> *).
(EraPlutusContext era, MonadFail m) =>
Language -> m (SupportedLanguage era)
mkSupportedLanguageM @era Language
l))

alwaysTrue :: forall era. Proof era -> Maybe Language -> Natural -> Script era
alwaysTrue :: forall era. Proof era -> Maybe Language -> Natural -> Script era
alwaysTrue Proof era
Conway (Just Language
l) Natural
n = forall era.
EraPlutusContext era =>
Language -> Natural -> Script era
alwaysSucceedsLang' @era Language
l Natural
n
alwaysTrue p :: Proof era
p@Proof era
Conway Maybe Language
Nothing Natural
_ = NativeScript ConwayEra -> Script ConwayEra
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript (NativeScript ConwayEra -> Script ConwayEra)
-> NativeScript ConwayEra -> Script ConwayEra
forall a b. (a -> b) -> a -> b
$ [Proof era -> NativeScript era] -> Proof era -> NativeScript era
forall era.
Scriptic era =>
[Proof era -> NativeScript era] -> Proof era -> NativeScript era
Scriptic.allOf [] Proof era
p
alwaysTrue Proof era
Babbage (Just Language
l) Natural
n = forall era.
EraPlutusContext era =>
Language -> Natural -> Script era
alwaysSucceedsLang' @era Language
l Natural
n
alwaysTrue p :: Proof era
p@Proof era
Babbage Maybe Language
Nothing Natural
_ = NativeScript BabbageEra -> Script BabbageEra
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript (NativeScript BabbageEra -> Script BabbageEra)
-> NativeScript BabbageEra -> Script BabbageEra
forall a b. (a -> b) -> a -> b
$ [Proof era -> NativeScript era] -> Proof era -> NativeScript era
forall era.
Scriptic era =>
[Proof era -> NativeScript era] -> Proof era -> NativeScript era
Scriptic.allOf [] Proof era
p
alwaysTrue Proof era
Alonzo (Just Language
l) Natural
n = forall era.
EraPlutusContext era =>
Language -> Natural -> Script era
alwaysSucceedsLang' @era Language
l Natural
n
alwaysTrue p :: Proof era
p@Proof era
Alonzo Maybe Language
Nothing Natural
_ = NativeScript AlonzoEra -> Script AlonzoEra
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript (NativeScript AlonzoEra -> Script AlonzoEra)
-> NativeScript AlonzoEra -> Script AlonzoEra
forall a b. (a -> b) -> a -> b
$ [Proof era -> NativeScript era] -> Proof era -> NativeScript era
forall era.
Scriptic era =>
[Proof era -> NativeScript era] -> Proof era -> NativeScript era
Scriptic.allOf [] Proof era
p
alwaysTrue p :: Proof era
p@Proof era
Mary Maybe Language
_ Natural
n = Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
n Proof era
p
alwaysTrue p :: Proof era
p@Proof era
Allegra Maybe Language
_ Natural
n = Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
n Proof era
p
alwaysTrue p :: Proof era
p@Proof era
Shelley Maybe Language
_ Natural
n = Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
always Natural
n Proof era
p
{-# NOINLINE alwaysTrue #-}

alwaysFalse :: forall era. Proof era -> Maybe Language -> Natural -> Script era
alwaysFalse :: forall era. Proof era -> Maybe Language -> Natural -> Script era
alwaysFalse Proof era
Conway (Just Language
l) Natural
n = forall era.
EraPlutusContext era =>
Language -> Natural -> Script era
alwaysFailsLang' @era Language
l Natural
n
alwaysFalse p :: Proof era
p@Proof era
Conway Maybe Language
Nothing Natural
_ = NativeScript ConwayEra -> Script ConwayEra
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript (NativeScript ConwayEra -> Script ConwayEra)
-> NativeScript ConwayEra -> Script ConwayEra
forall a b. (a -> b) -> a -> b
$ [Proof era -> NativeScript era] -> Proof era -> NativeScript era
forall era.
Scriptic era =>
[Proof era -> NativeScript era] -> Proof era -> NativeScript era
Scriptic.anyOf [] Proof era
p
alwaysFalse Proof era
Babbage (Just Language
l) Natural
n = forall era.
EraPlutusContext era =>
Language -> Natural -> Script era
alwaysFailsLang' @era Language
l Natural
n
alwaysFalse p :: Proof era
p@Proof era
Babbage Maybe Language
Nothing Natural
_ = NativeScript BabbageEra -> Script BabbageEra
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript (NativeScript BabbageEra -> Script BabbageEra)
-> NativeScript BabbageEra -> Script BabbageEra
forall a b. (a -> b) -> a -> b
$ [Proof era -> NativeScript era] -> Proof era -> NativeScript era
forall era.
Scriptic era =>
[Proof era -> NativeScript era] -> Proof era -> NativeScript era
Scriptic.anyOf [] Proof era
p
alwaysFalse Proof era
Alonzo (Just Language
l) Natural
n = forall era.
EraPlutusContext era =>
Language -> Natural -> Script era
alwaysFailsLang' @era Language
l Natural
n
alwaysFalse p :: Proof era
p@Proof era
Alonzo Maybe Language
Nothing Natural
_ = NativeScript AlonzoEra -> Script AlonzoEra
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript (NativeScript AlonzoEra -> Script AlonzoEra)
-> NativeScript AlonzoEra -> Script AlonzoEra
forall a b. (a -> b) -> a -> b
$ [Proof era -> NativeScript era] -> Proof era -> NativeScript era
forall era.
Scriptic era =>
[Proof era -> NativeScript era] -> Proof era -> NativeScript era
Scriptic.anyOf [] Proof era
p
alwaysFalse p :: Proof era
p@Proof era
Mary Maybe Language
_ Natural
n = Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
n Proof era
p
alwaysFalse p :: Proof era
p@Proof era
Allegra Maybe Language
_ Natural
n = Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
n Proof era
p
alwaysFalse p :: Proof era
p@Proof era
Shelley Maybe Language
_ Natural
n = Natural -> Proof era -> Script era
forall era. Scriptic era => Natural -> Proof era -> Script era
never Natural
n Proof era
p
{-# NOINLINE alwaysFalse #-}

certs :: (ShelleyEraTxBody era, EraTx era) => Proof era -> Tx era -> [TxCert era]
certs :: forall era.
(ShelleyEraTxBody era, EraTx era) =>
Proof era -> Tx era -> [TxCert era]
certs Proof era
_ Tx era
tx = StrictSeq (TxCert era) -> [TxCert era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList (StrictSeq (TxCert era) -> [TxCert era])
-> StrictSeq (TxCert era) -> [TxCert era]
forall a b. (a -> b) -> a -> b
$ Tx era
tx Tx era
-> Getting
     (StrictSeq (TxCert era)) (Tx era) (StrictSeq (TxCert era))
-> StrictSeq (TxCert era)
forall s a. s -> Getting a s a -> a
^. (TxBody era -> Const (StrictSeq (TxCert era)) (TxBody era))
-> Tx era -> Const (StrictSeq (TxCert era)) (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Const (StrictSeq (TxCert era)) (TxBody era))
 -> Tx era -> Const (StrictSeq (TxCert era)) (Tx era))
-> ((StrictSeq (TxCert era)
     -> Const (StrictSeq (TxCert era)) (StrictSeq (TxCert era)))
    -> TxBody era -> Const (StrictSeq (TxCert era)) (TxBody era))
-> Getting
     (StrictSeq (TxCert era)) (Tx era) (StrictSeq (TxCert era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era)
 -> Const (StrictSeq (TxCert era)) (StrictSeq (TxCert era)))
-> TxBody era -> Const (StrictSeq (TxCert era)) (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL

-- | Create an old style RewardUpdate to be used in tests, in any Era.
createRUpdNonPulsing' ::
  forall era.
  Proof era ->
  Model era ->
  RewardUpdateOld
createRUpdNonPulsing' :: forall era. Proof era -> Model era -> RewardUpdateOld
createRUpdNonPulsing' Proof era
proof Model era
model =
  let bm :: BlocksMade
bm = Map (KeyHash 'StakePool) Natural -> BlocksMade
BlocksMade (Map (KeyHash 'StakePool) Natural -> BlocksMade)
-> Map (KeyHash 'StakePool) Natural -> BlocksMade
forall a b. (a -> b) -> a -> b
$ Model era -> Map (KeyHash 'StakePool) Natural
forall era.
ModelNewEpochState era -> Map (KeyHash 'StakePool) Natural
mBcur Model era
model -- TODO or should this be mBprev?
      ss :: SnapShots
ss = Model era -> SnapShots
forall era. ModelNewEpochState era -> SnapShots
mSnapshots Model era
model
      as :: ChainAccountState
as = Model era -> ChainAccountState
forall era. ModelNewEpochState era -> ChainAccountState
mChainAccountState Model era
model
      reserves :: Coin
reserves = ChainAccountState -> Coin
casReserves ChainAccountState
as
      pp :: PParams era
pp = Model era -> PParams era
forall era. ModelNewEpochState era -> PParams era
mPParams Model era
model
      totalStake :: Coin
totalStake = (Coin -> Coin -> Coin)
-> Coin -> Map (Credential 'Staking) Coin -> Coin
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
(<+>) (Integer -> Coin
Coin Integer
0) (Map (Credential 'Staking) Coin -> Coin)
-> Map (Credential 'Staking) Coin -> Coin
forall a b. (a -> b) -> a -> b
$ Model era -> Map (Credential 'Staking) Coin
forall era.
ModelNewEpochState era -> Map (Credential 'Staking) Coin
mRewards Model era
model
      rs :: Set (Credential 'Staking)
rs = Map (Credential 'Staking) Coin -> Set (Credential 'Staking)
forall k a. Map k a -> Set k
Map.keysSet (Map (Credential 'Staking) Coin -> Set (Credential 'Staking))
-> Map (Credential 'Staking) Coin -> Set (Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Model era -> Map (Credential 'Staking) Coin
forall era.
ModelNewEpochState era -> Map (Credential 'Staking) Coin
mRewards Model era
model -- TODO or should we look at delegated keys instead?
      en :: EpochNo
en = Model era -> EpochNo
forall era. ModelNewEpochState era -> EpochNo
mEL Model era
model

      -- We use testGlobals here, since this generic function is used only in tests.
      slotsPerEpoch :: EpochSize
slotsPerEpoch = case EpochInfo (Either Text) -> EpochNo -> Either Text EpochSize
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> EpochNo -> m EpochSize
epochInfoSize (Globals -> EpochInfo (Either Text)
epochInfo Globals
testGlobals) EpochNo
en of
        Left Text
err -> String -> EpochSize
forall a. HasCallStack => String -> a
error (String
"Failed to calculate slots per epoch:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
err)
        Right EpochSize
x -> EpochSize
x
   in (Reader Globals RewardUpdateOld -> Globals -> RewardUpdateOld
forall r a. Reader r a -> r -> a
`runReader` Globals
testGlobals) (Reader Globals RewardUpdateOld -> RewardUpdateOld)
-> Reader Globals RewardUpdateOld -> RewardUpdateOld
forall a b. (a -> b) -> a -> b
$ case Proof era
proof of
        Proof era
Conway -> forall era.
EraPParams era =>
EpochSize
-> BlocksMade
-> SnapShots
-> Coin
-> PParams era
-> Coin
-> Set (Credential 'Staking)
-> NonMyopic
-> Reader Globals RewardUpdateOld
createRUpdOld_ @era EpochSize
slotsPerEpoch BlocksMade
bm SnapShots
ss Coin
reserves PParams era
pp Coin
totalStake Set (Credential 'Staking)
rs NonMyopic
forall a. Default a => a
def
        Proof era
Babbage -> forall era.
EraPParams era =>
EpochSize
-> BlocksMade
-> SnapShots
-> Coin
-> PParams era
-> Coin
-> Set (Credential 'Staking)
-> NonMyopic
-> Reader Globals RewardUpdateOld
createRUpdOld_ @era EpochSize
slotsPerEpoch BlocksMade
bm SnapShots
ss Coin
reserves PParams era
pp Coin
totalStake Set (Credential 'Staking)
rs NonMyopic
forall a. Default a => a
def
        Proof era
Alonzo -> forall era.
EraPParams era =>
EpochSize
-> BlocksMade
-> SnapShots
-> Coin
-> PParams era
-> Coin
-> Set (Credential 'Staking)
-> NonMyopic
-> Reader Globals RewardUpdateOld
createRUpdOld_ @era EpochSize
slotsPerEpoch BlocksMade
bm SnapShots
ss Coin
reserves PParams era
pp Coin
totalStake Set (Credential 'Staking)
rs NonMyopic
forall a. Default a => a
def
        Proof era
Mary -> forall era.
EraPParams era =>
EpochSize
-> BlocksMade
-> SnapShots
-> Coin
-> PParams era
-> Coin
-> Set (Credential 'Staking)
-> NonMyopic
-> Reader Globals RewardUpdateOld
createRUpdOld_ @era EpochSize
slotsPerEpoch BlocksMade
bm SnapShots
ss Coin
reserves PParams era
pp Coin
totalStake Set (Credential 'Staking)
rs NonMyopic
forall a. Default a => a
def
        Proof era
Allegra -> forall era.
EraPParams era =>
EpochSize
-> BlocksMade
-> SnapShots
-> Coin
-> PParams era
-> Coin
-> Set (Credential 'Staking)
-> NonMyopic
-> Reader Globals RewardUpdateOld
createRUpdOld_ @era EpochSize
slotsPerEpoch BlocksMade
bm SnapShots
ss Coin
reserves PParams era
pp Coin
totalStake Set (Credential 'Staking)
rs NonMyopic
forall a. Default a => a
def
        Proof era
Shelley -> forall era.
EraPParams era =>
EpochSize
-> BlocksMade
-> SnapShots
-> Coin
-> PParams era
-> Coin
-> Set (Credential 'Staking)
-> NonMyopic
-> Reader Globals RewardUpdateOld
createRUpdOld_ @era EpochSize
slotsPerEpoch BlocksMade
bm SnapShots
ss Coin
reserves PParams era
pp Coin
totalStake Set (Credential 'Staking)
rs NonMyopic
forall a. Default a => a
def
{-# NOINLINE createRUpdNonPulsing' #-}

languagesUsed ::
  forall era.
  Proof era ->
  Tx era ->
  UTxO era ->
  Set ScriptHash ->
  Set Language
languagesUsed :: forall era.
Proof era -> Tx era -> UTxO era -> Set ScriptHash -> Set Language
languagesUsed Proof era
proof Tx era
tx UTxO era
utxo Set ScriptHash
sNeeded = case Proof era
proof of
  Proof era
Shelley -> Set Language
forall a. Set a
Set.empty
  Proof era
Allegra -> Set Language
forall a. Set a
Set.empty
  Proof era
Mary -> Set Language
forall a. Set a
Set.empty
  Proof era
Alonzo -> Tx era -> UTxO era -> Set ScriptHash -> Set Language
forall era.
(EraUTxO era, AlonzoEraScript era) =>
Tx era -> UTxO era -> Set ScriptHash -> Set Language
languages Tx era
tx UTxO era
utxo Set ScriptHash
sNeeded
  Proof era
Babbage -> Tx era -> UTxO era -> Set ScriptHash -> Set Language
forall era.
(EraUTxO era, AlonzoEraScript era) =>
Tx era -> UTxO era -> Set ScriptHash -> Set Language
languages Tx era
tx UTxO era
utxo Set ScriptHash
sNeeded
  Proof era
Conway -> Tx era -> UTxO era -> Set ScriptHash -> Set Language
forall era.
(EraUTxO era, AlonzoEraScript era) =>
Tx era -> UTxO era -> Set ScriptHash -> Set Language
languages Tx era
tx UTxO era
utxo Set ScriptHash
sNeeded
{-# NOINLINE languagesUsed #-}

-- | Compute the Set of Languages in an era, where 'AlonzoScripts' are used
languages ::
  forall era.
  (EraUTxO era, AlonzoEraScript era) =>
  Tx era ->
  UTxO era ->
  Set ScriptHash ->
  Set Language
languages :: forall era.
(EraUTxO era, AlonzoEraScript era) =>
Tx era -> UTxO era -> Set ScriptHash -> Set Language
languages Tx era
tx UTxO era
utxo Set ScriptHash
sNeeded = (Set Language -> Script era -> Set Language)
-> Set Language -> Map ScriptHash (Script era) -> Set Language
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' Set Language -> Script era -> Set Language
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraScript era) =>
Set Language -> Script era -> Set Language
accum Set Language
forall a. Set a
Set.empty Map ScriptHash (Script era)
allScripts
  where
    allScripts :: Map ScriptHash (Script era)
allScripts = Map ScriptHash (Script era)
-> Set ScriptHash -> Map ScriptHash (Script era)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys (ScriptsProvided era -> Map ScriptHash (Script era)
forall era. ScriptsProvided era -> Map ScriptHash (Script era)
unScriptsProvided (ScriptsProvided era -> Map ScriptHash (Script era))
-> ScriptsProvided era -> Map ScriptHash (Script era)
forall a b. (a -> b) -> a -> b
$ UTxO era -> Tx era -> ScriptsProvided era
forall era.
EraUTxO era =>
UTxO era -> Tx era -> ScriptsProvided era
getScriptsProvided UTxO era
utxo Tx era
tx) Set ScriptHash
sNeeded
    accum :: Set Language -> Script era -> Set Language
accum Set Language
ans Script era
script =
      case Script era -> Maybe (PlutusScript era)
forall era.
AlonzoEraScript era =>
Script era -> Maybe (PlutusScript era)
toPlutusScript Script era
script of
        Maybe (PlutusScript era)
Nothing -> Set Language
ans
        Just PlutusScript era
plutusScript -> Language -> Set Language -> Set Language
forall a. Ord a => a -> Set a -> Set a
Set.insert (PlutusScript era -> Language
forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript era
plutusScript) Set Language
ans

-- | Compute the total Ada from Ada pots within 't'
class TotalAda t where
  totalAda :: t -> Coin

instance TotalAda ChainAccountState where
  totalAda :: ChainAccountState -> Coin
totalAda (ChainAccountState Coin
treasury Coin
reserves) = Coin
treasury Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
reserves

instance Reflect era => TotalAda (UTxOState era) where
  totalAda :: UTxOState era -> Coin
totalAda (UTxOState UTxO era
utxo Coin
_deposits Coin
fees GovState era
gs InstantStake era
_ Coin
donations) =
    UTxO era -> Coin
forall t. TotalAda t => t -> Coin
totalAda UTxO era
utxo Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
fees Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> GovState era -> Coin
forall era. Reflect era => GovState era -> Coin
govStateTotalAda GovState era
gs Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
donations

-- we don't add in the _deposits, because it is invariant that this
-- is equal to the sum of the key deposit map and the pool deposit map
-- So these are accounted for in the instance (TotalAda (CertState era))
-- TODO I'm not sure this is true ^
-- Imp conformance tests show in logs that totalAda is off by the deposit amount

instance Reflect era => TotalAda (UTxO era) where
  totalAda :: UTxO era -> Coin
totalAda (UTxO Map TxIn (TxOut era)
m) = (Coin -> TxOut era -> Coin) -> Coin -> Map TxIn (TxOut era) -> Coin
forall b a. (b -> a -> b) -> b -> Map TxIn a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Coin -> TxOut era -> Coin
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 EraTxOut era) =>
Coin -> TxOut era -> Coin
accum Coin
forall a. Monoid a => a
mempty Map TxIn (TxOut era)
m
    where
      accum :: Coin -> TxOut era -> Coin
accum Coin
ans TxOut era
txOut = (TxOut era
txOut TxOut era -> Getting Coin (TxOut era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxOut era) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL) Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Coin
ans

instance TotalAda (DState era) where
  totalAda :: DState era -> Coin
totalAda DState era
dstate =
    (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
UM.fromCompact (CompactForm Coin -> Coin) -> CompactForm Coin -> Coin
forall a b. (a -> b) -> a -> b
$ UView (Credential 'Staking) RDPair -> CompactForm Coin
forall k. UView k RDPair -> CompactForm Coin
UM.sumRewardsUView (UMap -> UView (Credential 'Staking) RDPair
UM.RewDepUView (DState era -> UMap
forall era. DState era -> UMap
dsUnified DState era
dstate)))
      Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
UM.fromCompact (CompactForm Coin -> Coin) -> CompactForm Coin -> Coin
forall a b. (a -> b) -> a -> b
$ UView (Credential 'Staking) RDPair -> CompactForm Coin
forall k. UView k RDPair -> CompactForm Coin
UM.sumDepositUView (UMap -> UView (Credential 'Staking) RDPair
UM.RewDepUView (DState era -> UMap
forall era. DState era -> UMap
dsUnified DState era
dstate)))

instance TotalAda (PState era) where
  totalAda :: PState era -> Coin
totalAda PState era
pstate = Map (KeyHash 'StakePool) Coin -> Coin
forall m. Monoid m => Map (KeyHash 'StakePool) m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Fold.fold (PState era -> Map (KeyHash 'StakePool) Coin
forall era. PState era -> Map (KeyHash 'StakePool) Coin
psDeposits PState era
pstate)

instance TotalAda (VState era) where
  totalAda :: VState era -> Coin
totalAda VState era
_ = Coin
forall a. Monoid a => a
mempty

instance TotalAda (ShelleyCertState era) where
  totalAda :: ShelleyCertState era -> Coin
totalAda (ShelleyCertState PState era
ps DState era
ds) = DState era -> Coin
forall t. TotalAda t => t -> Coin
totalAda DState era
ds Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> PState era -> Coin
forall t. TotalAda t => t -> Coin
totalAda PState era
ps

instance TotalAda (ShelleyGovState era) where
  totalAda :: ShelleyGovState era -> Coin
totalAda ShelleyGovState era
_ = Coin
forall a. Monoid a => a
mempty

govStateTotalAda :: forall era. Reflect era => GovState era -> Coin
govStateTotalAda :: forall era. Reflect era => GovState era -> Coin
govStateTotalAda = case forall era. Reflect era => Proof era
reify @era of
  Proof era
Shelley -> GovState era -> Coin
ShelleyGovState ShelleyEra -> Coin
forall t. TotalAda t => t -> Coin
totalAda
  Proof era
Mary -> GovState era -> Coin
ShelleyGovState MaryEra -> Coin
forall t. TotalAda t => t -> Coin
totalAda
  Proof era
Allegra -> GovState era -> Coin
ShelleyGovState AllegraEra -> Coin
forall t. TotalAda t => t -> Coin
totalAda
  Proof era
Alonzo -> GovState era -> Coin
ShelleyGovState AlonzoEra -> Coin
forall t. TotalAda t => t -> Coin
totalAda
  Proof era
Babbage -> GovState era -> Coin
ShelleyGovState BabbageEra -> Coin
forall t. TotalAda t => t -> Coin
totalAda
  Proof era
Conway -> GovState era -> Coin
ConwayGovState ConwayEra -> Coin
forall a. Monoid a => a
mempty

certStateTotalAda :: forall era. Reflect era => CertState era -> Coin
certStateTotalAda :: forall era. Reflect era => CertState era -> Coin
certStateTotalAda = case forall era. Reflect era => Proof era
reify @era of
  Proof era
Shelley -> CertState era -> Coin
ShelleyCertState ShelleyEra -> Coin
forall t. TotalAda t => t -> Coin
totalAda
  Proof era
Mary -> CertState era -> Coin
ShelleyCertState MaryEra -> Coin
forall t. TotalAda t => t -> Coin
totalAda
  Proof era
Allegra -> CertState era -> Coin
ShelleyCertState AllegraEra -> Coin
forall t. TotalAda t => t -> Coin
totalAda
  Proof era
Alonzo -> CertState era -> Coin
ShelleyCertState AlonzoEra -> Coin
forall t. TotalAda t => t -> Coin
totalAda
  Proof era
Babbage -> CertState era -> Coin
ShelleyCertState BabbageEra -> Coin
forall t. TotalAda t => t -> Coin
totalAda
  Proof era
Conway -> CertState era -> Coin
ConwayCertState ConwayEra -> Coin
forall a. Monoid a => a
mempty

instance Reflect era => TotalAda (LedgerState era) where
  totalAda :: LedgerState era -> Coin
totalAda (LedgerState UTxOState era
utxos CertState era
dps) = UTxOState era -> Coin
forall t. TotalAda t => t -> Coin
totalAda UTxOState era
utxos Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> CertState era -> Coin
forall era. Reflect era => CertState era -> Coin
certStateTotalAda CertState era
dps

instance Reflect era => TotalAda (EpochState era) where
  totalAda :: EpochState era -> Coin
totalAda EpochState era
eps = LedgerState era -> Coin
forall t. TotalAda t => t -> Coin
totalAda (EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState EpochState era
eps) Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> ChainAccountState -> Coin
forall t. TotalAda t => t -> Coin
totalAda (EpochState era -> ChainAccountState
forall era. EpochState era -> ChainAccountState
esChainAccountState EpochState era
eps)

instance Reflect era => TotalAda (NewEpochState era) where
  totalAda :: NewEpochState era -> Coin
totalAda NewEpochState era
nes = EpochState era -> Coin
forall t. TotalAda t => t -> Coin
totalAda (NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes)

adaPots :: Proof era -> EpochState era -> AdaPots
adaPots :: forall era. Proof era -> EpochState era -> AdaPots
adaPots Proof era
Conway EpochState era
es = EpochState era -> AdaPots
forall era.
(EraTxOut era, EraGov era, EraCertState era) =>
EpochState era -> AdaPots
totalAdaPotsES EpochState era
es
adaPots Proof era
Babbage EpochState era
es = EpochState era -> AdaPots
forall era.
(EraTxOut era, EraGov era, EraCertState era) =>
EpochState era -> AdaPots
totalAdaPotsES EpochState era
es
adaPots Proof era
Alonzo EpochState era
es = EpochState era -> AdaPots
forall era.
(EraTxOut era, EraGov era, EraCertState era) =>
EpochState era -> AdaPots
totalAdaPotsES EpochState era
es
adaPots Proof era
Mary EpochState era
es = EpochState era -> AdaPots
forall era.
(EraTxOut era, EraGov era, EraCertState era) =>
EpochState era -> AdaPots
totalAdaPotsES EpochState era
es
adaPots Proof era
Allegra EpochState era
es = EpochState era -> AdaPots
forall era.
(EraTxOut era, EraGov era, EraCertState era) =>
EpochState era -> AdaPots
totalAdaPotsES EpochState era
es
adaPots Proof era
Shelley EpochState era
es = EpochState era -> AdaPots
forall era.
(EraTxOut era, EraGov era, EraCertState era) =>
EpochState era -> AdaPots
totalAdaPotsES EpochState era
es
{-# NOINLINE adaPots #-}