{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Test.Cardano.Ledger.Generic.Updaters where

import Cardano.Crypto.DSIGN.Class ()
import Cardano.Ledger.Alonzo.Scripts (emptyCostModels)
import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..), hashScriptIntegrity)
import qualified Cardano.Ledger.Alonzo.Tx as Alonzo
import Cardano.Ledger.Alonzo.TxBody (AlonzoTxOut (..))
import Cardano.Ledger.Alonzo.TxWits (AlonzoTxWits (..), Redeemers (..), TxDats (..))
import Cardano.Ledger.Babbage.Core
import Cardano.Ledger.Babbage.TxBody (BabbageTxOut (..))
import Cardano.Ledger.Conway.PParams (
  ppCommitteeMaxTermLengthL,
  ppCommitteeMinSizeL,
  ppDRepActivityL,
  ppDRepDepositL,
  ppDRepVotingThresholdsL,
  ppGovActionDepositL,
  ppGovActionLifetimeL,
  ppPoolVotingThresholdsL,
 )
import Cardano.Ledger.Conway.TxBody (ConwayEraTxBody (..))
import Cardano.Ledger.Plutus.Data (Datum (..))
import Cardano.Ledger.Plutus.Language (Language (..))
import Cardano.Ledger.Shelley.Tx as Shelley (
  ShelleyTx (..),
 )
import Cardano.Ledger.Shelley.TxOut as Shelley (ShelleyTxOut (..))
import Cardano.Ledger.Shelley.TxWits as Shelley (
  addrWits,
  bootWits,
  scriptWits,
 )
