{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}

module Test.Cardano.Ledger.Generic.Fields (
  TxField (.., AuxData', Valid'),
  TxBodyField (
    ..,
    Inputs',
    Collateral',
    RefInputs',
    Outputs',
    Certs',
    CollateralReturn',
    Update',
    ReqSignerHashes',
    WppHash',
    AdHash',
    Txnetworkid'
  ),
  WitnessesField (.., AddrWits', BootWits', ScriptWits', DataWits'),
  PParamsField (..),
  TxOutField (.., DHash', RefScript'),
  initVI,
  initWithdrawals,
  initialTxBody,
  initialWitnesses,
  initialTx,
  initialTxOut,
  valid,
  abstractTx,
  abstractTxBody,
  abstractTxOut,
  abstractWitnesses,
  abstractPParams,
)
where

import Cardano.Ledger.Address (Addr (..))
import Cardano.Ledger.Allegra.TxBody (AllegraTxBody (..))
import Cardano.Ledger.Alonzo.PParams (AlonzoPParams (..), unOrdExUnits)
import Cardano.Ledger.Alonzo.Scripts (CostModels, ExUnits (..), Prices)
import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..), IsValid (..))
import Cardano.Ledger.Alonzo.TxAuxData (AuxiliaryDataHash)
import Cardano.Ledger.Alonzo.TxBody (AlonzoTxBody (..), AlonzoTxOut (..))
import Cardano.Ledger.Alonzo.TxWits (AlonzoTxWits (..), Redeemers (..), TxDats (..))
import Cardano.Ledger.Babbage.PParams (BabbagePParams (..))
import Cardano.Ledger.Babbage.TxBody (BabbageTxBody (..), BabbageTxOut (..))
import Cardano.Ledger.BaseTypes (
  EpochInterval (..),
  Network (..),
  NonNegativeInterval,
  Nonce,
  ProtVer (..),
  StrictMaybe (..),
  UnitInterval,
 )
import Cardano.Ledger.Binary (sizedValue)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Governance (ProposalProcedure, VotingProcedures)
import Cardano.Ledger.Conway.PParams (ConwayPParams (..))
import Cardano.Ledger.Conway.TxBody (ConwayTxBody (..))
import Cardano.Ledger.Credential (Credential (..), StakeReference (..))
import Cardano.Ledger.Keys (KeyHash, KeyRole (..), WitVKey (..), hashKey)
import Cardano.Ledger.Keys.Bootstrap (BootstrapWitness (..))
import Cardano.Ledger.Mary.TxBody (MaryTxBody (..))
import Cardano.Ledger.Mary.Value (MultiAsset (..))
import Cardano.Ledger.Plutus.Data (Data (..), Datum (..), hashData)
import Cardano.Ledger.Shelley.PParams (ShelleyPParams (..))
import qualified Cardano.Ledger.Shelley.PParams as PP (Update)
import Cardano.Ledger.Shelley.Tx (ShelleyTx (..))
import Cardano.Ledger.Shelley.TxBody (ShelleyTxBody (..))
import Cardano.Ledger.Shelley.TxOut (ShelleyTxOut (..))
import Cardano.Ledger.Shelley.TxWits (pattern ShelleyTxWits)
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.Slotting.Slot (SlotNo (..))
import Data.Map (Map)
import qualified Data.Map.Strict as Map
import qualified Data.OSet.Strict as OSet
import Data.Sequence.Strict (StrictSeq (..))
import qualified Data.Sequence.Strict as SSeq (fromList)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Word (Word16, Word32)
import Lens.Micro ((^.))
import Numeric.Natural (Natural)
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..))
import Test.Cardano.Ledger.Generic.Indexed (theKeyPair)
import Test.Cardano.Ledger.Generic.Proof

