{-# 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 (Data era)
x) (TxDats Map DataHash (Data era)
y) = forall era. Era era => Map DataHash (Data era) -> TxDats era
TxDats (forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map DataHash (Data era)
x Map DataHash (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 v) where
  merge :: Map ScriptHash v -> Map ScriptHash v -> Map ScriptHash 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
b TxWits ShelleyEra
w StrictMaybe (TxAuxData ShelleyEra)
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
w StrictMaybe (TxAuxData ShelleyEra)
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
w StrictMaybe (TxAuxData ShelleyEra)
d
    TxWits TxWits era
fwit -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody ShelleyEra
b TxWits era
fwit StrictMaybe (TxAuxData ShelleyEra)
d
    WitnessesI [WitnessesField era]
wfields -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody ShelleyEra
b (forall era.
Policy -> Proof era -> [WitnessesField era] -> TxWits era
newWitnesses Policy
override Proof era
wit [WitnessesField era]
wfields) StrictMaybe (TxAuxData ShelleyEra)
d
    AuxData StrictMaybe (TxAuxData era)
faux -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody ShelleyEra
b TxWits ShelleyEra
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
b TxWits AllegraEra
w StrictMaybe (TxAuxData AllegraEra)
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
w StrictMaybe (TxAuxData AllegraEra)
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
w StrictMaybe (TxAuxData AllegraEra)
d
    TxWits TxWits era
fwit -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody AllegraEra
b TxWits era
fwit StrictMaybe (TxAuxData AllegraEra)
d
    WitnessesI [WitnessesField era]
wfields -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody AllegraEra
b (forall era.
Policy -> Proof era -> [WitnessesField era] -> TxWits era
newWitnesses Policy
override Proof era
wit [WitnessesField era]
wfields) StrictMaybe (TxAuxData AllegraEra)
d
    AuxData StrictMaybe (TxAuxData era)
faux -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody AllegraEra
b TxWits AllegraEra
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
b TxWits MaryEra
w StrictMaybe (TxAuxData MaryEra)
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
w StrictMaybe (TxAuxData MaryEra)
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
w StrictMaybe (TxAuxData MaryEra)
d
    TxWits TxWits era
fwit -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody MaryEra
b TxWits era
fwit StrictMaybe (TxAuxData MaryEra)
d
    WitnessesI [WitnessesField era]
wfields -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody MaryEra
b (forall era.
Policy -> Proof era -> [WitnessesField era] -> TxWits era
newWitnesses Policy
override Proof era
wit [WitnessesField era]
wfields) StrictMaybe (TxAuxData MaryEra)
d
    AuxData StrictMaybe (TxAuxData era)
faux -> forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody MaryEra
b TxWits MaryEra
w StrictMaybe (TxAuxData era)
faux
    Valid IsValid
_ -> Tx era
tx
updateTx wit :: Proof era
wit@Proof era
Alonzo (Alonzo.AlonzoTx TxBody AlonzoEra
b TxWits AlonzoEra
w IsValid
iv StrictMaybe (TxAuxData AlonzoEra)
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
w IsValid
iv StrictMaybe (TxAuxData AlonzoEra)
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
w IsValid
iv StrictMaybe (TxAuxData AlonzoEra)
d
    TxWits TxWits era
fwit -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
Alonzo.AlonzoTx TxBody AlonzoEra
b TxWits era
fwit IsValid
iv StrictMaybe (TxAuxData AlonzoEra)
d
    WitnessesI [WitnessesField era]
wfields -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
Alonzo.AlonzoTx TxBody AlonzoEra
b (forall era.
Policy -> Proof era -> [WitnessesField era] -> TxWits era
newWitnesses Policy
override Proof era
wit [WitnessesField era]
wfields) IsValid
iv StrictMaybe (TxAuxData AlonzoEra)
d
    AuxData StrictMaybe (TxAuxData era)
faux -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
Alonzo.AlonzoTx TxBody AlonzoEra
b TxWits AlonzoEra
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
b TxWits AlonzoEra
w IsValid
iv' StrictMaybe (TxAuxData AlonzoEra)
d
updateTx wit :: Proof era
wit@Proof era
Babbage (AlonzoTx TxBody BabbageEra
b TxWits BabbageEra
w IsValid
iv StrictMaybe (TxAuxData BabbageEra)
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
w IsValid
iv StrictMaybe (TxAuxData BabbageEra)
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
w IsValid
iv StrictMaybe (TxAuxData BabbageEra)
d
    TxWits TxWits era
fwit -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx TxBody BabbageEra
b TxWits era
fwit IsValid
iv StrictMaybe (TxAuxData BabbageEra)
d
    WitnessesI [WitnessesField era]
wfields -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx TxBody BabbageEra
b (forall era.
Policy -> Proof era -> [WitnessesField era] -> TxWits era
newWitnesses Policy
override Proof era
wit [WitnessesField era]
wfields) IsValid
iv StrictMaybe (TxAuxData BabbageEra)
d
    AuxData StrictMaybe (TxAuxData era)
faux -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx TxBody BabbageEra
b TxWits BabbageEra
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
b TxWits BabbageEra
w IsValid
iv' StrictMaybe (TxAuxData BabbageEra)
d
updateTx wit :: Proof era
wit@Proof era
Conway (AlonzoTx TxBody ConwayEra
b TxWits ConwayEra
w IsValid
iv StrictMaybe (TxAuxData ConwayEra)
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
w IsValid
iv StrictMaybe (TxAuxData ConwayEra)
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
w IsValid
iv StrictMaybe (TxAuxData ConwayEra)
d
    TxWits TxWits era
fwit -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx TxBody ConwayEra
b TxWits era
fwit IsValid
iv StrictMaybe (TxAuxData ConwayEra)
d
    WitnessesI [WitnessesField era]
wfields -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx TxBody ConwayEra
b (forall era.
Policy -> Proof era -> [WitnessesField era] -> TxWits era
newWitnesses Policy
override Proof era
wit [WitnessesField era]
wfields) IsValid
iv StrictMaybe (TxAuxData ConwayEra)
d
    AuxData StrictMaybe (TxAuxData era)
faux -> forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx TxBody ConwayEra
b TxWits ConwayEra
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
b TxWits ConwayEra
w IsValid
iv' StrictMaybe (TxAuxData ConwayEra)
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
ins <- TxBodyField era
dt -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
inputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
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 TxAuxDataHash
auxDataHash <- TxBodyField era
dt -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictMaybe TxAuxDataHash)
auxDataHashTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe TxAuxDataHash
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
withdrawals -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals
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
withdrawals -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals
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
withdrawals -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals
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
mint -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era. MaryEraTxBody era => Lens' (TxBody era) MultiAsset
mintTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ MultiAsset
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
withdrawals -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals
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
mint -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era. MaryEraTxBody era => Lens' (TxBody era) MultiAsset
mintTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ MultiAsset
mint
      Collateral Set TxIn
collateral -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
collateralInputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
collateral
      ReqSignerHashes Set (KeyHash 'Witness)
reqSignerHashes -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (KeyHash 'Witness))
reqSignerHashesTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (KeyHash 'Witness)
reqSignerHashes
      WppHash StrictMaybe ScriptIntegrityHash
scriptIntegrityHash -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
scriptIntegrityHashTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe ScriptIntegrityHash
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
withdrawals -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals
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
mint -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era. MaryEraTxBody era => Lens' (TxBody era) MultiAsset
mintTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ MultiAsset
mint
      Collateral Set TxIn
collateral -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
collateralInputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
collateral
      ReqSignerHashes Set (KeyHash 'Witness)
reqSignerHashes -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (KeyHash 'Witness))
reqSignerHashesTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (KeyHash 'Witness)
reqSignerHashes
      WppHash StrictMaybe ScriptIntegrityHash
scriptIntegrityHash -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
scriptIntegrityHashTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe ScriptIntegrityHash
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
refInputs -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
referenceInputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
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
withdrawals -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals
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
mint -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era. MaryEraTxBody era => Lens' (TxBody era) MultiAsset
mintTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ MultiAsset
mint
      Collateral Set TxIn
collateral -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
collateralInputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
collateral
      ReqSignerHashes Set (KeyHash 'Witness)
reqSignerHashes -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (KeyHash 'Witness))
reqSignerHashesTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (KeyHash 'Witness)
reqSignerHashes
      WppHash StrictMaybe ScriptIntegrityHash
scriptIntegrityHash -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
scriptIntegrityHashTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe ScriptIntegrityHash
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
refInputs -> TxBody era
txBody forall a b. a -> (a -> b) -> b
& forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
referenceInputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
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. 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)
ks) -> TxWits era
w {addrWits :: Set (WitVKey 'Witness)
Shelley.addrWits = Policy
p (forall era.
EraScript era =>
ShelleyTxWits era -> Set (WitVKey 'Witness)
Shelley.addrWits TxWits era
w) Set (WitVKey 'Witness)
ks}
  (BootWits Set BootstrapWitness
boots) -> TxWits era
w {bootWits :: Set BootstrapWitness
Shelley.bootWits = Policy
p (forall era.
EraScript era =>
ShelleyTxWits era -> Set BootstrapWitness
Shelley.bootWits TxWits era
w) Set BootstrapWitness
boots}
  (ScriptWits Map ScriptHash (Script era)
ss) -> TxWits era
w {scriptWits :: Map ScriptHash (Script ShelleyEra)
Shelley.scriptWits = Policy
p (forall era.
EraScript era =>
ShelleyTxWits era -> Map ScriptHash (Script era)
Shelley.scriptWits TxWits era
w) Map ScriptHash (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)
ks) -> TxWits era
w {addrWits :: Set (WitVKey 'Witness)
Shelley.addrWits = Policy
p (forall era.
EraScript era =>
ShelleyTxWits era -> Set (WitVKey 'Witness)
Shelley.addrWits TxWits era
w) Set (WitVKey 'Witness)
ks}
  (BootWits Set BootstrapWitness
boots) -> TxWits era
w {bootWits :: Set BootstrapWitness
Shelley.bootWits = Policy
p (forall era.
EraScript era =>
ShelleyTxWits era -> Set BootstrapWitness
Shelley.bootWits TxWits era
w) Set BootstrapWitness
boots}
  (ScriptWits Map ScriptHash (Script era)
ss) -> TxWits era
w {scriptWits :: Map ScriptHash (Script AllegraEra)
Shelley.scriptWits = Policy
p (forall era.
EraScript era =>
ShelleyTxWits era -> Map ScriptHash (Script era)
Shelley.scriptWits TxWits era
w) Map ScriptHash (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)
ks) -> TxWits era
w {addrWits :: Set (WitVKey 'Witness)
Shelley.addrWits = Policy
p (forall era.
EraScript era =>
ShelleyTxWits era -> Set (WitVKey 'Witness)
Shelley.addrWits TxWits era
w) Set (WitVKey 'Witness)
ks}
  (BootWits Set BootstrapWitness
boots) -> TxWits era
w {bootWits :: Set BootstrapWitness
Shelley.bootWits = Policy
p (forall era.
EraScript era =>
ShelleyTxWits era -> Set BootstrapWitness
Shelley.bootWits TxWits era
w) Set BootstrapWitness
boots}
  (ScriptWits Map ScriptHash (Script era)
ss) -> TxWits era
w {scriptWits :: Map ScriptHash (Script MaryEra)
Shelley.scriptWits = Policy
p (forall era.
EraScript era =>
ShelleyTxWits era -> Map ScriptHash (Script era)
Shelley.scriptWits TxWits era
w) Map ScriptHash (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)
ks) -> TxWits era
w {txwitsVKey :: Set (WitVKey 'Witness)
txwitsVKey = Policy
p (forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Set (WitVKey 'Witness)
txwitsVKey TxWits era
w) Set (WitVKey 'Witness)
ks}
  (BootWits Set BootstrapWitness
boots) -> TxWits era
w {txwitsBoot :: Set BootstrapWitness
txwitsBoot = Policy
p (forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Set BootstrapWitness
txwitsBoot TxWits era
w) Set BootstrapWitness
boots}
  (ScriptWits Map ScriptHash (Script era)
ss) -> TxWits era
w {txscripts :: Map ScriptHash (Script AlonzoEra)
txscripts = Policy
p (forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Map ScriptHash (Script era)
txscripts TxWits era
w) Map ScriptHash (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)
ks) -> TxWits era
w {txwitsVKey :: Set (WitVKey 'Witness)
txwitsVKey = Policy
p (forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Set (WitVKey 'Witness)
txwitsVKey TxWits era
w) Set (WitVKey 'Witness)
ks}
  (BootWits Set BootstrapWitness
boots) -> TxWits era
w {txwitsBoot :: Set BootstrapWitness
txwitsBoot = Policy
p (forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Set BootstrapWitness
txwitsBoot TxWits era
w) Set BootstrapWitness
boots}
  (ScriptWits Map ScriptHash (Script era)
ss) -> TxWits era
w {txscripts :: Map ScriptHash (Script BabbageEra)
txscripts = Policy
p (forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Map ScriptHash (Script era)
txscripts TxWits era
w) Map ScriptHash (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)
ks) -> TxWits era
w {txwitsVKey :: Set (WitVKey 'Witness)
txwitsVKey = Policy
p (forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Set (WitVKey 'Witness)
txwitsVKey TxWits era
w) Set (WitVKey 'Witness)
ks}
  (BootWits Set BootstrapWitness
boots) -> TxWits era
w {txwitsBoot :: Set BootstrapWitness
txwitsBoot = Policy
p (forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Set BootstrapWitness
txwitsBoot TxWits era
w) Set BootstrapWitness
boots}
  (ScriptWits Map ScriptHash (Script era)
ss) -> TxWits era
w {txscripts :: Map ScriptHash (Script ConwayEra)
txscripts = Policy
p (forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Map ScriptHash (Script era)
txscripts TxWits era
w) Map ScriptHash (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 :: Policy -> Proof era -> [WitnessesField era] -> TxWits era
newWitnesses :: forall 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. Proof era -> TxWits era
initialWitnesses Proof era
era)

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

notAddress :: TxOutField era -> Bool
notAddress :: forall era. TxOutField era -> Bool
notAddress (Address Addr
_) = 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
a Value ShelleyEra
v)) TxOutField era
txoutd = case TxOutField era
txoutd of
  Address Addr
addr -> forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
addr Value ShelleyEra
v
  Amount Value era
val -> forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
a Value era
val
  TxOutField era
_ -> TxOut era
out
updateTxOut Proof era
Allegra (out :: TxOut era
out@(ShelleyTxOut Addr
a Value AllegraEra
v)) TxOutField era
txoutd = case TxOutField era
txoutd of
  Address Addr
addr -> forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
addr Value AllegraEra
v
  Amount Value era
val -> forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
a Value era
val
  TxOutField era
_ -> TxOut era
out
updateTxOut Proof era
Mary (out :: TxOut era
out@(ShelleyTxOut Addr
a Value MaryEra
v)) TxOutField era
txoutd = case TxOutField era
txoutd of
  Address Addr
addr -> forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
addr Value MaryEra
v
  Amount Value era
val -> forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
ShelleyTxOut Addr
a Value era
val
  TxOutField era
_ -> TxOut era
out
updateTxOut Proof era
Alonzo (out :: TxOut era
out@(AlonzoTxOut Addr
a Value AlonzoEra
v StrictMaybe DataHash
h)) TxOutField era
txoutd = case TxOutField era
txoutd of
  Address Addr
addr -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr -> Value era -> StrictMaybe DataHash -> AlonzoTxOut era
AlonzoTxOut Addr
addr Value AlonzoEra
v StrictMaybe DataHash
h
  Amount Value era
val -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr -> Value era -> StrictMaybe DataHash -> AlonzoTxOut era
AlonzoTxOut Addr
a Value era
val StrictMaybe DataHash
h
  DHash StrictMaybe DataHash
mdh -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr -> Value era -> StrictMaybe DataHash -> AlonzoTxOut era
AlonzoTxOut Addr
a Value AlonzoEra
v StrictMaybe DataHash
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
a Value BabbageEra
v Datum BabbageEra
h StrictMaybe (Script BabbageEra)
refscript) TxOutField era
txoutd = case TxOutField era
txoutd of
  Address Addr
addr -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
addr Value BabbageEra
v Datum BabbageEra
h StrictMaybe (Script BabbageEra)
refscript
  Amount Value era
val -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
a Value era
val Datum BabbageEra
h StrictMaybe (Script BabbageEra)
refscript
  DHash StrictMaybe DataHash
SNothing -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
a Value BabbageEra
v forall era. Datum era
NoDatum StrictMaybe (Script BabbageEra)
refscript
  DHash (SJust DataHash
dh) -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
a Value BabbageEra
v (forall era. DataHash -> Datum era
DatumHash DataHash
dh) StrictMaybe (Script BabbageEra)
refscript
  FDatum Datum era
d -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
a Value BabbageEra
v Datum era
d StrictMaybe (Script BabbageEra)
refscript
  RefScript StrictMaybe (Script era)
s -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
a Value BabbageEra
v Datum BabbageEra
h StrictMaybe (Script era)
s
updateTxOut Proof era
Conway (BabbageTxOut Addr
a Value ConwayEra
v Datum ConwayEra
h StrictMaybe (Script ConwayEra)
refscript) TxOutField era
txoutd = case TxOutField era
txoutd of
  Address Addr
addr -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
addr Value ConwayEra
v Datum ConwayEra
h StrictMaybe (Script ConwayEra)
refscript
  Amount Value era
val -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
a Value era
val Datum ConwayEra
h StrictMaybe (Script ConwayEra)
refscript
  DHash StrictMaybe DataHash
SNothing -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
a Value ConwayEra
v forall era. Datum era
NoDatum StrictMaybe (Script ConwayEra)
refscript
  DHash (SJust DataHash
dh) -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
a Value ConwayEra
v (forall era. DataHash -> Datum era
DatumHash DataHash
dh) StrictMaybe (Script ConwayEra)
refscript
  FDatum Datum era
d -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
a Value ConwayEra
v Datum era
d StrictMaybe (Script ConwayEra)
refscript
  RefScript StrictMaybe (Script era)
s -> forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
a Value ConwayEra
v Datum ConwayEra
h StrictMaybe (Script era)
s
{-# NOINLINE updateTxOut #-}

newTxOut :: Proof era -> [TxOutField era] -> TxOut era
newTxOut :: forall 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. 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 Word16
nat -> PParams era
pp' forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Word16
ppNOptL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word16
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
newScriptIntegrityHash :: forall era.
Proof era
-> PParams era
-> [Language]
-> Redeemers era
-> TxDats era
-> StrictMaybe ScriptIntegrityHash
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
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
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
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]