import qualified Data.List as List
import Data.Map (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict (StrictMaybe (..))
import Data.Set (Set)
import qualified Data.Set as Set
import Lens.Micro
import Test.Cardano.Ledger.Generic.Fields
import Test.Cardano.Ledger.Generic.Proof
import Test.Cardano.Ledger.Plutus (zeroTestingCostModels)

-- ===========================================================================
-- Upaters and the use of Policy to specify Merge Semantics and use of [t] as inputs.
-- When using the Updaters, one will usually consruct the fields by hand.
-- So if a Field consists of (Set t), (StrictSeq t), [t], (Maybe t), (StrictMaybe t), or (Map key t)
-- we will use a list, and convert to the appropriate type for each Field and Era.
-- Several of these: (Map key t), (Maybe t) and (StrictMaybe t) can be problematic
-- since they only have a well defined Merge semantics when (SemiGroup t) .
-- So we define specialized functions applyMap, applyMaybe and applySMaybe that raise
-- an error if a Merge semantics finds more than one copy of the elements being combined.
-- Users may choose what merge semantics they want by passing the right Policy
-- =============================================================================

-- =======================================================================
-- A Policy lets you choose to keep the old (first) or the new (override)
-- or combine (merge) of two values. We only use this for elements in the
-- WitnessesField data type. That is because we assemble witnesses in small
-- pieces and we combine the pieces together. Every field in ShelleyTxWits and
-- AlonzoTxWits has clear way of being merged. We don't use Policies in the other
-- xxxField types because most of those parts cannot be safely combined.
-- (The only execeptions are Coin and Value, but they both have Monoid
-- instances, where we can easliy use (<>) instead.).

class Merge t where
  first :: t -> t -> t
  first t
x t
_ = t
x
  override :: t -> t -> t
  override t
_ t
y = t
y
  merge :: t -> t -> t

type Policy = (forall t. Merge t => t -> t -> t)

-- We need just these 4 instances to merge components of TxWitnesses

instance Ord a => Merge (Set a) where
  merge :: Set a -> Set a -> Set a
merge = forall a. Ord a => Set a -> Set a -> Set a
Set.union

instance Era era => Merge (TxDats era) where
  merge :: TxDats era -> TxDats era -> TxDats era
merge (TxDats Map (DataHash (EraCrypto era)) (Data era)
x) (TxDats Map (DataHash (EraCrypto era)) (Data era)
y) = forall era.
Era era =>
Map (DataHash (EraCrypto era)) (Data era) -> TxDats era
TxDats (forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map (DataHash (EraCrypto era)) (Data era)
x Map (DataHash (EraCrypto era)) (Data era)
y)

instance AlonzoEraScript era => Merge (Redeemers era) where
  merge :: Redeemers era -> Redeemers era -> Redeemers era
merge (Redeemers Map (PlutusPurpose AsIx era) (Data era, ExUnits)
x) (Redeemers Map (PlutusPurpose AsIx era) (Data era, ExUnits)
y) = forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers (forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map (PlutusPurpose AsIx era) (Data era, ExUnits)
x Map (PlutusPurpose AsIx era) (Data era, ExUnits)
y)

instance Merge (Map (ScriptHash c) v) where
  merge :: Map (ScriptHash c) v
-> Map (ScriptHash c) v -> Map (ScriptHash c) v
merge = forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union

-- ====================================================================
-- Building Era parametric Records
-- ====================================================================

-- Updaters for Tx

updateTx :: Proof era -> Tx era -> TxField era -> Tx era
updateTx :: forall era. Proof era -> Tx era -> TxField era -> Tx era
updateTx wit :: Proof era
wit@Proof era
Shelley tx :: Tx era
tx@(ShelleyTx TxBody (ShelleyEra StandardCrypto)
b TxWits (ShelleyEra StandardCrypto)
w StrictMaybe (TxAuxData (ShelleyEra StandardCrypto))
d) TxField era
dt =
  case TxField era
dt of
    Body TxBody era
fbody -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody era
fbody TxWits (ShelleyEra StandardCrypto)
w StrictMaybe (TxAuxData (ShelleyEra StandardCrypto))
d
    BodyI [TxBodyField era]
bfields -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx (forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody Proof era
wit [TxBodyField era]
bfields) TxWits (ShelleyEra StandardCrypto)
w StrictMaybe (TxAuxData (ShelleyEra StandardCrypto))
d
    TxWits TxWits era
fwit -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody (ShelleyEra StandardCrypto)
b TxWits era
fwit StrictMaybe (TxAuxData (ShelleyEra StandardCrypto))
d
    WitnessesI [WitnessesField era]
wfields -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody (ShelleyEra StandardCrypto)
b (forall era.
Era era =>
Policy -> Proof era -> [WitnessesField era] -> TxWits era
newWitnesses Policy
override Proof era
wit [WitnessesField era]
wfields) StrictMaybe (TxAuxData (ShelleyEra StandardCrypto))
d
    AuxData StrictMaybe (TxAuxData era)
faux -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody (ShelleyEra StandardCrypto)
b TxWits (ShelleyEra StandardCrypto)
w StrictMaybe (TxAuxData era)
faux
    Valid IsValid
_ -> Tx era
tx
updateTx wit :: Proof era
wit@Proof era
Allegra tx :: Tx era
tx@(ShelleyTx TxBody (AllegraEra StandardCrypto)
b TxWits (AllegraEra StandardCrypto)
w StrictMaybe (TxAuxData (AllegraEra StandardCrypto))
d) TxField era
dt =
  case TxField era
dt of
    Body TxBody era
fbody -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody era
fbody TxWits (AllegraEra StandardCrypto)
w StrictMaybe (TxAuxData (AllegraEra StandardCrypto))
d
    BodyI [TxBodyField era]
bfields -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx (forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody Proof era
wit [TxBodyField era]
bfields) TxWits (AllegraEra StandardCrypto)
w StrictMaybe (TxAuxData (AllegraEra StandardCrypto))
d
    TxWits TxWits era
fwit -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody (AllegraEra StandardCrypto)
b TxWits era
fwit StrictMaybe (TxAuxData (AllegraEra StandardCrypto))
d
    WitnessesI [WitnessesField era]
wfields -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody (AllegraEra StandardCrypto)
b (forall era.
Era era =>
Policy -> Proof era -> [WitnessesField era] -> TxWits era
newWitnesses Policy
override Proof era
wit [WitnessesField era]
wfields) StrictMaybe (TxAuxData (AllegraEra StandardCrypto))
d
    AuxData StrictMaybe (TxAuxData era)
faux -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody (AllegraEra StandardCrypto)
b TxWits (AllegraEra StandardCrypto)
w StrictMaybe (TxAuxData era)
faux
    Valid IsValid
_ -> Tx era
tx
updateTx wit :: Proof era
wit@Proof era
Mary tx :: Tx era
tx@(ShelleyTx TxBody (MaryEra StandardCrypto)
b TxWits (MaryEra StandardCrypto)
w StrictMaybe (TxAuxData (MaryEra StandardCrypto))
d) TxField era
dt =
  case TxField era
dt of
    Body TxBody era
fbody -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody era
fbody TxWits (MaryEra StandardCrypto)
w StrictMaybe (TxAuxData (MaryEra StandardCrypto))
d
    BodyI [TxBodyField era]
bfields -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx (forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody Proof era
wit [TxBodyField era]
bfields) TxWits (MaryEra StandardCrypto)
w StrictMaybe (TxAuxData (MaryEra StandardCrypto))
d
    TxWits TxWits era
fwit -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody (MaryEra StandardCrypto)
b TxWits era
fwit StrictMaybe (TxAuxData (MaryEra StandardCrypto))
d
    WitnessesI [WitnessesField era]
wfields -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody (MaryEra StandardCrypto)
b (forall era.
Era era =>
Policy -> Proof era -> [WitnessesField era] -> TxWits era
newWitnesses Policy
override Proof era
wit [WitnessesField era]
wfields) StrictMaybe (TxAuxData (MaryEra StandardCrypto))
d
    AuxData StrictMaybe (TxAuxData era)
faux -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody (MaryEra StandardCrypto)
b TxWits (MaryEra StandardCrypto)
w StrictMaybe (TxAuxData era)
faux
    Valid IsValid
_ -> Tx era
tx
updateTx wit :: Proof era
wit@Proof era
Alonzo (Alonzo.AlonzoTx TxBody (AlonzoEra StandardCrypto)
b TxWits (AlonzoEra StandardCrypto)
w IsValid
iv StrictMaybe (TxAuxData (AlonzoEra StandardCrypto))
d) TxField era
dt =
  case TxField era
dt of
    Body TxBody era
fbody -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
Alonzo.AlonzoTx TxBody era
fbody TxWits (AlonzoEra StandardCrypto)
w IsValid
iv StrictMaybe (TxAuxData (AlonzoEra StandardCrypto))
d
    BodyI [TxBodyField era]
bfields -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
Alonzo.AlonzoTx (forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody Proof era
wit [TxBodyField era]
bfields) TxWits (AlonzoEra StandardCrypto)
w IsValid
iv StrictMaybe (TxAuxData (AlonzoEra StandardCrypto))
d
    TxWits TxWits era
fwit -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
Alonzo.AlonzoTx TxBody (AlonzoEra StandardCrypto)
b TxWits era
fwit IsValid
iv StrictMaybe (TxAuxData (AlonzoEra StandardCrypto))
d
    WitnessesI [WitnessesField era]
wfields -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
Alonzo.AlonzoTx TxBody (AlonzoEra StandardCrypto)
b (forall era.
Era era =>
Policy -> Proof era -> [WitnessesField era] -> TxWits era
newWitnesses Policy
override Proof era
wit [WitnessesField era]
wfields) IsValid
iv StrictMaybe (TxAuxData (AlonzoEra StandardCrypto))
d
    AuxData StrictMaybe (TxAuxData era)
faux -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
Alonzo.AlonzoTx TxBody (AlonzoEra StandardCrypto)
b TxWits (AlonzoEra StandardCrypto)
w IsValid
iv StrictMaybe (TxAuxData era)
faux
    Valid IsValid
iv' -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
Alonzo.AlonzoTx TxBody (AlonzoEra StandardCrypto)
b TxWits (AlonzoEra StandardCrypto)
w IsValid
iv' StrictMaybe (TxAuxData (AlonzoEra StandardCrypto))
d
updateTx wit :: Proof era
wit@Proof era
Babbage (AlonzoTx TxBody (BabbageEra StandardCrypto)
b TxWits (BabbageEra StandardCrypto)
w IsValid
iv StrictMaybe (TxAuxData (BabbageEra StandardCrypto))
d) TxField era
dt =
  case TxField era
dt of
    Body TxBody era
fbody -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx TxBody era
fbody TxWits (BabbageEra StandardCrypto)
w IsValid
iv StrictMaybe (TxAuxData (BabbageEra StandardCrypto))
d
    BodyI [TxBodyField era]
bfields -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx (forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody Proof era
wit [TxBodyField era]
bfields) TxWits (BabbageEra StandardCrypto)
w IsValid
iv StrictMaybe (TxAuxData (BabbageEra StandardCrypto))
d
    TxWits TxWits era
fwit -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx TxBody (BabbageEra StandardCrypto)
b TxWits era
fwit IsValid
iv StrictMaybe (TxAuxData (BabbageEra StandardCrypto))
d
    WitnessesI [WitnessesField era]
wfields -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx TxBody (BabbageEra StandardCrypto)
b (forall era.
Era era =>
Policy -> Proof era -> [WitnessesField era] -> TxWits era
newWitnesses Policy
override Proof era
wit [WitnessesField era]
wfields) IsValid
iv StrictMaybe (TxAuxData (BabbageEra StandardCrypto))
d
    AuxData StrictMaybe (TxAuxData era)
faux -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx TxBody (BabbageEra StandardCrypto)
b TxWits (BabbageEra StandardCrypto)
w IsValid
iv StrictMaybe (TxAuxData era)
faux
    Valid IsValid
iv' -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx TxBody (BabbageEra StandardCrypto)
b TxWits (BabbageEra StandardCrypto)
w IsValid
iv' StrictMaybe (TxAuxData (BabbageEra StandardCrypto))
d
updateTx wit :: Proof era
wit@Proof era
Conway (AlonzoTx TxBody (ConwayEra StandardCrypto)
b TxWits (ConwayEra StandardCrypto)
w IsValid
iv StrictMaybe (TxAuxData (ConwayEra StandardCrypto))
d) TxField era
dt =
  case TxField era
dt of
    Body TxBody era
fbody -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx TxBody era
fbody TxWits (ConwayEra StandardCrypto)
w IsValid
iv StrictMaybe (TxAuxData (ConwayEra StandardCrypto))
d
    BodyI [TxBodyField era]
bfields -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx (forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody Proof era
wit [TxBodyField era]
bfields) TxWits (ConwayEra StandardCrypto)
w IsValid
iv StrictMaybe (TxAuxData (ConwayEra StandardCrypto))
d
    TxWits TxWits era
fwit -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx TxBody (ConwayEra StandardCrypto)
b TxWits era
fwit IsValid
iv StrictMaybe (TxAuxData (ConwayEra StandardCrypto))
d
    WitnessesI [WitnessesField era]
wfields -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx TxBody (ConwayEra StandardCrypto)
b (forall era.
Era era =>
Policy -> Proof era -> [WitnessesField era] -> TxWits era
newWitnesses Policy
override Proof era
wit [WitnessesField era]
wfields) IsValid
iv StrictMaybe (TxAuxData (ConwayEra StandardCrypto))
d
    AuxData StrictMaybe (TxAuxData era)
faux -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx TxBody (ConwayEra StandardCrypto)
b TxWits (ConwayEra StandardCrypto)
w IsValid
iv StrictMaybe (TxAuxData era)
faux
    Valid IsValid
iv' -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx TxBody (ConwayEra StandardCrypto)
b TxWits (ConwayEra StandardCrypto)
w IsValid
iv' StrictMaybe (TxAuxData (ConwayEra StandardCrypto))
d
{-# NOINLINE updateTx #-}

newTx :: Proof era -> [TxField era] -> Tx era
newTx :: forall era. Proof era -> [TxField era] -> Tx era
newTx Proof era
era = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (forall era. Proof era -> Tx era -> TxField era -> Tx era
updateTx Proof era
era) (forall era. Proof era -> Tx era
initialTx Proof era
era)

--------------------------------------------------------------------
-- Updaters for TxBody

updateTxBody :: EraTxBody era => Proof era -> TxBody era -> TxBodyField era -> TxBody era
updateTxBody :: forall era.
EraTxBody era =>
Proof era -> TxBody era -> TxBodyField era -> TxBody era
updateTxBody Proof era
pf TxBody era
txBody TxBodyField era
dt =
  case Proof era
pf of
    Proof era
_ | Inputs Set (TxIn (EraCrypto era))
ins <- TxBodyField era
dt -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
inputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (TxIn (EraCrypto era))
ins
    Proof era
_ | Outputs StrictSeq (TxOut era)
outs <- TxBodyField era
dt -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxOut era)
outs
    Proof era
_ | Txfee Coin
fee <- TxBodyField era
dt -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
fee
    Proof era
_ | AdHash StrictMaybe (AuxiliaryDataHash (EraCrypto era))
auxDataHash <- TxBodyField era
dt -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (AuxiliaryDataHash (EraCrypto era)))
auxDataHashTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (AuxiliaryDataHash (EraCrypto era))
auxDataHash
    Proof era