-- =======================================================
-- Fields are used to hold a single field of record. So the Field
-- data type (Core.T era) holds the union of all fields of (Core.T era)
-- across all eras Shelley, Allegra, Mary, Alonzo, Babbage.
-- Pattern constructors (with primed names, like C') allow users to use [a], to stand
-- for (Set a) (Maybe a) (StrictSeq a) (StrictMaybe a) (Map (hash a) a)
-- and hide the conversion details from the user. This is very convenient when
-- using Fields to construct (Core.Txx era) by hand in an era agnostic way.

data TxField era
  = Body (TxBody era)
  | BodyI [TxBodyField era] -- Inlines TxBody Fields
  | TxWits (TxWits era)
  | WitnessesI [WitnessesField era] -- Inlines Witnesess Fields
  | AuxData (StrictMaybe (TxAuxData era))
  | Valid IsValid

pattern AuxData' :: [TxAuxData era] -> TxField era

pattern Valid' :: Bool -> TxField era

-- =================
data TxBodyField era
  = Inputs (Set (TxIn (EraCrypto era)))
  | Collateral (Set (TxIn (EraCrypto era)))
  | RefInputs (Set (TxIn (EraCrypto era)))
  | Outputs (StrictSeq (TxOut era))
  | CollateralReturn (StrictMaybe (TxOut era))
  | TotalCol (StrictMaybe Coin)
  | Certs (StrictSeq (TxCert era))
  | Withdrawals' (Withdrawals (EraCrypto era))
  | Txfee Coin
  | Vldt ValidityInterval
  | TTL SlotNo
  | Update (StrictMaybe (PP.Update era))
  | ReqSignerHashes (Set (KeyHash 'Witness (EraCrypto era)))
  | Mint (MultiAsset (EraCrypto era))
  | WppHash (StrictMaybe (ScriptIntegrityHash (EraCrypto era)))
  | AdHash (StrictMaybe (AuxiliaryDataHash (EraCrypto era)))
  | Txnetworkid (StrictMaybe Network)
  | ProposalProc (OSet.OSet (ProposalProcedure era))
  | VotingProc (VotingProcedures era)
  | CurrentTreasuryValue (StrictMaybe Coin)
  | TreasuryDonation Coin

pattern Inputs' :: [TxIn (EraCrypto era)] -> TxBodyField era -- Set

pattern Collateral' :: [TxIn (EraCrypto era)] -> TxBodyField era -- Set

pattern RefInputs' :: [TxIn (EraCrypto era)] -> TxBodyField era -- Set

pattern Outputs' :: [TxOut era] -> TxBodyField era -- StrictSeq

pattern Certs' :: [TxCert era] -> TxBodyField era -- StrictSeq

pattern CollateralReturn' :: [TxOut era] -> TxBodyField era -- 0 or 1 element

pattern Update' :: [PP.Update era] -> TxBodyField era -- 0 or 1 element

pattern ReqSignerHashes' :: [KeyHash 'Witness (EraCrypto era)] -> TxBodyField era -- A set

pattern WppHash' :: [ScriptIntegrityHash (EraCrypto era)] -> TxBodyField era -- 0 or 1 element

pattern AdHash' :: [AuxiliaryDataHash (EraCrypto era)] -> TxBodyField era -- 0 or 1 element

pattern Txnetworkid' :: [Network] -> TxBodyField era -- 0 or 1 element

-- ====================
data WitnessesField era
  = AddrWits (Set (WitVKey 'Witness (EraCrypto era)))
  | BootWits (Set (BootstrapWitness (EraCrypto era)))
  | ScriptWits (Map (ScriptHash (EraCrypto era)) (Script era))
  | DataWits (TxDats era)
  | RdmrWits (Redeemers era)

pattern AddrWits' :: Era era => [WitVKey 'Witness (EraCrypto era)] -> WitnessesField era -- Set

pattern BootWits' :: Era era => [BootstrapWitness (EraCrypto era)] -> WitnessesField era -- Set

pattern ScriptWits' :: forall era. EraScript era => [Script era] -> WitnessesField era -- Map

pattern DataWits' :: Era era => [Data era] -> WitnessesField era -- Map

-- ================
data TxOutField era
  = Address (Addr (EraCrypto era))
  | Amount (Value era)
  | DHash (StrictMaybe (DataHash (EraCrypto era)))
  | FDatum (Datum era)
  | RefScript (StrictMaybe (Script era))

pattern DHash' :: [DataHash (EraCrypto era)] -> TxOutField era -- 0 or 1 element

pattern RefScript' :: [Script era] -> TxOutField era -- 0 or 1 element

-- ================================================================
-- PParam Fields

data PParamsField era
  = MinfeeA Coin
  | -- | The constant factor for the minimum fee calculation
    MinfeeB Coin
  | -- | Maximal block body size
    MaxBBSize Word32
  | -- | Maximal transaction size
    MaxTxSize Word32
  | -- | Maximal block header size
    MaxBHSize Word16
  | -- | The amount of a key registration deposit
    KeyDeposit Coin
  | -- | The amount of a pool registration deposit
    PoolDeposit Coin
  | -- | epoch bound on pool retirement
    EMax EpochInterval
  | -- | Desired number of pools
    NOpt Natural
  | -- | Pool influence
    A0 NonNegativeInterval
  | -- | Monetary expansion
    Rho UnitInterval
  | -- | Treasury expansion
    Tau UnitInterval
  | -- | Decentralization parameter
    D UnitInterval -- Dropped in Babbage
  | -- | Extra entropy
    ExtraEntropy Nonce -- Dropped in Babbage
  | -- | Protocol version
    ProtocolVersion ProtVer
  | -- | Minimum Stake Pool Cost
    MinPoolCost Coin
  | -- | Minimum Lovelace in a UTxO deprecated by AdaPerUTxOWord
    MinUTxOValue Coin
  | -- | Cost in ada per 8 bytes of UTxO storage instead of _minUTxOValue
    CoinPerUTxOWord CoinPerWord -- Dropped in Babbage
  | -- | Cost in ada per 1 byte of UTxO storage instead of _coinsPerUTxOWord
    CoinPerUTxOByte CoinPerByte -- New in Babbage
  | -- | Cost models for non-native script languages
    Costmdls CostModels
  | -- | Prices of execution units for non-native script languages
    Prices Prices
  | -- | Max total script execution resources units allowed per tx
    MaxTxExUnits ExUnits
  | -- | Max total script execution resources units allowed per block
    MaxBlockExUnits ExUnits
  | -- | Max size of a Value in an output
    MaxValSize Natural
  | -- | The scaling percentage of the collateral relative to the fee
    CollateralPercentage Natural
  | -- | Maximum number of collateral inputs allowed in a transaction
    MaxCollateralInputs Natural
  | -- | These are new to Conway
    PoolVotingThreshold PoolVotingThresholds
  | DRepVotingThreshold DRepVotingThresholds
  | MinCommitteeSize Natural
  | CommitteeTermLimit EpochInterval
  | GovActionExpiration EpochInterval
  | GovActionDeposit Coin
  | DRepDeposit Coin
  | DRepActivity EpochInterval

abstractPParams :: Proof era -> PParams era -> [PParamsField era]
abstractPParams :: forall era. Proof era -> PParams era -> [PParamsField era]
abstractPParams Proof era
proof PParams era
ppp = case (forall era. Proof era -> PParamsWit era
whichPParams Proof era
proof, PParams era
ppp) of
  (PParamsWit era
PParamsShelleyToMary, PParams pp :: PParamsHKD Identity era
pp@(ShelleyPParams {})) ->
    [ forall era. Coin -> PParamsField era
MinfeeA (forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Coin
sppMinFeeA PParamsHKD Identity era
pp)
    , forall era. Coin -> PParamsField era
MinfeeB (forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Coin
sppMinFeeB PParamsHKD Identity era
pp)
    , forall era. Word32 -> PParamsField era
MaxBBSize (forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Word32
sppMaxBBSize PParamsHKD Identity era
pp)
    , forall era. Word32 -> PParamsField era
MaxTxSize (forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Word32
sppMaxTxSize PParamsHKD Identity era
pp)
    , forall era. Word16 -> PParamsField era
MaxBHSize (forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Word16
sppMaxBHSize PParamsHKD Identity era
pp)
    , forall era. Coin -> PParamsField era
KeyDeposit (forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Coin
sppKeyDeposit PParamsHKD Identity era
pp)
    , forall era. Coin -> PParamsField era
PoolDeposit (forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Coin
sppPoolDeposit PParamsHKD Identity era
pp)
    , forall era. EpochInterval -> PParamsField era
EMax (forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f EpochInterval
sppEMax PParamsHKD Identity era
pp)
    , forall era. Natural -> PParamsField era
NOpt (forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Natural
sppNOpt PParamsHKD Identity era
pp)
    , forall era. NonNegativeInterval -> PParamsField era
A0 (forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f NonNegativeInterval
sppA0 PParamsHKD Identity era
pp)
    , forall era. UnitInterval -> PParamsField era
Rho (forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f UnitInterval
sppRho PParamsHKD Identity era
pp)
    , forall era. UnitInterval -> PParamsField era
Tau (forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f UnitInterval
sppTau PParamsHKD Identity era
pp)
    , forall era. UnitInterval -> PParamsField era
D (forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f UnitInterval
sppD PParamsHKD Identity era
pp)
    , forall era. Nonce -> PParamsField era
ExtraEntropy (forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Nonce
sppExtraEntropy PParamsHKD Identity era
pp)
    , forall era. ProtVer -> PParamsField era
ProtocolVersion (forall (f :: * -> *) era. ShelleyPParams f era -> HKD f ProtVer
sppProtocolVersion PParamsHKD Identity era
pp)
    , forall era. Coin -> PParamsField era
MinUTxOValue (forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Coin
sppMinUTxOValue PParamsHKD Identity era
pp)
    , forall era. Coin -> PParamsField era
MinPoolCost (forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Coin
sppMinPoolCost PParamsHKD Identity era
pp)
    ]
  (PParamsWit era
PParamsAlonzoToAlonzo, PParams pp :: PParamsHKD Identity era
pp@(AlonzoPParams {})) ->
    [ forall era. Coin -> PParamsField era
MinfeeA (forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Coin
appMinFeeA PParamsHKD Identity era
pp)
    , forall era. Coin -> PParamsField era
MinfeeB (forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Coin
appMinFeeB PParamsHKD Identity era
pp)
    , forall era. Word32 -> PParamsField era
MaxBBSize (forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Word32
appMaxBBSize PParamsHKD Identity era
pp)
    , forall era. Word32 -> PParamsField era
MaxTxSize (forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Word32
appMaxTxSize PParamsHKD Identity era
pp)
    , forall era. Word16 -> PParamsField era
MaxBHSize (forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Word16
appMaxBHSize PParamsHKD Identity era
pp)
    , forall era. Coin -> PParamsField era
KeyDeposit (forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Coin
appKeyDeposit PParamsHKD Identity era
pp)
    , forall era. Coin -> PParamsField era
PoolDeposit (forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Coin
appPoolDeposit PParamsHKD Identity era
pp)
    , forall era. EpochInterval -> PParamsField era
EMax (forall (f :: * -> *) era.
AlonzoPParams f era -> HKD f EpochInterval
appEMax PParamsHKD Identity era
pp)
    , forall era. Natural -> PParamsField era
NOpt (forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Natural
appNOpt PParamsHKD Identity era
pp)
    , forall era. NonNegativeInterval -> PParamsField era
A0 (forall (f :: * -> *) era.
AlonzoPParams f era -> HKD f NonNegativeInterval
appA0 PParamsHKD Identity era
pp)
    , forall era. UnitInterval -> PParamsField era
Rho (forall (f :: * -> *) era. AlonzoPParams f era -> HKD f UnitInterval
appRho PParamsHKD Identity era
pp)
    , forall era. UnitInterval -> PParamsField era
Tau (forall (f :: * -> *) era. AlonzoPParams f era -> HKD f UnitInterval
appTau PParamsHKD Identity era
pp)
    , forall era. UnitInterval -> PParamsField era
D (forall (f :: * -> *) era. AlonzoPParams f era -> HKD f UnitInterval
appD PParamsHKD Identity era
pp)
    , forall era. Nonce -> PParamsField era
ExtraEntropy (forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Nonce
appExtraEntropy PParamsHKD Identity era
pp)
    , forall era. ProtVer -> PParamsField era
ProtocolVersion (forall (f :: * -> *) era. AlonzoPParams f era -> HKD f ProtVer
appProtocolVersion PParamsHKD Identity era
pp)
    , forall era. Coin -> PParamsField era
MinPoolCost (forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Coin
appMinPoolCost PParamsHKD Identity era
pp)
    , forall era. CoinPerWord -> PParamsField era
CoinPerUTxOWord (forall (f :: * -> *) era. AlonzoPParams f era -> HKD f CoinPerWord
appCoinsPerUTxOWord PParamsHKD Identity era
pp)
    , forall era. CostModels -> PParamsField era
Costmdls (forall (f :: * -> *) era. AlonzoPParams f era -> HKD f CostModels
appCostModels PParamsHKD Identity era
pp)
    , forall era. Prices -> PParamsField era
Prices (forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Prices
appPrices PParamsHKD Identity era
pp)
    , forall era. ExUnits -> PParamsField era
MaxTxExUnits (OrdExUnits -> ExUnits
unOrdExUnits (forall (f :: * -> *) era. AlonzoPParams f era -> HKD f OrdExUnits
appMaxTxExUnits PParamsHKD Identity era
pp))
    , forall era. ExUnits -> PParamsField era
MaxBlockExUnits (OrdExUnits -> ExUnits
unOrdExUnits (forall (f :: * -> *) era. AlonzoPParams f era -> HKD f OrdExUnits
appMaxBlockExUnits PParamsHKD Identity era
pp))
    , forall era. Natural -> PParamsField era
MaxValSize (forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Natural
appMaxValSize PParamsHKD Identity era
pp)
    , forall era. Natural -> PParamsField era
CollateralPercentage (forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Natural
appCollateralPercentage PParamsHKD Identity era
pp)
    , forall era. Natural -> PParamsField era
MaxCollateralInputs (forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Natural
appMaxCollateralInputs PParamsHKD Identity era
pp)
    ]
  (PParamsWit era
PParamsBabbageToBabbage, PParams pp :: PParamsHKD Identity era
pp@(BabbagePParams {})) ->
    [ forall era. Coin -> PParamsField era
MinfeeA (forall (f :: * -> *) era. BabbagePParams f era -> HKD f Coin
bppMinFeeA PParamsHKD Identity era
pp)
    , forall era. Coin -> PParamsField era
MinfeeB (forall (f :: * -> *) era. BabbagePParams f era -> HKD f Coin
bppMinFeeB PParamsHKD Identity era
pp)
    , forall era. Word32 -> PParamsField era
MaxBBSize (forall (f :: * -> *) era. BabbagePParams f era -> HKD f Word32
bppMaxBBSize PParamsHKD Identity era
pp)
    , forall era. Word32 -> PParamsField era
MaxTxSize (forall (f :: * -> *) era. BabbagePParams f era -> HKD f Word32
bppMaxTxSize PParamsHKD Identity era
pp)
    , forall era. Word16 -> PParamsField era
MaxBHSize (forall (f :: * -> *) era. BabbagePParams f era -> HKD f Word16
bppMaxBHSize PParamsHKD Identity era
pp)
    , forall era. Coin -> PParamsField era
KeyDeposit (forall (f :: * -> *) era. BabbagePParams f era -> HKD f Coin
bppKeyDeposit PParamsHKD Identity era
pp)
    , forall era. Coin -> PParamsField era
PoolDeposit (forall (f :: * -> *) era. BabbagePParams f era -> HKD f Coin
bppPoolDeposit PParamsHKD Identity era
pp)
    , forall era. EpochInterval -> PParamsField era
EMax (forall (f :: * -> *) era.
BabbagePParams f era -> HKD f EpochInterval
bppEMax PParamsHKD Identity era
pp)
    , forall era. Natural -> PParamsField era
NOpt (forall (f :: * -> *) era. BabbagePParams f era -> HKD f Natural
bppNOpt PParamsHKD Identity era
pp)
    , forall era. NonNegativeInterval -> PParamsField era
A0 (forall (f :: * -> *) era.
BabbagePParams f era -> HKD f NonNegativeInterval
bppA0 PParamsHKD Identity era
pp)
    , forall era. UnitInterval -> PParamsField era
Rho (forall (f :: * -> *) era.
BabbagePParams f era -> HKD f UnitInterval
bppRho PParamsHKD Identity era
pp)
    , forall era. UnitInterval -> PParamsField era
Tau (forall (f :: * -> *) era.
BabbagePParams f era -> HKD f UnitInterval
bppTau PParamsHKD Identity era
pp)
    , forall era. ProtVer -> PParamsField era
ProtocolVersion (forall (f :: * -> *) era. BabbagePParams f era -> HKD f ProtVer
bppProtocolVersion PParamsHKD Identity era
pp)
    , forall era. Coin -> PParamsField era
MinPoolCost (forall (f :: * -> *) era. BabbagePParams f era -> HKD f Coin
bppMinPoolCost PParamsHKD Identity era
pp)
    , forall era. CoinPerByte -> PParamsField era
CoinPerUTxOByte (forall (f :: * -> *) era. BabbagePParams f era -> HKD f CoinPerByte
bppCoinsPerUTxOByte PParamsHKD Identity era
pp)
    , forall era. CostModels -> PParamsField era
Costmdls (forall (f :: * -> *) era. BabbagePParams f era -> HKD f CostModels
bppCostModels PParamsHKD Identity era
pp)
    , forall era. Prices -> PParamsField era
Prices (forall (f :: * -> *) era. BabbagePParams f era -> HKD f Prices
bppPrices PParamsHKD Identity era
pp)
    , forall era. ExUnits -> PParamsField era
MaxTxExUnits (OrdExUnits -> ExUnits
unOrdExUnits (forall (f :: * -> *) era. BabbagePParams f era -> HKD f OrdExUnits
bppMaxTxExUnits PParamsHKD Identity era
pp))
    , forall era. ExUnits -> PParamsField era
MaxBlockExUnits (OrdExUnits -> ExUnits
unOrdExUnits (forall (f :: * -> *) era. BabbagePParams f era -> HKD f OrdExUnits
bppMaxBlockExUnits PParamsHKD Identity era
pp))
    , forall era. Natural -> PParamsField era
MaxValSize (forall (f :: * -> *) era. BabbagePParams f era -> HKD f Natural
bppMaxValSize PParamsHKD Identity era
pp)
    , forall era. Natural -> PParamsField era
CollateralPercentage (forall (f :: * -> *) era. BabbagePParams f era -> HKD f Natural
bppCollateralPercentage PParamsHKD Identity era
pp)
    , forall era. Natural -> PParamsField era
MaxCollateralInputs (forall (f :: * -> *) era. BabbagePParams f era -> HKD f Natural
bppMaxCollateralInputs PParamsHKD Identity era
pp)
    ]
  (PParamsWit era
PParamsConwayToConway, pp :: PParams era
pp@(PParams (ConwayPParams {}))) ->
    [ forall era. Coin -> PParamsField era
MinfeeA (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppMinFeeAL)
    , forall era. Coin -> PParamsField era
MinfeeB (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppMinFeeBL)
    , forall era. Word32 -> PParamsField era
MaxBBSize (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Word32
ppMaxBBSizeL)
    , forall era. Word32 -> PParamsField era
MaxTxSize (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Word32
ppMaxTxSizeL)
    , forall era. Word16 -> PParamsField era
MaxBHSize (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Word16
ppMaxBHSizeL)
    , forall era. Coin -> PParamsField era
KeyDeposit (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL)
    , forall era. Coin -> PParamsField era
PoolDeposit (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppPoolDepositL)
    , forall era. EpochInterval -> PParamsField era
EMax (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) EpochInterval
ppEMaxL)
    , forall era. Natural -> PParamsField era
NOpt (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Natural
ppNOptL)
    , forall era. NonNegativeInterval -> PParamsField era
A0 (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParams era) NonNegativeInterval
ppA0L)
    , forall era. UnitInterval -> PParamsField era
Rho (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) UnitInterval
ppRhoL)
    , forall era. UnitInterval -> PParamsField era
Tau (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) UnitInterval
ppTauL)
    , forall era. ProtVer -> PParamsField era
ProtocolVersion (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL)
    , forall era. Coin -> PParamsField era
MinPoolCost (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppMinPoolCostL)
    , forall era. CoinPerByte -> PParamsField era
CoinPerUTxOByte (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
BabbageEraPParams era =>
Lens' (PParams era) CoinPerByte
ppCoinsPerUTxOByteL)
    , forall era. CostModels -> PParamsField era
Costmdls (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
ppCostModelsL)
    , forall era. Prices -> PParamsField era
Prices (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
ppPricesL)
    , forall era. ExUnits -> PParamsField era
MaxTxExUnits (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
ppMaxTxExUnitsL)
    , forall era. ExUnits -> PParamsField era
MaxBlockExUnits (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
ppMaxBlockExUnitsL)
    , forall era. Natural -> PParamsField era
MaxValSize (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
ppMaxValSizeL)
    , forall era. Natural -> PParamsField era
CollateralPercentage (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
ppCollateralPercentageL)
    , forall era. Natural -> PParamsField era
MaxCollateralInputs (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
ppMaxCollateralInputsL)
    , forall era. PoolVotingThresholds -> PParamsField era
PoolVotingThreshold (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL)
    , forall era. DRepVotingThresholds -> PParamsField era
DRepVotingThreshold (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL)
    , forall era. Natural -> PParamsField era
MinCommitteeSize (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Natural
ppCommitteeMinSizeL)
    , forall era. EpochInterval -> PParamsField era
CommitteeTermLimit (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppCommitteeMaxTermLengthL)
    , forall era. EpochInterval -> PParamsField era
GovActionExpiration (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL)
    , forall era. Coin -> PParamsField era
GovActionDeposit (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL)
    , forall era. Coin -> PParamsField era
DRepDeposit (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppDRepDepositL)
    , forall era. EpochInterval -> PParamsField era
DRepActivity (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppDRepActivityL)
    ]

-- =========================================================================
-- Era parametric "empty" or initial values.

initVI :: ValidityInterval
initVI :: ValidityInterval
initVI = StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval forall a. StrictMaybe a
SNothing forall a. StrictMaybe a
SNothing

initWithdrawals :: Withdrawals c
initWithdrawals :: forall c. Withdrawals c
initWithdrawals = forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty

initialTxBody :: Era era => Proof era -> TxBody era
initialTxBody :: forall era. Era era => Proof era -> TxBody era
initialTxBody Proof era
Shelley = forall era. EraTxBody era => TxBody era
mkBasicTxBody
initialTxBody Proof era
Allegra = forall era. EraTxBody era => TxBody era
mkBasicTxBody
initialTxBody Proof era
Mary = forall era. EraTxBody era => TxBody era
mkBasicTxBody
initialTxBody Proof era
Alonzo = forall era. EraTxBody era => TxBody era
mkBasicTxBody
initialTxBody Proof era
Babbage = forall era. EraTxBody era => TxBody era
mkBasicTxBody
initialTxBody Proof era
Conway = forall era. EraTxBody era => TxBody era
mkBasicTxBody

initialWitnesses :: Era era => Proof era -> TxWits era
initialWitnesses :: forall era. Era era => Proof era -> TxWits era
initialWitnesses Proof era
Shelley = forall era. EraTxWits era => TxWits era
mkBasicTxWits
initialWitnesses Proof era
Allegra = forall era. EraTxWits era => TxWits era
mkBasicTxWits
initialWitnesses Proof era
Mary = forall era. EraTxWits era => TxWits era
mkBasicTxWits
initialWitnesses Proof era
Alonzo = forall era. EraTxWits era => TxWits era
mkBasicTxWits
initialWitnesses Proof era
Babbage = forall era. EraTxWits era => TxWits era
mkBasicTxWits
initialWitnesses Proof era
Conway = forall era. EraTxWits era => TxWits era
mkBasicTxWits

initialTx :: forall era. Proof era -> Tx era
initialTx :: forall era. Proof era -> Tx era
initialTx era :: Proof era
era@Proof era
Shelley = forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (forall era. Era era => Proof era -> TxBody era
initialTxBody Proof era
era)
initialTx era :: Proof era
era@Proof era
Allegra = forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (forall era. Era era => Proof era -> TxBody era
initialTxBody Proof era
era)
initialTx era :: Proof era
era@Proof era
Mary = forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (forall era. Era era => Proof era -> TxBody era
initialTxBody Proof era
era)
initialTx era :: Proof era
era@Proof era
Alonzo = forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (forall era. Era era => Proof era -> TxBody era
initialTxBody Proof era
era)
initialTx era :: Proof era
era@Proof era
Babbage = forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (forall era. Era era => Proof era -> TxBody era
initialTxBody Proof era
era)
initialTx era :: Proof era
era@Proof era
Conway = forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (forall era. Era era => Proof era -> TxBody era
initialTxBody Proof era
era)

-- | A Meaningless Addr.
initialAddr :: Era era => Proof era -> Addr (EraCrypto era)
initialAddr :: forall era. Era era => Proof era -> Addr (EraCrypto era)
initialAddr Proof era
_wit = forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr Network
Testnet forall {kr :: KeyRole}. Credential kr (EraCrypto era)
pCred StakeReference (EraCrypto era)
sCred
  where
    (KeyPair VKey kr (EraCrypto era)
svk SignKeyDSIGN (DSIGN (EraCrypto era))
_ssk) = forall c (kr :: KeyRole). Crypto c => Int -> KeyPair kr c
theKeyPair Int
0
    pCred :: Credential kr (EraCrypto era)
pCred = forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey forall a b. (a -> b) -> a -> b
$ forall c (kr :: KeyRole). Crypto c => Int -> KeyPair kr c
theKeyPair Int
1
    sCred :: StakeReference (EraCrypto era)
sCred = forall c. StakeCredential c -> StakeReference c
StakeRefBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall a b. (a -> b) -> a -> b
$ forall {kr :: KeyRole}. VKey kr (EraCrypto era)
svk