Shelley -> case TxBodyField era
dt of
      Certs StrictSeq (TxCert era)
certs -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxCert era)
certs
      Withdrawals' Withdrawals (EraCrypto era)
withdrawals -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (Withdrawals (EraCrypto era))
withdrawalsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals (EraCrypto era)
withdrawals
      TTL SlotNo
ttl -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
(ShelleyEraTxBody era, ExactEra ShelleyEra era) =>
Lens' (TxBody era) SlotNo
ttlTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ SlotNo
ttl
      Update StrictMaybe (Update era)
update -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
updateTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (Update era)
update
      TxBodyField era
_ -> TxBody era
txBody
    Proof era
Allegra -> case TxBodyField era
dt of
      Certs StrictSeq (TxCert era)
certs -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxCert era)
certs
      Withdrawals' Withdrawals (EraCrypto era)
withdrawals -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (Withdrawals (EraCrypto era))
withdrawalsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals (EraCrypto era)
withdrawals
      Vldt ValidityInterval
vldt -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
vldtTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValidityInterval
vldt
      Update StrictMaybe (Update era)
update -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
updateTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (Update era)
update
      TxBodyField era
_ -> TxBody era
txBody
    Proof era
Mary -> case TxBodyField era
dt of
      Certs StrictSeq (TxCert era)
certs -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxCert era)
certs
      Withdrawals' Withdrawals (EraCrypto era)
withdrawals -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (Withdrawals (EraCrypto era))
withdrawalsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals (EraCrypto era)
withdrawals
      Vldt ValidityInterval
vldt -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
vldtTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValidityInterval
vldt
      Update StrictMaybe (Update era)
update -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
updateTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (Update era)
update
      Mint MultiAsset (EraCrypto era)
mint -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
MaryEraTxBody era =>
Lens' (TxBody era) (MultiAsset (EraCrypto era))
mintTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ MultiAsset (EraCrypto era)
mint
      TxBodyField era
_ -> TxBody era
txBody
    Proof era
Alonzo -> case TxBodyField era
dt of
      Certs StrictSeq (TxCert era)
certs -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxCert era)
certs
      Withdrawals' Withdrawals (EraCrypto era)
withdrawals -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (Withdrawals (EraCrypto era))
withdrawalsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals (EraCrypto era)
withdrawals
      Vldt ValidityInterval
vldt -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
vldtTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValidityInterval
vldt
      Update StrictMaybe (Update era)
update -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
updateTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (Update era)
update
      Mint MultiAsset (EraCrypto era)
mint -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
MaryEraTxBody era =>
Lens' (TxBody era) (MultiAsset (EraCrypto era))
mintTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ MultiAsset (EraCrypto era)
mint
      Collateral Set (TxIn (EraCrypto era))
collateral -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
collateralInputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (TxIn (EraCrypto era))
collateral
      ReqSignerHashes Set (KeyHash 'Witness (EraCrypto era))
reqSignerHashes -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (KeyHash 'Witness (EraCrypto era)))
reqSignerHashesTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (KeyHash 'Witness (EraCrypto era))
reqSignerHashes
      WppHash StrictMaybe (ScriptIntegrityHash (EraCrypto era))
scriptIntegrityHash -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (ScriptIntegrityHash (EraCrypto era)))
scriptIntegrityHashTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (ScriptIntegrityHash (EraCrypto era))
scriptIntegrityHash
      Txnetworkid StrictMaybe Network
networkId -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe Network)
networkIdTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Network
networkId
      TxBodyField era
_ -> TxBody era
txBody
    Proof era
Babbage -> case TxBodyField era
dt of
      Certs StrictSeq (TxCert era)
certs -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxCert era)
certs
      Withdrawals' Withdrawals (EraCrypto era)
withdrawals -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (Withdrawals (EraCrypto era))
withdrawalsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals (EraCrypto era)
withdrawals
      Vldt ValidityInterval
vldt -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
vldtTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValidityInterval
vldt
      Update StrictMaybe (Update era)
update -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
updateTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (Update era)
update
      Mint MultiAsset (EraCrypto era)
mint -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
MaryEraTxBody era =>
Lens' (TxBody era) (MultiAsset (EraCrypto era))
mintTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ MultiAsset (EraCrypto era)
mint
      Collateral Set (TxIn (EraCrypto era))