initialTxOut :: Era era => Proof era -> TxOut era
initialTxOut :: forall era. Era era => Proof era -> TxOut era
initialTxOut wit :: Proof era
wit@Proof era
Shelley = forall era.
(EraTxOut era, HasCallStack) =>
Addr (EraCrypto era) -> Value era -> TxOut era
mkBasicTxOut (forall era. Era era => Proof era -> Addr (EraCrypto era)
initialAddr Proof era
wit) forall a. Monoid a => a
mempty
initialTxOut wit :: Proof era
wit@Proof era
Allegra = forall era.
(EraTxOut era, HasCallStack) =>
Addr (EraCrypto era) -> Value era -> TxOut era
mkBasicTxOut (forall era. Era era => Proof era -> Addr (EraCrypto era)
initialAddr Proof era
wit) forall a. Monoid a => a
mempty
initialTxOut wit :: Proof era
wit@Proof era
Mary = forall era.
(EraTxOut era, HasCallStack) =>
Addr (EraCrypto era) -> Value era -> TxOut era
mkBasicTxOut (forall era. Era era => Proof era -> Addr (EraCrypto era)
initialAddr Proof era
wit) forall a. Monoid a => a
mempty
initialTxOut wit :: Proof era
wit@Proof era
Alonzo = forall era.
(EraTxOut era, HasCallStack) =>
Addr (EraCrypto era) -> Value era -> TxOut era
mkBasicTxOut (forall era. Era era => Proof era -> Addr (EraCrypto era)
initialAddr Proof era
wit) forall a. Monoid a => a
mempty
initialTxOut wit :: Proof era
wit@Proof era
Babbage = forall era.
(EraTxOut era, HasCallStack) =>
Addr (EraCrypto era) -> Value era -> TxOut era
mkBasicTxOut (forall era. Era era => Proof era -> Addr (EraCrypto era)
initialAddr Proof era
wit) forall a. Monoid a => a
mempty
initialTxOut wit :: Proof era
wit@Proof era
Conway = forall era.
(EraTxOut era, HasCallStack) =>
Addr (EraCrypto era) -> Value era -> TxOut era
mkBasicTxOut (forall era. Era era => Proof era -> Addr (EraCrypto era)
initialAddr Proof era
wit) forall a. Monoid a => a
mempty

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

abstractTx :: Proof era -> Tx era -> [TxField era]
abstractTx :: forall era. Proof era -> Tx era -> [TxField era]
abstractTx Proof era
Conway (AlonzoTx TxBody (ConwayEra StandardCrypto)
txBody TxWits (ConwayEra StandardCrypto)
wit IsValid
v StrictMaybe (TxAuxData (ConwayEra StandardCrypto))
auxdata) =
  [forall era. TxBody era -> TxField era
Body TxBody (ConwayEra StandardCrypto)
txBody, forall era. TxWits era -> TxField era
TxWits TxWits (ConwayEra StandardCrypto)
wit, forall era. IsValid -> TxField era
Valid IsValid
v, forall era. StrictMaybe (TxAuxData era) -> TxField era
AuxData StrictMaybe (TxAuxData (ConwayEra StandardCrypto))
auxdata]
abstractTx Proof era
Babbage (AlonzoTx TxBody (BabbageEra StandardCrypto)
txBody TxWits (BabbageEra StandardCrypto)
wit IsValid
v StrictMaybe (TxAuxData (BabbageEra StandardCrypto))
auxdata) =
  [forall era. TxBody era -> TxField era
Body TxBody (BabbageEra StandardCrypto)
txBody, forall era. TxWits era -> TxField era
TxWits TxWits (BabbageEra StandardCrypto)
wit, forall era. IsValid -> TxField era
Valid IsValid
v, forall era. StrictMaybe (TxAuxData era) -> TxField era
AuxData StrictMaybe (TxAuxData (BabbageEra StandardCrypto))
auxdata]
abstractTx Proof era
Alonzo (AlonzoTx TxBody (AlonzoEra StandardCrypto)
txBody TxWits (AlonzoEra StandardCrypto)
wit IsValid
v StrictMaybe (TxAuxData (AlonzoEra StandardCrypto))
auxdata) =
  [forall era. TxBody era -> TxField era
Body TxBody (AlonzoEra StandardCrypto)
txBody, forall era. TxWits era -> TxField era
TxWits TxWits (AlonzoEra StandardCrypto)
wit, forall era. IsValid -> TxField era
Valid IsValid
v, forall era. StrictMaybe (TxAuxData era) -> TxField era
AuxData StrictMaybe (TxAuxData (AlonzoEra StandardCrypto))
auxdata]
abstractTx Proof era
Shelley (ShelleyTx TxBody (ShelleyEra StandardCrypto)
txBody TxWits (ShelleyEra StandardCrypto)
wit StrictMaybe (TxAuxData (ShelleyEra StandardCrypto))
auxdata) =
  [forall era. TxBody era -> TxField era
Body TxBody (ShelleyEra StandardCrypto)
txBody, forall era. TxWits era -> TxField era
TxWits TxWits (ShelleyEra StandardCrypto)
wit, forall era. StrictMaybe (TxAuxData era) -> TxField era
AuxData StrictMaybe (TxAuxData (ShelleyEra StandardCrypto))
auxdata]
abstractTx Proof era
Mary (ShelleyTx TxBody (MaryEra StandardCrypto)
txBody TxWits (MaryEra StandardCrypto)
wit StrictMaybe (TxAuxData (MaryEra StandardCrypto))
auxdata) =
  [forall era. TxBody era -> TxField era
Body TxBody (MaryEra StandardCrypto)
txBody, forall era. TxWits era -> TxField era
TxWits TxWits (MaryEra StandardCrypto)
wit, forall era. StrictMaybe (TxAuxData era) -> TxField era
AuxData StrictMaybe (TxAuxData (MaryEra StandardCrypto))
auxdata]
abstractTx Proof era
Allegra (ShelleyTx TxBody (AllegraEra StandardCrypto)
txBody TxWits (AllegraEra StandardCrypto)
wit StrictMaybe (TxAuxData (AllegraEra StandardCrypto))
auxdata) =
  [forall era. TxBody era -> TxField era
Body TxBody (AllegraEra StandardCrypto)
txBody, forall era. TxWits era -> TxField era
TxWits TxWits (AllegraEra StandardCrypto)
wit, forall era. StrictMaybe (TxAuxData era) -> TxField era
AuxData StrictMaybe (TxAuxData (AllegraEra StandardCrypto))
auxdata]

abstractTxBody :: Proof era -> TxBody era -> [TxBodyField era]
abstractTxBody :: forall era. Proof era -> TxBody era -> [TxBodyField era]
abstractTxBody Proof era
Alonzo (AlonzoTxBody Set (TxIn (EraCrypto era))
inp Set (TxIn (EraCrypto era))
col StrictSeq (TxOut era)
out StrictSeq (TxCert era)
cert Withdrawals (EraCrypto era)
wdrl Coin
fee ValidityInterval
vldt StrictMaybe (Update era)
up Set (KeyHash 'Witness (EraCrypto era))
req MultiAsset (EraCrypto era)
mnt StrictMaybe (ScriptIntegrityHash (EraCrypto era))
sih StrictMaybe (AuxiliaryDataHash (EraCrypto era))
adh StrictMaybe Network
net) =
  [ forall era. Set (TxIn (EraCrypto era)) -> TxBodyField era
Inputs Set (TxIn (EraCrypto era))
inp
  , forall era. Set (TxIn (EraCrypto era)) -> TxBodyField era
Collateral Set (TxIn (EraCrypto era))
col
  , forall era. StrictSeq (TxOut era) -> TxBodyField era
Outputs StrictSeq (TxOut era)
out
  , forall era. StrictSeq (TxCert era) -> TxBodyField era
Certs StrictSeq (TxCert era)
cert
  , forall era. Withdrawals (EraCrypto era) -> TxBodyField era
Withdrawals' Withdrawals (EraCrypto era)
wdrl
  , forall era. Coin -> TxBodyField era
Txfee Coin
fee
  , forall era. ValidityInterval -> TxBodyField era
Vldt ValidityInterval
vldt
  , forall era. StrictMaybe (Update era) -> TxBodyField era
Update StrictMaybe (Update era)
up
  , forall era.
Set (KeyHash 'Witness (EraCrypto era)) -> TxBodyField era
ReqSignerHashes Set (KeyHash 'Witness (EraCrypto era))
req
  , forall era. MultiAsset (EraCrypto era) -> TxBodyField era
Mint MultiAsset (EraCrypto era)
mnt
  , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash StrictMaybe (ScriptIntegrityHash (EraCrypto era))
sih
  , forall era.
StrictMaybe (AuxiliaryDataHash (EraCrypto era)) -> TxBodyField era
AdHash StrictMaybe (AuxiliaryDataHash (EraCrypto era))
adh
  , forall era. StrictMaybe Network -> TxBodyField era
Txnetworkid StrictMaybe Network
net
  ]
abstractTxBody Proof era
Conway (ConwayTxBody Set (TxIn (EraCrypto era))
inp Set (TxIn (EraCrypto era))
col Set (TxIn (EraCrypto era))
ref StrictSeq (Sized (TxOut era))
out StrictMaybe (Sized (TxOut era))
colret StrictMaybe Coin
totcol OSet (ConwayTxCert era)
cert Withdrawals (EraCrypto era)
wdrl Coin
fee ValidityInterval
vldt Set (KeyHash 'Witness (EraCrypto era))
req MultiAsset (EraCrypto era)
mnt StrictMaybe (ScriptIntegrityHash (EraCrypto era))
sih StrictMaybe (AuxiliaryDataHash (EraCrypto era))
adh StrictMaybe Network
net VotingProcedures era
vp OSet (ProposalProcedure era)
pp StrictMaybe Coin
ctv Coin
td) =
  [ forall era. Set (TxIn (EraCrypto era)) -> TxBodyField era
Inputs Set (TxIn (EraCrypto era))
inp
  , forall era. Set (TxIn (EraCrypto era)) -> TxBodyField era
Collateral Set (TxIn (EraCrypto era))
col
  , forall era. Set (TxIn (EraCrypto era)) -> TxBodyField era
RefInputs Set (TxIn (EraCrypto era))
ref
  , forall era. StrictSeq (TxOut era) -> TxBodyField era
Outputs (forall a. Sized a -> a
sizedValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Sized (TxOut era))
out)
  , forall era. StrictMaybe (TxOut era) -> TxBodyField era
CollateralReturn (forall a. Sized a -> a
sizedValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe (Sized (TxOut era))
colret)
  , forall era. StrictMaybe Coin -> TxBodyField era
TotalCol StrictMaybe Coin
totcol
  , forall era. StrictSeq (TxCert era) -> TxBodyField era
Certs forall a b. (a -> b) -> a -> b
$ forall a. OSet a -> StrictSeq a
OSet.toStrictSeq OSet (ConwayTxCert era)
cert
  , forall era. Withdrawals (EraCrypto era) -> TxBodyField era
Withdrawals' Withdrawals (EraCrypto era)
wdrl
  , forall era. Coin -> TxBodyField era
Txfee Coin
fee
  , forall era. ValidityInterval -> TxBodyField era
Vldt ValidityInterval
vldt
  , forall era.
Set (KeyHash 'Witness (EraCrypto era)) -> TxBodyField era
ReqSignerHashes Set (KeyHash 'Witness (EraCrypto era))
req
  , forall era. MultiAsset (EraCrypto era) -> TxBodyField era
Mint MultiAsset (EraCrypto era)
mnt
  , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash StrictMaybe (ScriptIntegrityHash (EraCrypto era))
sih
  , forall era.
StrictMaybe (AuxiliaryDataHash (EraCrypto era)) -> TxBodyField era
AdHash StrictMaybe (AuxiliaryDataHash (EraCrypto era))
adh
  , forall era. StrictMaybe Network -> TxBodyField era
Txnetworkid StrictMaybe Network
net
  , forall era. VotingProcedures era -> TxBodyField era
VotingProc VotingProcedures era
vp
  , forall era. OSet (ProposalProcedure era) -> TxBodyField era
ProposalProc OSet (ProposalProcedure era)
pp
  , forall era. StrictMaybe Coin -> TxBodyField era
CurrentTreasuryValue StrictMaybe Coin
ctv
  , forall era. Coin -> TxBodyField era
TreasuryDonation Coin
td
  ]
abstractTxBody Proof era
Babbage (BabbageTxBody Set (TxIn (EraCrypto era))
inp Set (TxIn (EraCrypto era))
col Set (TxIn (EraCrypto era))
ref StrictSeq (Sized (TxOut era))
out StrictMaybe (Sized (TxOut era))
colret StrictMaybe Coin
totcol StrictSeq (TxCert era)
cert Withdrawals (EraCrypto era)
wdrl Coin
fee ValidityInterval
vldt StrictMaybe (Update era)
up Set (KeyHash 'Witness (EraCrypto era))
req MultiAsset (EraCrypto era)
mnt StrictMaybe (ScriptIntegrityHash (EraCrypto era))
sih StrictMaybe (AuxiliaryDataHash (EraCrypto era))
adh StrictMaybe Network
net) =
  [ forall era. Set (TxIn (EraCrypto era)) -> TxBodyField era
Inputs Set (TxIn (EraCrypto era))
inp
  , forall era. Set (TxIn (EraCrypto era)) -> TxBodyField era
Collateral Set (TxIn (EraCrypto era))
col
  , forall era. Set (TxIn (EraCrypto era)) -> TxBodyField era
RefInputs Set (TxIn (EraCrypto era))
ref
  , forall era. StrictSeq (TxOut era) -> TxBodyField era
Outputs (forall a. Sized a -> a
sizedValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Sized (TxOut era))
out)
  , forall era. StrictMaybe (TxOut era) -> TxBodyField era
CollateralReturn (forall a. Sized a -> a
sizedValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe (Sized (TxOut era))
colret)
  , forall era. StrictMaybe Coin -> TxBodyField era
TotalCol StrictMaybe Coin
totcol
  , forall era. StrictSeq (TxCert era) -> TxBodyField era
Certs StrictSeq (TxCert era)
cert
  , forall era. Withdrawals (EraCrypto era) -> TxBodyField era
Withdrawals' Withdrawals (EraCrypto era)
wdrl
  , forall era. Coin -> TxBodyField era
Txfee Coin
fee
  , forall era. ValidityInterval -> TxBodyField era
Vldt ValidityInterval
vldt
  , forall era. StrictMaybe (Update era) -> TxBodyField era
Update StrictMaybe (Update era)
up
  , forall era.
Set (KeyHash 'Witness (EraCrypto era)) -> TxBodyField era
ReqSignerHashes Set (KeyHash 'Witness (EraCrypto era))
req
  , forall era. MultiAsset (EraCrypto era) -> TxBodyField era
Mint MultiAsset (EraCrypto era)
mnt
  , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash StrictMaybe (ScriptIntegrityHash (EraCrypto era))
sih
  , forall era.
StrictMaybe (AuxiliaryDataHash (EraCrypto era)) -> TxBodyField era
AdHash StrictMaybe (AuxiliaryDataHash (EraCrypto era))
adh
  , forall era. StrictMaybe Network -> TxBodyField era
Txnetworkid StrictMaybe Network
net
  ]
abstractTxBody Proof era
Shelley (ShelleyTxBody Set (TxIn (EraCrypto era))
inp StrictSeq (TxOut era)
out StrictSeq (TxCert era)
cert Withdrawals (EraCrypto era)
wdrl Coin
fee SlotNo
ttlslot StrictMaybe (Update era)
up StrictMaybe (AuxiliaryDataHash (EraCrypto era))
adh) =
  [ forall era. Set (TxIn (EraCrypto era)) -> TxBodyField era
Inputs Set (TxIn (EraCrypto era))
inp
  , forall era. StrictSeq (TxOut era) -> TxBodyField era
Outputs StrictSeq (TxOut era)
out
  , forall era. StrictSeq (TxCert era) -> TxBodyField era
Certs StrictSeq (TxCert era)
cert
  , forall era. Withdrawals (EraCrypto era) -> TxBodyField era
Withdrawals' Withdrawals (EraCrypto era)
wdrl
  , forall era. Coin -> TxBodyField era
Txfee Coin
fee
  , forall era. SlotNo -> TxBodyField era
TTL SlotNo
ttlslot
  , forall era. StrictMaybe (Update era) -> TxBodyField era
Update StrictMaybe (Update era)
up
  , forall era.
StrictMaybe (AuxiliaryDataHash (EraCrypto era)) -> TxBodyField era
AdHash StrictMaybe (AuxiliaryDataHash (EraCrypto era))
adh
  ]
abstractTxBody Proof era
Mary (MaryTxBody Set (TxIn (EraCrypto era))
inp StrictSeq (TxOut era)
out StrictSeq (TxCert era)
cert Withdrawals (EraCrypto era)
wdrl Coin
fee ValidityInterval
vldt StrictMaybe (Update era)
up StrictMaybe (AuxiliaryDataHash (EraCrypto era))
adh MultiAsset (EraCrypto era)
mnt) =
  [ forall era. Set (TxIn (EraCrypto era)) -> TxBodyField era
Inputs Set (TxIn (EraCrypto era))
inp
  , forall era. StrictSeq (TxOut era) -> TxBodyField era
Outputs StrictSeq (TxOut era)
out
  , forall era. StrictSeq (TxCert era) -> TxBodyField era
Certs StrictSeq (TxCert era)
cert
  , forall era. Withdrawals (EraCrypto era) -> TxBodyField era
Withdrawals' Withdrawals (EraCrypto era)
wdrl
  , forall era. Coin -> TxBodyField era
Txfee Coin
fee
  , forall era. ValidityInterval -> TxBodyField era
Vldt ValidityInterval
vldt
  , forall era. StrictMaybe (Update era) -> TxBodyField era
Update StrictMaybe (Update era)
up
  , forall era.
StrictMaybe (AuxiliaryDataHash (EraCrypto era)) -> TxBodyField era
AdHash StrictMaybe (AuxiliaryDataHash (EraCrypto era))
adh
  , forall era. MultiAsset (EraCrypto era) -> TxBodyField era
Mint MultiAsset (EraCrypto era)
mnt
  ]
abstractTxBody Proof era
Allegra (AllegraTxBody Set (TxIn (EraCrypto era))
inp StrictSeq (TxOut era)
out StrictSeq (TxCert era)
cert Withdrawals (EraCrypto era)
wdrl Coin
fee ValidityInterval
vldt StrictMaybe (Update era)
up StrictMaybe (AuxiliaryDataHash (EraCrypto era))
adh) =
  [ forall era. Set (TxIn (EraCrypto era)) -> TxBodyField era
Inputs Set (TxIn (EraCrypto era))
inp
  , forall era. StrictSeq (TxOut era) -> TxBodyField era
Outputs StrictSeq (TxOut era)
out
  , forall era. StrictSeq (TxCert era) -> TxBodyField era
Certs StrictSeq (TxCert era)
cert
  , forall era. Withdrawals (EraCrypto era) -> TxBodyField era
Withdrawals' Withdrawals (EraCrypto era)
wdrl
  , forall era. Coin -> TxBodyField era
Txfee Coin
fee
  , forall era. ValidityInterval -> TxBodyField era
Vldt ValidityInterval
vldt
  , forall era. StrictMaybe (Update era) -> TxBodyField era
Update StrictMaybe (Update era)
up
  , forall era.
StrictMaybe (AuxiliaryDataHash (EraCrypto era)) -> TxBodyField era
AdHash StrictMaybe (AuxiliaryDataHash (EraCrypto era))
adh
  ]

abstractWitnesses :: Proof era -> TxWits era -> [WitnessesField era]
abstractWitnesses :: forall era. Proof era -> TxWits era -> [WitnessesField era]
abstractWitnesses Proof era
Shelley (ShelleyTxWits Set (WitVKey 'Witness (EraCrypto (ShelleyEra StandardCrypto)))
keys Map
  (ScriptHash (EraCrypto (ShelleyEra StandardCrypto)))
  (Script (ShelleyEra StandardCrypto))
scripts Set (BootstrapWitness (EraCrypto (ShelleyEra StandardCrypto)))
boot) = [forall era.
Set (WitVKey 'Witness (EraCrypto era)) -> WitnessesField era
AddrWits Set (WitVKey 'Witness (EraCrypto (ShelleyEra StandardCrypto)))
keys, forall era.
Map (ScriptHash (EraCrypto era)) (Script era) -> WitnessesField era
ScriptWits Map
  (ScriptHash (EraCrypto (ShelleyEra StandardCrypto)))
  (Script (ShelleyEra StandardCrypto))
scripts, forall era.
Set (BootstrapWitness (EraCrypto era)) -> WitnessesField era
BootWits Set (BootstrapWitness (EraCrypto (ShelleyEra StandardCrypto)))
boot]
abstractWitnesses Proof era
Allegra (ShelleyTxWits Set (WitVKey 'Witness (EraCrypto (AllegraEra StandardCrypto)))
keys Map
  (ScriptHash (EraCrypto (AllegraEra StandardCrypto)))
  (Script (AllegraEra StandardCrypto))
scripts Set (BootstrapWitness (EraCrypto (AllegraEra StandardCrypto)))
boot) = [forall era.
Set (WitVKey 'Witness (EraCrypto era)) -> WitnessesField era
AddrWits Set (WitVKey 'Witness (EraCrypto (AllegraEra StandardCrypto)))
keys, forall era.
Map (ScriptHash (EraCrypto era)) (Script era) -> WitnessesField era
ScriptWits Map
  (ScriptHash (EraCrypto (AllegraEra StandardCrypto)))
  (Script (AllegraEra StandardCrypto))
scripts, forall era.
Set (BootstrapWitness (EraCrypto era)) -> WitnessesField era
BootWits Set (BootstrapWitness (EraCrypto (AllegraEra StandardCrypto)))
boot]
abstractWitnesses Proof era
Mary (ShelleyTxWits Set (WitVKey 'Witness (EraCrypto (MaryEra StandardCrypto)))
keys Map
  (ScriptHash (EraCrypto (MaryEra StandardCrypto)))
  (Script (MaryEra StandardCrypto))
scripts Set (BootstrapWitness (EraCrypto (MaryEra StandardCrypto)))
boot) = [forall era.
Set (WitVKey 'Witness (EraCrypto era)) -> WitnessesField era
AddrWits Set (WitVKey 'Witness (EraCrypto (MaryEra StandardCrypto)))
keys, forall era.
Map (ScriptHash (EraCrypto era)) (Script era) -> WitnessesField era
ScriptWits Map
  (ScriptHash (EraCrypto (MaryEra StandardCrypto)))
  (Script (MaryEra StandardCrypto))
scripts, forall era.
Set (BootstrapWitness (EraCrypto era)) -> WitnessesField era
BootWits Set (BootstrapWitness (EraCrypto (MaryEra StandardCrypto)))
boot]
abstractWitnesses Proof era
Alonzo (AlonzoTxWits Set (WitVKey 'Witness (EraCrypto era))
key Set (BootstrapWitness (EraCrypto era))
boot Map (ScriptHash (EraCrypto era)) (Script era)
scripts TxDats era
dats Redeemers era
red) =
  [forall era.
Set (WitVKey 'Witness (EraCrypto era)) -> WitnessesField era
AddrWits Set (WitVKey 'Witness (EraCrypto era))
key, forall era.
Map (ScriptHash (EraCrypto era)) (Script era) -> WitnessesField era
ScriptWits Map (ScriptHash (EraCrypto era)) (Script era)
scripts, forall era.
Set (BootstrapWitness (EraCrypto era)) -> WitnessesField era
BootWits Set (BootstrapWitness (EraCrypto era))
boot, forall era. TxDats era -> WitnessesField era
DataWits TxDats era
dats, forall era. Redeemers era -> WitnessesField era
RdmrWits Redeemers era
red]
abstractWitnesses Proof era
Babbage (AlonzoTxWits Set (WitVKey 'Witness (EraCrypto era))
key Set (BootstrapWitness (EraCrypto era))
boot Map (ScriptHash (EraCrypto era)) (Script era)
scripts TxDats era
dats Redeemers era
red) =
  [forall era.
Set (WitVKey 'Witness (EraCrypto era)) -> WitnessesField era
AddrWits Set (WitVKey 'Witness (EraCrypto era))
key, forall era.
Map (ScriptHash (EraCrypto era)) (Script era) -> WitnessesField era
ScriptWits Map (ScriptHash (EraCrypto era)) (Script era)
scripts, forall era.
Set (BootstrapWitness (EraCrypto era)) -> WitnessesField era
BootWits Set (BootstrapWitness (EraCrypto era))
boot, forall era. TxDats era -> WitnessesField era
DataWits TxDats era
dats, forall era. Redeemers era -> WitnessesField era
RdmrWits Redeemers era
red]
abstractWitnesses Proof era
Conway (AlonzoTxWits Set (WitVKey 'Witness (EraCrypto era))
key Set (BootstrapWitness (EraCrypto era))
boot Map (ScriptHash (EraCrypto era)) (Script era)
scripts TxDats era
dats Redeemers era
red) =
  [forall era.
Set (WitVKey 'Witness (EraCrypto era)) -> WitnessesField era
AddrWits Set (WitVKey 'Witness (EraCrypto era))
key, forall era.
Map (ScriptHash (EraCrypto era)) (Script era) -> WitnessesField era
ScriptWits Map (ScriptHash (EraCrypto era)) (Script era)
scripts, forall era.
Set (BootstrapWitness (EraCrypto era)) -> WitnessesField era
BootWits Set (BootstrapWitness (EraCrypto era))
boot, forall era. TxDats era -> WitnessesField era
DataWits TxDats era
dats, forall era. Redeemers era -> WitnessesField era
RdmrWits Redeemers era
red]

abstractTxOut :: Era era => Proof era -> TxOut era -> [TxOutField era]
abstractTxOut :: forall era. Era era => Proof era -> TxOut era -> [TxOutField era]
abstractTxOut Proof era
Shelley (ShelleyTxOut Addr (EraCrypto (ShelleyEra StandardCrypto))
addr Value (ShelleyEra StandardCrypto)
c) = [forall era. Addr (EraCrypto era) -> TxOutField era
Address Addr (EraCrypto (ShelleyEra StandardCrypto))
addr, forall era. Value era -> TxOutField era
Amount Value (ShelleyEra StandardCrypto)
c]
abstractTxOut Proof era
Allegra (ShelleyTxOut Addr (EraCrypto (AllegraEra StandardCrypto))
addr Value (AllegraEra StandardCrypto)
c) = [forall era. Addr (EraCrypto era) -> TxOutField era
Address Addr (EraCrypto (AllegraEra StandardCrypto))
addr, forall era. Value era -> TxOutField era
Amount Value (AllegraEra StandardCrypto)
c]
abstractTxOut Proof era
Mary (ShelleyTxOut Addr (EraCrypto (MaryEra StandardCrypto))
addr Value (MaryEra StandardCrypto)
val) = [forall era. Addr (EraCrypto era) -> TxOutField era
Address Addr (EraCrypto (MaryEra StandardCrypto))
addr, forall era. Value era -> TxOutField era
Amount Value (MaryEra StandardCrypto)
val]
abstractTxOut Proof era
Alonzo (AlonzoTxOut Addr (EraCrypto (AlonzoEra StandardCrypto))
addr Value (AlonzoEra StandardCrypto)
val StrictMaybe (DataHash (EraCrypto (AlonzoEra StandardCrypto)))
d) = [forall era. Addr (EraCrypto era) -> TxOutField era
Address Addr (EraCrypto (AlonzoEra StandardCrypto))
addr, forall era. Value era -> TxOutField era
Amount Value (AlonzoEra StandardCrypto)
val, forall era.
StrictMaybe (DataHash (EraCrypto era)) -> TxOutField era
DHash StrictMaybe (DataHash (EraCrypto (AlonzoEra StandardCrypto)))
d]
abstractTxOut Proof era
Babbage (BabbageTxOut Addr (EraCrypto era)
addr Value era
val Datum era
d StrictMaybe (Script era)
refscr) =
  [forall era. Addr (EraCrypto era) -> TxOutField era
Address Addr (EraCrypto era)
addr, forall era. Value era -> TxOutField era
Amount Value era
val, forall era. Datum era -> TxOutField era
FDatum Datum era
d, forall era. StrictMaybe (Script era) -> TxOutField era
RefScript StrictMaybe (Script era)
refscr]
abstractTxOut Proof era
Conway (BabbageTxOut Addr (EraCrypto era)
addr Value era
val Datum era
d StrictMaybe (Script era)
refscr) =
  [forall era. Addr (EraCrypto era) -> TxOutField era
Address Addr (EraCrypto era)
addr, forall era. Value era -> TxOutField era
Amount Value era
val, forall era. Datum era -> TxOutField era
FDatum Datum era
d, forall era. StrictMaybe (Script era) -> TxOutField era
RefScript StrictMaybe (Script era)
refscr]

-- =================================================================
-- coercion functions for defining Primed Field constructor patterns

valid :: IsValid -> Bool
valid :: IsValid -> Bool
valid (IsValid Bool
b) = Bool
b

toSet :: Ord a => [a] -> Set a
toSet :: forall a. Ord a => [a] -> Set a
toSet = forall a. Ord a => [a] -> Set a
Set.fromList

fromSet :: Set a -> [a]
fromSet :: forall a. Set a -> [a]
fromSet = forall a. Set a -> [a]
Set.toList

toStrictSeq :: [a] -> StrictSeq a
toStrictSeq :: forall a. [a] -> StrictSeq a
toStrictSeq = forall a. [a] -> StrictSeq a
SSeq.fromList

fromStrictSeq :: StrictSeq a -> [a]
fromStrictSeq :: forall a. StrictSeq a -> [a]
fromStrictSeq StrictSeq a
s = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [] StrictSeq a
s

toStrictMaybe :: [a] -> StrictMaybe a
toStrictMaybe :: forall a. [a] -> StrictMaybe a
toStrictMaybe [] = forall a. StrictMaybe a
SNothing
toStrictMaybe [a
x] = forall a. a -> StrictMaybe a
SJust a
x
toStrictMaybe [a]
_xs = forall a. HasCallStack => [Char] -> a
error [Char]
"toStrictMaybe applied to list with 2 or more elements"

fromStrictMaybe :: StrictMaybe a -> [a]
fromStrictMaybe :: forall a. StrictMaybe a -> [a]
fromStrictMaybe StrictMaybe a
SNothing = []
fromStrictMaybe (SJust a
x) = [a
x]

-- Coercing from [T era] to (Map (Hash (T era)) (T era)), for different version of T that are Hashable

toMapDat :: Era era => [Data era] -> TxDats era
toMapDat :: forall era. Era era => [Data era] -> TxDats era
toMapDat [Data era]
ds = forall era.
Era era =>
Map (DataHash (EraCrypto era)) (Data era) -> TxDats era
TxDats (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall a b. (a -> b) -> [a] -> [b]
map (\Data era
d -> (forall era. Era era => Data era -> DataHash (EraCrypto era)
hashData Data era
d, Data era
d)) [Data era]
ds))

fromMapScript :: forall era. Map (ScriptHash (EraCrypto era)) (Script era) -> [Script era]
fromMapScript :: forall era.
Map (ScriptHash (EraCrypto era)) (Script era) -> [Script era]
fromMapScript Map (ScriptHash (EraCrypto era)) (Script era)
m = forall k a. Map k a -> [a]
Map.elems Map (ScriptHash (EraCrypto era)) (Script era)
m

toMapScript ::
  forall era. EraScript era => [Script era] -> Map (ScriptHash (EraCrypto era)) (Script era)
toMapScript :: forall era.
EraScript era =>
[Script era] -> Map (ScriptHash (EraCrypto era)) (Script era)
toMapScript [Script era]
scripts = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall a b. (a -> b) -> [a] -> [b]
map (\Script era
s -> (forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @era Script era
s, Script era
s)) [Script era]
scripts)

-- =============================================================================
-- Patterns (with primed names, like C') allow users to use [a], to stand
-- for (Set a) (Maybe a) (StrictSeq a) (StrictMaybe a) (Map (hash a) a)
-- The pattern signatures are just underneath the data declarations

-- ========================
-- TxBody patterns

netview :: TxBodyField era -> Maybe [Network]
netview :: forall era. TxBodyField era -> Maybe [Network]
netview (Txnetworkid StrictMaybe Network
x) = forall a. a -> Maybe a
Just (forall a. StrictMaybe a -> [a]
fromStrictMaybe StrictMaybe Network
x)
netview TxBodyField era
_ = forall a. Maybe a
Nothing

pattern $bTxnetworkid' :: forall era. [Network] -> TxBodyField era
$mTxnetworkid' :: forall {r} {era}.
TxBodyField era -> ([Network] -> r) -> ((# #) -> r) -> r
Txnetworkid' x <-
  (netview -> Just x)
  where
    Txnetworkid' [Network]
x = forall era. StrictMaybe Network -> TxBodyField era
Txnetworkid (forall a. [a] -> StrictMaybe a
toStrictMaybe [Network]
x)

adhashview :: TxBodyField era -> Maybe [AuxiliaryDataHash (EraCrypto era)]
adhashview :: forall era.
TxBodyField era -> Maybe [AuxiliaryDataHash (EraCrypto era)]
adhashview (AdHash StrictMaybe (AuxiliaryDataHash (EraCrypto era))
x) = forall a. a -> Maybe a
Just (forall a. StrictMaybe a -> [a]
fromStrictMaybe StrictMaybe (AuxiliaryDataHash (EraCrypto era))
x)
adhashview TxBodyField era
_ = forall a. Maybe a
Nothing

pattern $bAdHash' :: forall era. [AuxiliaryDataHash (EraCrypto era)] -> TxBodyField era
$mAdHash' :: forall {r} {era}.
TxBodyField era
-> ([AuxiliaryDataHash (EraCrypto era)] -> r) -> ((# #) -> r) -> r
AdHash' x <-
  (adhashview -> Just x)
  where
    AdHash' [AuxiliaryDataHash (EraCrypto era)]
x = forall era.
StrictMaybe (AuxiliaryDataHash (EraCrypto era)) -> TxBodyField era
AdHash (forall a. [a] -> StrictMaybe a
toStrictMaybe [AuxiliaryDataHash (EraCrypto era)]
x)

wppview :: TxBodyField era -> Maybe [ScriptIntegrityHash (EraCrypto era)]
wppview :: forall era.
TxBodyField era -> Maybe [ScriptIntegrityHash (EraCrypto era)]
wppview (WppHash StrictMaybe (ScriptIntegrityHash (EraCrypto era))
x) = forall a. a -> Maybe a
Just (forall a. StrictMaybe a -> [a]
fromStrictMaybe StrictMaybe (ScriptIntegrityHash (EraCrypto era))
x)
wppview TxBodyField era
_ = forall a. Maybe a
Nothing

pattern $bWppHash' :: forall era.
[ScriptIntegrityHash (EraCrypto era)] -> TxBodyField era
$mWppHash' :: forall {r} {era}.
TxBodyField era
-> ([ScriptIntegrityHash (EraCrypto era)] -> r)
-> ((# #) -> r)
-> r
WppHash' x <-
  (wppview -> Just x)
  where
    WppHash' [ScriptIntegrityHash (EraCrypto era)]
x = forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash (forall a. [a] -> StrictMaybe a
toStrictMaybe [ScriptIntegrityHash (EraCrypto era)]
x)

signview :: TxBodyField era -> Maybe [KeyHash 'Witness (EraCrypto era)]
signview :: forall era.
TxBodyField era -> Maybe [KeyHash 'Witness (EraCrypto era)]
signview (ReqSignerHashes Set (KeyHash 'Witness (EraCrypto era))
x) = forall a. a -> Maybe a
Just (forall a. Set a -> [a]
fromSet Set (KeyHash 'Witness (EraCrypto era))
x)
signview TxBodyField era
_ = forall a. Maybe a
Nothing

pattern $bReqSignerHashes' :: forall era. [KeyHash 'Witness (EraCrypto era)] -> TxBodyField era
$mReqSignerHashes' :: forall {r} {era}.
TxBodyField era
-> ([KeyHash 'Witness (EraCrypto era)] -> r) -> ((# #) -> r) -> r
ReqSignerHashes' x <-
  (signview -> Just x)
  where
    ReqSignerHashes' [KeyHash 'Witness (EraCrypto era)]
x = forall era.
Set (KeyHash 'Witness (EraCrypto era)) -> TxBodyField era
ReqSignerHashes (forall a. Ord a => [a] -> Set a
toSet [KeyHash 'Witness (EraCrypto era)]
x)

updateview :: TxBodyField era -> Maybe [PP.Update era]
updateview :: forall era. TxBodyField era -> Maybe [Update era]
updateview (Update StrictMaybe (Update era)
x) = forall a. a -> Maybe a
Just (forall a. StrictMaybe a -> [a]
fromStrictMaybe StrictMaybe (Update era)
x)
updateview TxBodyField era
_ = forall a. Maybe a
Nothing

pattern $bUpdate' :: forall era. [Update era] -> TxBodyField era
$mUpdate' :: forall {r} {era}.
TxBodyField era -> ([Update era] -> r) -> ((# #) -> r) -> r
Update' x <-
  (updateview -> Just x)
  where
    Update' [Update era]
x = forall era. StrictMaybe (Update era) -> TxBodyField era
Update (forall a. [a] -> StrictMaybe a
toStrictMaybe [Update era]
x)

certsview :: TxBodyField era -> Maybe [TxCert era]
certsview :: forall era. TxBodyField era -> Maybe [TxCert era]
certsview (Certs StrictSeq (TxCert era)
x) = forall a. a -> Maybe a
Just (forall a. StrictSeq a -> [a]
fromStrictSeq StrictSeq (TxCert era)
x)
certsview TxBodyField era
_ = forall a. Maybe a
Nothing

pattern $bCerts' :: forall era. [TxCert era] -> TxBodyField era
$mCerts' :: forall {r} {era}.
TxBodyField era -> ([TxCert era] -> r) -> ((# #) -> r) -> r
Certs' x <-
  (certsview -> Just x)
  where
    Certs' [TxCert era]
x = forall era. StrictSeq (TxCert era) -> TxBodyField era
Certs (forall a. [a] -> StrictSeq a
toStrictSeq [TxCert era]
x)

colretview :: TxBodyField era -> Maybe [TxOut era]
colretview :: forall era. TxBodyField era -> Maybe [TxOut era]
colretview (CollateralReturn StrictMaybe (TxOut era)
x) = forall a. a -> Maybe a
Just (forall a. StrictMaybe a -> [a]
fromStrictMaybe StrictMaybe (TxOut era)
x)
colretview TxBodyField era
_ = forall a. Maybe a
Nothing

pattern $bCollateralReturn' :: forall era. [TxOut era] -> TxBodyField era
$mCollateralReturn' :: forall {r} {era}.
TxBodyField era -> ([TxOut era] -> r) -> ((# #) -> r) -> r
CollateralReturn' x <-
  (colretview -> Just x)
  where
    CollateralReturn' [TxOut era]
x = forall era. StrictMaybe (TxOut era) -> TxBodyField era
CollateralReturn (forall a. [a] -> StrictMaybe a
toStrictMaybe [TxOut era]
x)

outputview :: TxBodyField era -> Maybe [TxOut era]
outputview :: forall era. TxBodyField era -> Maybe [TxOut era]
outputview (Outputs StrictSeq (TxOut era)
x) = forall a. a -> Maybe a
Just (forall a. StrictSeq a -> [a]
fromStrictSeq StrictSeq (TxOut era)
x)
outputview TxBodyField era
_ = forall a. Maybe a
Nothing

pattern $bOutputs' :: forall era. [TxOut era] -> TxBodyField era
$mOutputs' :: forall {r} {era}.
TxBodyField era -> ([TxOut era] -> r) -> ((# #) -> r) -> r
Outputs' x <-
  (outputview -> Just x)
  where
    Outputs' [TxOut era]
x = forall era. StrictSeq (TxOut era) -> TxBodyField era
Outputs (forall a. [a] -> StrictSeq a
toStrictSeq [TxOut era]
x)

inputsview :: TxBodyField era -> Maybe [TxIn (EraCrypto era)]
inputsview :: forall era. TxBodyField era -> Maybe [TxIn (EraCrypto era)]
inputsview (Inputs Set (TxIn (EraCrypto era))
x) = forall a. a -> Maybe a
Just (forall a. Set a -> [a]
fromSet Set (TxIn (EraCrypto era))
x)
inputsview TxBodyField era
_ = forall a. Maybe a
Nothing

pattern $bInputs' :: forall era. [TxIn (EraCrypto era)] -> TxBodyField era
$mInputs' :: forall {r} {era}.
TxBodyField era
-> ([TxIn (EraCrypto era)] -> r) -> ((# #) -> r) -> r
Inputs' x <-
  (inputsview -> Just x)
  where
    Inputs' [TxIn (EraCrypto era)]
x = forall era. Set (TxIn (EraCrypto era)) -> TxBodyField era
Inputs (forall a. Ord a => [a] -> Set a
toSet [TxIn (EraCrypto era)]
x)

colview :: TxBodyField era -> Maybe [TxIn (EraCrypto era)]
colview :: forall era. TxBodyField era -> Maybe [TxIn (EraCrypto era)]
colview (Collateral Set (TxIn (EraCrypto era))
x) = forall a. a -> Maybe a
Just (forall a. Set a -> [a]
fromSet Set (TxIn (EraCrypto era))
x)
colview TxBodyField era
_ = forall a. Maybe a
Nothing

pattern $bCollateral' :: forall era. [TxIn (EraCrypto era)] -> TxBodyField era
$mCollateral' :: forall {r} {era}.
TxBodyField era
-> ([TxIn (EraCrypto era)] -> r) -> ((# #) -> r) -> r
Collateral' x <-
  (colview -> Just x)
  where
    Collateral' [TxIn (EraCrypto era)]
x = forall era. Set (TxIn (EraCrypto era)) -> TxBodyField era
Collateral (forall a. Ord a => [a] -> Set a
toSet [TxIn (EraCrypto era)]
x)

refview :: TxBodyField era -> Maybe [TxIn (EraCrypto era)]
refview :: forall era. TxBodyField era -> Maybe [TxIn (EraCrypto era)]
refview (RefInputs Set (TxIn (EraCrypto era))
x) = forall a. a -> Maybe a
Just (forall a. Set a -> [a]
fromSet Set (TxIn (EraCrypto era))
x)
refview TxBodyField era
_ = forall a. Maybe a
Nothing

pattern $bRefInputs' :: forall era. [TxIn (EraCrypto era)] -> TxBodyField era
$mRefInputs' :: forall {r} {era}.
TxBodyField era
-> ([TxIn (EraCrypto era)] -> r) -> ((# #) -> r) -> r
RefInputs' x <-
  (refview -> Just x)
  where
    RefInputs' [TxIn (EraCrypto era)]
x = forall era. Set (TxIn (EraCrypto era)) -> TxBodyField era
RefInputs (forall a. Ord a => [a] -> Set a
toSet [TxIn (EraCrypto era)]
x)

-- =============================
-- Tx patterns

validview :: TxField era -> Maybe Bool
validview :: forall era. TxField era -> Maybe Bool
validview (Valid IsValid
x) = forall a. a -> Maybe a
Just (IsValid -> Bool
valid IsValid
x)
validview TxField era
_ = forall a. Maybe a
Nothing

pattern $bValid' :: forall era. Bool -> TxField era
$mValid' :: forall {r} {era}. TxField era -> (Bool -> r) -> ((# #) -> r) -> r
Valid' x <-
  (validview -> Just x)
  where
    Valid' Bool
x = forall era. IsValid -> TxField era
Valid (Bool -> IsValid
IsValid Bool
x)

auxdataview :: TxField era -> Maybe [TxAuxData era]
auxdataview :: forall era. TxField era -> Maybe [TxAuxData era]
auxdataview (AuxData StrictMaybe (TxAuxData era)
x) = forall a. a -> Maybe a
Just (forall a. StrictMaybe a -> [a]
fromStrictMaybe StrictMaybe (TxAuxData era)
x)
auxdataview TxField era
_ = forall a. Maybe a
Nothing

pattern $bAuxData' :: forall era. [TxAuxData era] -> TxField era
$mAuxData' :: forall {r} {era}.
TxField era -> ([TxAuxData era] -> r) -> ((# #) -> r) -> r
AuxData' x <-
  (auxdataview -> Just x)
  where
    AuxData' [TxAuxData era]
x = forall era. StrictMaybe (TxAuxData era) -> TxField era
AuxData (forall a. [a] -> StrictMaybe a
toStrictMaybe [TxAuxData era]
x)

-- =======================
-- WitnessesField Patterns

datawitsview :: forall era. Era era => WitnessesField era -> Maybe [Data era]
datawitsview :: forall era. Era era => WitnessesField era -> Maybe [Data era]
datawitsview (DataWits (TxDats Map (DataHash (EraCrypto era)) (Data era)
x)) = forall a. a -> Maybe a
Just (forall k a. Map k a -> [a]
Map.elems Map (DataHash (EraCrypto era)) (Data era)
x)
datawitsview WitnessesField era
_ = forall a. Maybe a
Nothing

pattern $bDataWits' :: forall era. Era era => [Data era] -> WitnessesField era
$mDataWits' :: forall {r} {era}.
Era era =>
WitnessesField era -> ([Data era] -> r) -> ((# #) -> r) -> r
DataWits' x <-
  (datawitsview -> Just x)
  where
    DataWits' [Data era]
x = forall era. TxDats era -> WitnessesField era
DataWits (forall era. Era era => [Data era] -> TxDats era
toMapDat [Data era]
x)

scriptview :: forall era. WitnessesField era -> Maybe [Script era]
scriptview :: forall era. WitnessesField era -> Maybe [Script era]
scriptview (ScriptWits Map (ScriptHash (EraCrypto era)) (Script era)
x) = forall a. a -> Maybe a
Just (forall era.
Map (ScriptHash (EraCrypto era)) (Script era) -> [Script era]
fromMapScript @era Map (ScriptHash (EraCrypto era)) (Script era)
x)
scriptview WitnessesField era
_ = forall a. Maybe a
Nothing

pattern $bScriptWits' :: forall era. EraScript era => [Script era] -> WitnessesField era
$mScriptWits' :: forall {r} {era}.
EraScript era =>
WitnessesField era -> ([Script era] -> r) -> ((# #) -> r) -> r
ScriptWits' x <-
  (scriptview -> Just x)
  where
    ScriptWits' [Script era]
x = forall era.
Map (ScriptHash (EraCrypto era)) (Script era) -> WitnessesField era
ScriptWits (forall era.
EraScript era =>
[Script era] -> Map (ScriptHash (EraCrypto era)) (Script era)
toMapScript @era [Script era]
x)

addrview :: WitnessesField era -> Maybe [WitVKey 'Witness (EraCrypto era)]
addrview :: forall era.
WitnessesField era -> Maybe [WitVKey 'Witness (EraCrypto era)]
addrview (AddrWits Set (WitVKey 'Witness (EraCrypto era))
x) = forall a. a -> Maybe a
Just (forall a. Set a -> [a]
fromSet Set (WitVKey 'Witness (EraCrypto era))
x)
addrview WitnessesField era
_ = forall a. Maybe a
Nothing

pattern $bAddrWits' :: forall era.
Era era =>
[WitVKey 'Witness (EraCrypto era)] -> WitnessesField era
$mAddrWits' :: forall {r} {era}.
Era era =>
WitnessesField era
-> ([WitVKey 'Witness (EraCrypto era)] -> r) -> ((# #) -> r) -> r
AddrWits' x <-
  (addrview -> Just x)
  where
    AddrWits' [WitVKey 'Witness (EraCrypto era)]
x = forall era.
Set (WitVKey 'Witness (EraCrypto era)) -> WitnessesField era
AddrWits (forall a. Ord a => [a] -> Set a
toSet [WitVKey 'Witness (EraCrypto era)]
x)

bootview :: WitnessesField era -> Maybe [BootstrapWitness (EraCrypto era)]
bootview :: forall era.
WitnessesField era -> Maybe [BootstrapWitness (EraCrypto era)]
bootview (BootWits Set (BootstrapWitness (EraCrypto era))
x) = forall a. a -> Maybe a
Just (forall a. Set a -> [a]
fromSet Set (BootstrapWitness (EraCrypto era))
x)
bootview WitnessesField era
_ = forall a. Maybe a
Nothing

pattern $bBootWits' :: forall era.
Era era =>
[BootstrapWitness (EraCrypto era)] -> WitnessesField era
$mBootWits' :: forall {r} {era}.
Era era =>
WitnessesField era
-> ([BootstrapWitness (EraCrypto era)] -> r) -> ((# #) -> r) -> r
BootWits' x <-
  (bootview -> Just x)
  where
    BootWits' [BootstrapWitness (EraCrypto era)]
x = forall era.
Set (BootstrapWitness (EraCrypto era)) -> WitnessesField era
BootWits (forall a. Ord a => [a] -> Set a
toSet [BootstrapWitness (EraCrypto era)]
x)

-- ========================================
-- TxOut patterns

refscriptview :: TxOutField era -> Maybe [Script era]
refscriptview :: forall era. TxOutField era -> Maybe [Script era]
refscriptview (RefScript StrictMaybe (Script era)
x) = forall a. a -> Maybe a
Just (forall a. StrictMaybe a -> [a]
fromStrictMaybe StrictMaybe (Script era)
x)
refscriptview TxOutField era
_ = forall a. Maybe a
Nothing

pattern $bRefScript' :: forall era. [Script era] -> TxOutField era
$mRefScript' :: forall {r} {era}.
TxOutField era -> ([Script era] -> r) -> ((# #) -> r) -> r
RefScript' x <-
  (refscriptview -> Just x)
  where
    RefScript' [Script era]
x = forall era. StrictMaybe (Script era) -> TxOutField era
RefScript (forall a. [a] -> StrictMaybe a
toStrictMaybe [Script era]
x)

dhashview :: TxOutField era -> Maybe [DataHash (EraCrypto era)]
dhashview :: forall era. TxOutField era -> Maybe [DataHash (EraCrypto era)]
dhashview (DHash StrictMaybe (DataHash (EraCrypto era))
x) = forall a. a -> Maybe a
Just (forall a. StrictMaybe a -> [a]
fromStrictMaybe StrictMaybe (DataHash (EraCrypto era))
x)
dhashview TxOutField era
_ = forall a. Maybe a
Nothing

pattern $bDHash' :: forall era. [DataHash (EraCrypto era)] -> TxOutField era
$mDHash' :: forall {r} {era}.
TxOutField era
-> ([DataHash (EraCrypto era)] -> r) -> ((# #) -> r) -> r
DHash' x <-
  (dhashview -> Just x)
  where
    DHash' [DataHash (EraCrypto era)]
x = forall era.
StrictMaybe (DataHash (EraCrypto era)) -> TxOutField era
DHash (forall a. [a] -> StrictMaybe a
toStrictMaybe [DataHash (EraCrypto era)]
x)