collateral -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
collateralInputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (TxIn (EraCrypto era))
collateral
      ReqSignerHashes Set (KeyHash 'Witness (EraCrypto era))
reqSignerHashes -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (KeyHash 'Witness (EraCrypto era)))
reqSignerHashesTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (KeyHash 'Witness (EraCrypto era))
reqSignerHashes
      WppHash StrictMaybe (ScriptIntegrityHash (EraCrypto era))
scriptIntegrityHash -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (ScriptIntegrityHash (EraCrypto era)))
scriptIntegrityHashTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (ScriptIntegrityHash (EraCrypto era))
scriptIntegrityHash
      Txnetworkid StrictMaybe Network
networkId -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe Network)
networkIdTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Network
networkId
      RefInputs Set (TxIn (EraCrypto era))
refInputs -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
referenceInputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (TxIn (EraCrypto era))
refInputs
      TotalCol StrictMaybe Coin
totalCol -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictMaybe Coin)
totalCollateralTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Coin
totalCol
      CollateralReturn StrictMaybe (TxOut era)
collateralReturn -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (TxOut era))
collateralReturnTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (TxOut era)
collateralReturn
      TxBodyField era
_ -> TxBody era
txBody
    Proof era
Conway -> case TxBodyField era
dt of
      Certs StrictSeq (TxCert era)
certs -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxCert era)
certs
      Withdrawals' Withdrawals (EraCrypto era)
withdrawals -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (Withdrawals (EraCrypto era))
withdrawalsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals (EraCrypto era)
withdrawals
      Vldt ValidityInterval
vldt -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
vldtTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValidityInterval
vldt
      Mint MultiAsset (EraCrypto era)
mint -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
MaryEraTxBody era =>
Lens' (TxBody era) (MultiAsset (EraCrypto era))
mintTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ MultiAsset (EraCrypto era)
mint
      Collateral Set (TxIn (EraCrypto era))
collateral -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
collateralInputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (TxIn (EraCrypto era))
collateral
      ReqSignerHashes Set (KeyHash 'Witness (EraCrypto era))
reqSignerHashes -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (KeyHash 'Witness (EraCrypto era)))
reqSignerHashesTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (KeyHash 'Witness (EraCrypto era))
reqSignerHashes
      WppHash StrictMaybe (ScriptIntegrityHash (EraCrypto era))
scriptIntegrityHash -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (ScriptIntegrityHash (EraCrypto era)))
scriptIntegrityHashTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (ScriptIntegrityHash (EraCrypto era))
scriptIntegrityHash
      Txnetworkid StrictMaybe Network
networkId -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe Network)
networkIdTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Network
networkId
      RefInputs Set (TxIn (EraCrypto era))
refInputs -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
referenceInputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (TxIn (EraCrypto era))
refInputs
      TotalCol StrictMaybe Coin
totalCol -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictMaybe Coin)
totalCollateralTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Coin
totalCol
      CollateralReturn StrictMaybe (TxOut era)
collateralReturn -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (TxOut era))
collateralReturnTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (TxOut era)
collateralReturn
      VotingProc VotingProcedures era
vp -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (VotingProcedures era)
votingProceduresTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ VotingProcedures era
vp
      ProposalProc OSet (ProposalProcedure era)
pp -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (OSet (ProposalProcedure era))
proposalProceduresTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ OSet (ProposalProcedure era)
pp
      TxBodyField era
_ -> TxBody era
txBody
{-# NOINLINE updateTxBody #-}

newTxBody :: EraTxBody era => Proof era -> [TxBodyField era] -> TxBody era
newTxBody :: forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody Proof era
era = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (forall era.
EraTxBody era =>
Proof era -> TxBody era -> TxBodyField era -> TxBody era
updateTxBody Proof era
era) (forall era. Era era => Proof era -> TxBody era
initialTxBody Proof era
era)

--------------------------------------------------------------------
-- Updaters for TxWits

updateWitnesses :: forall era. Policy -> Proof era -> TxWits era -> WitnessesField era -> TxWits era
updateWitnesses :: forall era.
Policy
-> Proof era -> TxWits era -> WitnessesField era -> TxWits era
updateWitnesses Policy
p Proof era
Shelley TxWits era
w WitnessesField era
dw = case WitnessesField era
dw of
  (AddrWits Set (WitVKey 'Witness (EraCrypto era))
ks) -> TxWits era
w {addrWits :: Set (WitVKey 'Witness (EraCrypto (ShelleyEra StandardCrypto)))
Shelley.addrWits = Policy
p (forall era.
EraScript era =>
ShelleyTxWits era -> Set (WitVKey 'Witness (EraCrypto era))
Shelley.addrWits TxWits era
w) Set (WitVKey 'Witness (EraCrypto era))
ks}
  (BootWits Set (BootstrapWitness (EraCrypto era))
boots) -> TxWits era
w {bootWits :: Set (BootstrapWitness (EraCrypto (ShelleyEra StandardCrypto)))
Shelley.bootWits = Policy
p (forall era.
EraScript era =>
ShelleyTxWits era -> Set (BootstrapWitness (EraCrypto era))
Shelley.bootWits TxWits era
w) Set (BootstrapWitness (EraCrypto era))
boots}
  (ScriptWits Map (ScriptHash (EraCrypto era)) (Script era)
ss) -> TxWits era
w {scriptWits :: Map
  (ScriptHash (EraCrypto (ShelleyEra StandardCrypto)))
  (Script (ShelleyEra StandardCrypto))
Shelley.scriptWits = Policy
p (forall era.
EraScript era =>
ShelleyTxWits era -> Map (ScriptHash (EraCrypto era)) (Script era)
Shelley.scriptWits TxWits era
w) Map (ScriptHash (EraCrypto era)) (Script era)
ss}
  WitnessesField era
_ -> TxWits era
w
updateWitnesses Policy
p Proof era
Allegra TxWits era
w WitnessesField era
dw = case WitnessesField era
dw of
  (AddrWits Set (WitVKey 'Witness (EraCrypto era))
ks) -> TxWits era
w {addrWits :: Set (WitVKey 'Witness (EraCrypto (AllegraEra StandardCrypto)))
Shelley.addrWits = Policy
p (forall era.
EraScript era =>
ShelleyTxWits era -> Set (WitVKey 'Witness (EraCrypto era))
Shelley.addrWits TxWits era
w) Set (WitVKey 'Witness (EraCrypto era))
ks}
  (BootWits Set (BootstrapWitness (EraCrypto era))
boots) -> TxWits era
w {bootWits :: Set (BootstrapWitness (EraCrypto (AllegraEra StandardCrypto)))
Shelley.bootWits = Policy
p (forall era.
EraScript era =>
ShelleyTxWits era -> Set (BootstrapWitness (EraCrypto era))
Shelley.bootWits TxWits era
w) Set (BootstrapWitness (EraCrypto era))
boots}
  (ScriptWits Map (ScriptHash (EraCrypto era)) (Script era)
ss) -> TxWits era
w {scriptWits :: Map
  (ScriptHash (EraCrypto (AllegraEra StandardCrypto)))
  (Script (AllegraEra StandardCrypto))
Shelley.scriptWits = Policy
p (forall era.
EraScript era =>
ShelleyTxWits era -> Map (ScriptHash (EraCrypto era)) (Script era)
Shelley.scriptWits TxWits era
w) Map (ScriptHash (EraCrypto era)) (Script era)
ss}
  WitnessesField era
_ -> TxWits era
w
updateWitnesses Policy
p Proof era
Mary TxWits era
w WitnessesField era
dw = case WitnessesField era
dw of
  (AddrWits Set (WitVKey 'Witness (EraCrypto era))
ks) -> TxWits era
w {addrWits :: Set (WitVKey 'Witness (EraCrypto (MaryEra StandardCrypto)))
Shelley.addrWits = Policy
p (forall era.
EraScript era =>
ShelleyTxWits era -> Set (WitVKey 'Witness (EraCrypto era))
Shelley.addrWits TxWits era
w) Set (WitVKey 'Witness (EraCrypto era))
ks}
  (BootWits Set (BootstrapWitness (EraCrypto era))
boots) -> TxWits era
w {bootWits :: Set (BootstrapWitness (EraCrypto (MaryEra StandardCrypto)))
Shelley.bootWits = Policy
p (forall era.
EraScript era =>
ShelleyTxWits era -> Set (BootstrapWitness (EraCrypto era))
Shelley.bootWits TxWits era
w) Set (BootstrapWitness (EraCrypto era))
boots}
  (ScriptWits Map (ScriptHash (EraCrypto era)) (Script era)
ss) -> TxWits era
w {scriptWits :: Map
  (ScriptHash (EraCrypto (MaryEra StandardCrypto)))
  (Script (MaryEra StandardCrypto))
Shelley.scriptWits = Policy
p (forall era.
EraScript era =>
ShelleyTxWits era -> Map (ScriptHash (EraCrypto era)) (Script era)
Shelley.scriptWits TxWits era
w) Map (ScriptHash (EraCrypto era)) (Script era)
ss}
  WitnessesField era
_ -> TxWits era
w
updateWitnesses Policy
p Proof era
Alonzo TxWits era
w WitnessesField era
dw = case WitnessesField era
dw of
  (AddrWits Set (WitVKey 'Witness (EraCrypto era))
ks) -> TxWits era
w {txwitsVKey :: Set (WitVKey 'Witness (EraCrypto (AlonzoEra StandardCrypto)))
txwitsVKey = Policy
p (forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Set (WitVKey 'Witness (EraCrypto era))
txwitsVKey TxWits era
w) Set (WitVKey 'Witness (EraCrypto era))
ks}
  (BootWits Set (BootstrapWitness (EraCrypto era))
boots) -> TxWits era
w {txwitsBoot :: Set (BootstrapWitness (EraCrypto (AlonzoEra StandardCrypto)))
txwitsBoot = Policy
p (forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Set (BootstrapWitness (EraCrypto era))
txwitsBoot TxWits era
w) Set (BootstrapWitness (EraCrypto era))
boots}
  (ScriptWits Map (ScriptHash (EraCrypto era)) (Script era)
ss) -> TxWits era
w {txscripts :: Map
  (ScriptHash (EraCrypto (AlonzoEra StandardCrypto)))
  (Script (AlonzoEra StandardCrypto))
txscripts = Policy
p (forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Map (ScriptHash (EraCrypto era)) (Script era)
txscripts TxWits era
w) Map (ScriptHash (EraCrypto era)) (Script era)
ss}
  (DataWits TxDats era
ds) -> TxWits era
w {txdats :: TxDats era
txdats = Policy
p (forall era. AlonzoEraScript era => AlonzoTxWits era -> TxDats era
txdats TxWits era
w) TxDats era
ds}
  (RdmrWits Redeemers era
r) -> TxWits era
w {txrdmrs :: Redeemers era
txrdmrs = Policy
p (forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Redeemers era
txrdmrs TxWits era
w) Redeemers era
r}
updateWitnesses Policy
p Proof era
Babbage TxWits era
w WitnessesField era
dw = case WitnessesField era
dw of
  (AddrWits Set (WitVKey 'Witness (EraCrypto era))
ks) -> TxWits era
w {txwitsVKey :: Set (WitVKey 'Witness (EraCrypto (BabbageEra StandardCrypto)))
txwitsVKey = Policy
p (forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Set (WitVKey 'Witness (EraCrypto era))
txwitsVKey TxWits era
w) Set (WitVKey 'Witness (EraCrypto era))
ks}
  (BootWits Set (BootstrapWitness (EraCrypto era))
boots) -> TxWits era
w {txwitsBoot :: Set (BootstrapWitness (EraCrypto (BabbageEra StandardCrypto)))
txwitsBoot = Policy
p (forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Set (BootstrapWitness (EraCrypto era))
txwitsBoot TxWits era
w) Set (BootstrapWitness (EraCrypto era))
boots}
  (ScriptWits Map (ScriptHash (EraCrypto era)) (Script era)
ss) -> TxWits era
w {txscripts :: Map
  (ScriptHash (EraCrypto (BabbageEra StandardCrypto)))
  (Script (BabbageEra StandardCrypto))
txscripts = Policy
p (forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Map (ScriptHash (EraCrypto era)) (Script era)
txscripts TxWits era
w) Map (ScriptHash (EraCrypto era)) (Script era)
ss}
  (DataWits TxDats era
ds) -> TxWits era
w {txdats :: TxDats era
txdats = Policy
p (forall era. AlonzoEraScript era => AlonzoTxWits era -> TxDats era
txdats TxWits era
w) TxDats era
ds}
  (RdmrWits Redeemers era
r) -> TxWits era
w {txrdmrs :: Redeemers era
txrdmrs = Policy
p (forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Redeemers era
txrdmrs TxWits era
w) Redeemers era
r}
updateWitnesses Policy
p Proof era
Conway TxWits era
w WitnessesField era
dw = case WitnessesField era
dw of
  (AddrWits Set (WitVKey 'Witness (EraCrypto era))
ks) -> TxWits era
w {txwitsVKey :: Set (WitVKey 'Witness (EraCrypto (ConwayEra StandardCrypto)))
txwitsVKey = Policy
p (forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Set (WitVKey 'Witness (EraCrypto era))
txwitsVKey TxWits era
w) Set (WitVKey 'Witness (EraCrypto era))
ks}
  (BootWits Set (BootstrapWitness (EraCrypto era))
boots) -> TxWits era
w {txwitsBoot :: Set (BootstrapWitness (EraCrypto (ConwayEra StandardCrypto)))
txwitsBoot = Policy
p (forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Set (BootstrapWitness (EraCrypto era))
txwitsBoot TxWits era
w) Set (BootstrapWitness (EraCrypto era))
boots}
  (ScriptWits Map (ScriptHash (EraCrypto era)) (Script era)
ss) -> TxWits era
w {txscripts :: Map
  (ScriptHash (EraCrypto (ConwayEra StandardCrypto)))
  (Script (ConwayEra StandardCrypto))
txscripts = Policy
p (forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Map (ScriptHash (EraCrypto era)) (Script era)
txscripts TxWits era
w) Map (ScriptHash (EraCrypto era)) (Script era)
ss}
  (DataWits TxDats era
ds) -> TxWits era
w {txdats :: TxDats era
txdats = Policy
p (forall era. AlonzoEraScript era => AlonzoTxWits era -> TxDats era
txdats TxWits era
w) TxDats era
ds}
  (RdmrWits Redeemers era
r) -> TxWits era
w {txrdmrs :: Redeemers era
txrdmrs = Policy
p (forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Redeemers era
txrdmrs TxWits era
w) Redeemers era
r}
{-# NOINLINE updateWitnesses #-}

newWitnesses :: Era era => Policy -> Proof era -> [WitnessesField era] -> TxWits era
newWitnesses :: forall era.
Era era =>
Policy -> Proof era -> [WitnessesField era] -> TxWits era
newWitnesses Policy
p Proof era
era = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (forall era.
Policy
-> Proof era -> TxWits era -> WitnessesField era -> TxWits era
updateWitnesses Policy
p Proof era
era) (forall era. Era era => Proof era -> TxWits era
initialWitnesses Proof era
era)

--------------------------------------------------------------------
-- Updaters for TxOut

notAddress :: TxOutField era -> Bool
notAddress :: forall era. TxOutField era -> Bool
notAddress (Address Addr (EraCrypto era)
_) = Bool
False
notAddress TxOutField era
_ = Bool
True

updateTxOut :: Proof era -> TxOut era -> TxOutField era -> TxOut era
updateTxOut :: forall era. Proof era -> TxOut era -> TxOutField era -> TxOut era
updateTxOut Proof era
Shelley (out :: TxOut era
out@(ShelleyTxOut Addr (EraCrypto (ShelleyEra StandardCrypto))
a Value (ShelleyEra StandardCrypto)
v)) TxOutField era
txoutd = case TxOutField era
txoutd of
  Address Addr (EraCrypto era)
addr -> forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr (EraCrypto era)
addr Value (ShelleyEra StandardCrypto)
v
  Amount Value era
val -> forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr (EraCrypto (ShelleyEra StandardCrypto))
a Value era
val
  TxOutField era
_ -> TxOut era
out
updateTxOut Proof era
Allegra (out :: TxOut era
out@(ShelleyTxOut Addr (EraCrypto (AllegraEra StandardCrypto))
a Value (AllegraEra StandardCrypto)
v)) TxOutField era
txoutd = case TxOutField era
txoutd of
  Address Addr (EraCrypto era)
addr -> forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr (EraCrypto era)
addr Value (AllegraEra StandardCrypto)
v
  Amount Value era
val -> forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr (EraCrypto (AllegraEra StandardCrypto))
a Value era
val
  TxOutField era
_ -> TxOut era
out
updateTxOut Proof era
Mary (out :: TxOut era
out@(ShelleyTxOut Addr (EraCrypto (MaryEra StandardCrypto))
a Value (MaryEra StandardCrypto)
v)) TxOutField era
txoutd = case TxOutField era
txoutd of
  Address Addr (EraCrypto era)
addr -> forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr (EraCrypto era)
addr Value (MaryEra StandardCrypto)
v
  Amount Value era
val -> forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr (EraCrypto (MaryEra StandardCrypto))
a Value era
val
  TxOutField era
_ -> TxOut era
out
updateTxOut Proof era
Alonzo (out :: TxOut era
out@(AlonzoTxOut Addr (EraCrypto (AlonzoEra StandardCrypto))
a Value (AlonzoEra StandardCrypto)
v StrictMaybe (DataHash (EraCrypto (AlonzoEra StandardCrypto)))
h)) TxOutField era
txoutd = case TxOutField era
txoutd of
  Address Addr (EraCrypto era)
addr -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> StrictMaybe (DataHash (EraCrypto era))
-> AlonzoTxOut era
AlonzoTxOut Addr (EraCrypto era)
addr Value (AlonzoEra StandardCrypto)
v StrictMaybe (DataHash (EraCrypto (AlonzoEra StandardCrypto)))
h
  Amount Value era
val -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> StrictMaybe (DataHash (EraCrypto era))
-> AlonzoTxOut era
AlonzoTxOut Addr (EraCrypto (AlonzoEra StandardCrypto))
a Value era
val StrictMaybe (DataHash (EraCrypto (AlonzoEra StandardCrypto)))
h
  DHash StrictMaybe (DataHash (EraCrypto era))
mdh -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> StrictMaybe (DataHash (EraCrypto era))
-> AlonzoTxOut era
AlonzoTxOut Addr (EraCrypto (AlonzoEra StandardCrypto))
a Value (AlonzoEra StandardCrypto)
v StrictMaybe (DataHash (EraCrypto era))
mdh
  FDatum Datum era
d -> forall a. HasCallStack => [Char] -> a
error ([Char]
"This feature is only available from Babbage onward " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Datum era
d)
  TxOutField era
_ -> TxOut era
out
updateTxOut Proof era
Babbage (BabbageTxOut Addr (EraCrypto (BabbageEra StandardCrypto))
a Value (BabbageEra StandardCrypto)
v Datum (BabbageEra StandardCrypto)
h StrictMaybe (Script (BabbageEra StandardCrypto))
refscript) TxOutField era
txoutd = case TxOutField era
txoutd of
  Address Addr (EraCrypto era)
addr -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr (EraCrypto era)
addr Value (BabbageEra StandardCrypto)
v Datum (BabbageEra StandardCrypto)
h StrictMaybe (Script (BabbageEra StandardCrypto))
refscript
  Amount Value era
val -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr (EraCrypto (BabbageEra StandardCrypto))
a Value era
val Datum (BabbageEra StandardCrypto)
h StrictMaybe (Script (BabbageEra StandardCrypto))
refscript
  DHash StrictMaybe (DataHash (EraCrypto era))
SNothing -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr (EraCrypto (BabbageEra StandardCrypto))
a Value (BabbageEra StandardCrypto)
v forall era. Datum era
NoDatum StrictMaybe (Script (BabbageEra StandardCrypto))
refscript
  DHash (SJust DataHash (EraCrypto era)
dh) -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr (EraCrypto (BabbageEra StandardCrypto))
a Value (BabbageEra StandardCrypto)
v (forall era. DataHash (EraCrypto era) -> Datum era
DatumHash DataHash (EraCrypto era)
dh) StrictMaybe (Script (BabbageEra StandardCrypto))
refscript
  FDatum Datum era
d -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr (EraCrypto (BabbageEra StandardCrypto))
a Value (BabbageEra StandardCrypto)
v Datum era
d StrictMaybe (Script (BabbageEra StandardCrypto))
refscript
  RefScript StrictMaybe (Script era)
s -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr (EraCrypto (BabbageEra StandardCrypto))
a Value (BabbageEra StandardCrypto)
v Datum (BabbageEra StandardCrypto)
h StrictMaybe (Script era)
s
updateTxOut Proof era
Conway (BabbageTxOut Addr (EraCrypto (ConwayEra StandardCrypto))
a Value (ConwayEra StandardCrypto)
v Datum (ConwayEra StandardCrypto)
h StrictMaybe (Script (ConwayEra StandardCrypto))
refscript) TxOutField era
txoutd = case TxOutField era
txoutd of
  Address Addr (EraCrypto era)
addr -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr (EraCrypto era)
addr Value (ConwayEra StandardCrypto)
v Datum (ConwayEra StandardCrypto)
h StrictMaybe (Script (ConwayEra StandardCrypto))
refscript
  Amount Value era
val -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr (EraCrypto (ConwayEra StandardCrypto))
a Value era
val Datum (ConwayEra StandardCrypto)
h StrictMaybe (Script (ConwayEra StandardCrypto))
refscript
  DHash StrictMaybe (DataHash (EraCrypto era))
SNothing -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr (EraCrypto (ConwayEra StandardCrypto))
a Value (ConwayEra StandardCrypto)
v forall era. Datum era
NoDatum StrictMaybe (Script (ConwayEra StandardCrypto))
refscript
  DHash (SJust DataHash (EraCrypto era)
dh) -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr (EraCrypto (ConwayEra StandardCrypto))
a Value (ConwayEra StandardCrypto)
v (forall era. DataHash (EraCrypto era) -> Datum era
DatumHash DataHash (EraCrypto era)
dh) StrictMaybe (Script (ConwayEra StandardCrypto))
refscript
  FDatum Datum era
d -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr (EraCrypto (ConwayEra StandardCrypto))
a Value (ConwayEra StandardCrypto)
v Datum era
d StrictMaybe (Script (ConwayEra StandardCrypto))
refscript
  RefScript StrictMaybe (Script era)
s -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr (EraCrypto era)
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr (EraCrypto (ConwayEra StandardCrypto))
a Value (ConwayEra StandardCrypto)
v Datum (ConwayEra StandardCrypto)
h StrictMaybe (Script era)
s
{-# NOINLINE updateTxOut #-}

newTxOut :: Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut :: forall era. Era era => Proof era -> [TxOutField era] -> TxOut era
newTxOut Proof era
_ [TxOutField era]
dts | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall era. TxOutField era -> Bool
notAddress [TxOutField era]
dts = forall a. HasCallStack => [Char] -> a
error ([Char]
"A call to newTxOut must have an (Address x) field.")
-- This is because we don't have a good story about an initial Address, so the user MUST supply one
newTxOut Proof era
era [TxOutField era]
dts = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (forall era. Proof era -> TxOut era -> TxOutField era -> TxOut era
updateTxOut Proof era
era) (forall era. Era era => Proof era -> TxOut era
initialTxOut Proof era
era) [TxOutField era]
dts

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

-- | updatePParams uses the Override policy exclusively
updatePParams :: EraPParams era => Proof era -> PParams era -> PParamsField era -> PParams era
updatePParams :: forall era.
EraPParams era =>
Proof era -> PParams era -> PParamsField era -> PParams era
updatePParams Proof era
proof PParams era
pp' PParamsField era
ppf =
  -- update all of the common fields first
  let pp :: PParams era
pp = case PParamsField era
ppf of
        MinfeeA Coin
minFeeA -> PParams era
pp' forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Coin
ppMinFeeAL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
minFeeA
        MinfeeB Coin
minFeeB -> PParams era
pp' forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Coin
ppMinFeeBL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
minFeeB
        MaxBBSize Word32
maxBBSize -> PParams era
pp' forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Word32
ppMaxBBSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
maxBBSize
        MaxTxSize Word32
maxTxSize -> PParams era
pp' forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Word32
ppMaxTxSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
maxTxSize
        MaxBHSize Word16
maxBHSize -> PParams era
pp' forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Word16
ppMaxBHSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word16
maxBHSize
        KeyDeposit Coin
keyDeposit -> PParams era
pp' forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
keyDeposit
        PoolDeposit Coin
poolDeposit -> PParams era
pp' forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Coin
ppPoolDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
poolDeposit
        EMax EpochInterval
e -> PParams era
pp' forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) EpochInterval
ppEMaxL forall s t a b. ASetter s t a b -> b -> s -> t
.~ EpochInterval
e
        NOpt Natural
nat -> PParams era
pp' forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Natural
ppNOptL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
nat
        A0 NonNegativeInterval
a0 -> PParams era
pp' forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParams era) NonNegativeInterval
ppA0L forall s t a b. ASetter s t a b -> b -> s -> t
.~ NonNegativeInterval
a0
        Rho UnitInterval
rho -> PParams era
pp' forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) UnitInterval
ppRhoL forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
rho
        Tau UnitInterval
tau -> PParams era
pp' forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) UnitInterval
ppTauL forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
tau
        ProtocolVersion ProtVer
pv -> PParams era
pp' forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL forall s t a b. ASetter s t a b -> b -> s -> t
.~ ProtVer
pv
        MinPoolCost Coin
coin -> PParams era
pp' forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Coin
ppMinPoolCostL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
coin
        PParamsField era
_ -> PParams era
pp'
   in case Proof era
proof of
        Proof era
Shelley ->
          case PParamsField era
ppf of
            D UnitInterval
d -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParams era) UnitInterval
ppDL forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
d
            ExtraEntropy Nonce
nonce -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParams era) Nonce
ppExtraEntropyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Nonce
nonce
            MinUTxOValue Coin
mu -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParams era) Coin
ppMinUTxOValueL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
mu
            PParamsField era
_ -> PParams era
pp
        Proof era
Allegra ->
          case PParamsField era
ppf of
            D UnitInterval
d -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParams era) UnitInterval
ppDL forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
d
            ExtraEntropy Nonce
nonce -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParams era) Nonce
ppExtraEntropyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Nonce
nonce
            MinUTxOValue Coin
mu -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParams era) Coin
ppMinUTxOValueL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
mu
            PParamsField era
_ -> PParams era
pp
        Proof era
Mary ->
          case PParamsField era
ppf of
            D UnitInterval
d -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParams era) UnitInterval
ppDL forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
d
            ExtraEntropy Nonce
nonce -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParams era) Nonce
ppExtraEntropyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Nonce
nonce
            MinUTxOValue Coin
mu -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParams era) Coin
ppMinUTxOValueL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
mu
            PParamsField era
_ -> PParams era
pp
        Proof era
Alonzo ->
          case PParamsField era
ppf of
            D UnitInterval
d -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParams era) UnitInterval
ppDL forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
d
            ExtraEntropy Nonce
nonce -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParams era) Nonce
ppExtraEntropyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Nonce
nonce
            CoinPerUTxOWord CoinPerWord
coinPerWord -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era.
(AlonzoEraPParams era, ExactEra AlonzoEra era) =>
Lens' (PParams era) CoinPerWord
ppCoinsPerUTxOWordL forall s t a b. ASetter s t a b -> b -> s -> t
.~ CoinPerWord
coinPerWord
            Costmdls CostModels
costModels -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
ppCostModelsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ CostModels
costModels
            Prices Prices
prices -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
ppPricesL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Prices
prices
            MaxTxExUnits ExUnits
maxTxExUnits -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
ppMaxTxExUnitsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ ExUnits
maxTxExUnits
            MaxBlockExUnits ExUnits
maxBlockExUnits -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
ppMaxBlockExUnitsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ ExUnits
maxBlockExUnits
            MaxValSize Natural
maxValSize -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
ppMaxValSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
maxValSize
            CollateralPercentage Natural
colPerc -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
ppCollateralPercentageL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
colPerc
            MaxCollateralInputs Natural
maxColInputs -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
ppMaxCollateralInputsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
maxColInputs
            PParamsField era
_ -> PParams era
pp
        Proof era
Babbage ->
          case PParamsField era
ppf of
            CoinPerUTxOByte CoinPerByte
coinPerByte -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era.
BabbageEraPParams era =>
Lens' (PParams era) CoinPerByte
ppCoinsPerUTxOByteL forall s t a b. ASetter s t a b -> b -> s -> t
.~ CoinPerByte
coinPerByte
            Costmdls CostModels
costModels -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
ppCostModelsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ CostModels
costModels
            Prices Prices
prices -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
ppPricesL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Prices
prices
            MaxTxExUnits ExUnits
maxTxExUnits -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
ppMaxTxExUnitsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ ExUnits
maxTxExUnits
            MaxBlockExUnits ExUnits
maxBlockExUnits -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
ppMaxBlockExUnitsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ ExUnits
maxBlockExUnits
            MaxValSize Natural
maxValSize -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
ppMaxValSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
maxValSize
            CollateralPercentage Natural
colPerc -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
ppCollateralPercentageL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
colPerc
            MaxCollateralInputs Natural
maxColInputs -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
ppMaxCollateralInputsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
maxColInputs
            PParamsField era
_ -> PParams era
pp
        Proof era
Conway ->
          case PParamsField era
ppf of
            CoinPerUTxOByte CoinPerByte
coinPerByte -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era.
BabbageEraPParams era =>
Lens' (PParams era) CoinPerByte
ppCoinsPerUTxOByteL forall s t a b. ASetter s t a b -> b -> s -> t
.~ CoinPerByte
coinPerByte
            Costmdls CostModels
costModels -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
ppCostModelsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ CostModels
costModels
            Prices Prices
prices -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
ppPricesL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Prices
prices
            MaxTxExUnits ExUnits
maxTxExUnits -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
ppMaxTxExUnitsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ ExUnits
maxTxExUnits
            MaxBlockExUnits ExUnits
maxBlockExUnits -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
ppMaxBlockExUnitsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ ExUnits
maxBlockExUnits
            MaxValSize Natural
maxValSize -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
ppMaxValSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
maxValSize
            CollateralPercentage Natural
colPerc -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
ppCollateralPercentageL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
colPerc
            MaxCollateralInputs Natural
maxColInputs -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
ppMaxCollateralInputsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
maxColInputs
            GovActionDeposit Coin
c -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
c
            DRepDeposit Coin
c -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppDRepDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
c
            DRepActivity EpochInterval
c -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppDRepActivityL forall s t a b. ASetter s t a b -> b -> s -> t
.~ EpochInterval
c
            PoolVotingThreshold PoolVotingThresholds
c -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ PoolVotingThresholds
c
            DRepVotingThreshold DRepVotingThresholds
c -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ DRepVotingThresholds
c
            MinCommitteeSize Natural
c -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era. ConwayEraPParams era => Lens' (PParams era) Natural
ppCommitteeMinSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
c
            CommitteeTermLimit EpochInterval
c -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppCommitteeMaxTermLengthL forall s t a b. ASetter s t a b -> b -> s -> t
.~ EpochInterval
c
            GovActionExpiration EpochInterval
c -> PParams era
pp forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ EpochInterval
c
            PParamsField era
_ -> PParams era
pp

newPParams :: EraPParams era => Proof era -> [PParamsField era] -> PParams era
newPParams :: forall era.
EraPParams era =>
Proof era -> [PParamsField era] -> PParams era
newPParams Proof era
era = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (forall era.
EraPParams era =>
Proof era -> PParams era -> PParamsField era -> PParams era
updatePParams Proof era
era) forall era. EraPParams era => PParams era
emptyPParams

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

-- | This only make sense in the Alonzo era and forward, all other Eras return Nothing
newScriptIntegrityHash ::
  Proof era ->
  PParams era ->
  [Language] ->
  Redeemers era ->
  TxDats era ->
  StrictMaybe (Alonzo.ScriptIntegrityHash (EraCrypto era))
newScriptIntegrityHash :: forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
newScriptIntegrityHash Proof era
Conway PParams era
pp [Language]
ls Redeemers era
rds TxDats era
dats =
  forall era.
AlonzoEraScript era =>
Set LangDepView
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
hashScriptIntegrity (forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (forall era.
AlonzoEraPParams era =>
PParams era -> Language -> LangDepView
Alonzo.getLanguageView PParams era
pp) (forall a. Ord a => [a] -> Set a
Set.fromList [Language]
ls)) Redeemers era
rds TxDats era
dats
newScriptIntegrityHash Proof era
Babbage PParams era
pp [Language]
ls Redeemers era
rds TxDats era
dats =
  forall era.
AlonzoEraScript era =>
Set LangDepView
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
hashScriptIntegrity (forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (forall era.
AlonzoEraPParams era =>
PParams era -> Language -> LangDepView
Alonzo.getLanguageView PParams era
pp) (forall a. Ord a => [a] -> Set a
Set.fromList [Language]
ls)) Redeemers era
rds TxDats era
dats
newScriptIntegrityHash Proof era
Alonzo PParams era
pp [Language]
ls Redeemers era
rds TxDats era
dats =
  forall era.
AlonzoEraScript era =>
Set LangDepView
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
hashScriptIntegrity (forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (forall era.
AlonzoEraPParams era =>
PParams era -> Language -> LangDepView
Alonzo.getLanguageView PParams era
pp) (forall a. Ord a => [a] -> Set a
Set.fromList [Language]
ls)) Redeemers era
rds TxDats era
dats
newScriptIntegrityHash Proof era
_wit PParams era
_pp [Language]
_ls Redeemers era
_rds TxDats era
_dats = forall a. StrictMaybe a
SNothing

defaultCostModels :: Proof era -> PParamsField era
defaultCostModels :: forall era. Proof era -> PParamsField era
defaultCostModels Proof era
Shelley = forall era. CostModels -> PParamsField era
Costmdls CostModels
emptyCostModels
defaultCostModels Proof era
Allegra = forall era. CostModels -> PParamsField era
Costmdls CostModels
emptyCostModels
defaultCostModels Proof era
Mary = forall era. CostModels -> PParamsField era
Costmdls CostModels
emptyCostModels
defaultCostModels Proof era
Alonzo = forall era. CostModels -> PParamsField era
Costmdls forall a b. (a -> b) -> a -> b
$ HasCallStack => [Language] -> CostModels
zeroTestingCostModels [Language
PlutusV1]
defaultCostModels Proof era
Babbage = forall era. CostModels -> PParamsField era
Costmdls forall a b. (a -> b) -> a -> b
$ HasCallStack => [Language] -> CostModels
zeroTestingCostModels [Language
PlutusV1, Language
PlutusV2]
defaultCostModels Proof era
Conway = forall era. CostModels -> PParamsField era
Costmdls forall a b. (a -> b) -> a -> b
$ HasCallStack => [Language] -> CostModels
zeroTestingCostModels [Language
PlutusV1, Language
PlutusV2]

languages :: Proof era -> [Language]
languages :: forall era. Proof era -> [Language]
languages Proof era
Shelley = []
languages Proof era
Allegra = []
languages Proof era
Mary = []
languages Proof era
Alonzo = [Language
PlutusV1]
languages Proof era
Babbage = [Language
PlutusV1, Language
PlutusV2]
languages Proof era
Conway = [Language
PlutusV1, Language
PlutusV2]