{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Conway.TxBody (
  ConwayEraTxBody (..),
  TxBody (
    MkConwayTxBody,
    ConwayTxBody,
    ctbSpendInputs,
    ctbCollateralInputs,
    ctbReferenceInputs,
    ctbOutputs,
    ctbCollateralReturn,
    ctbTotalCollateral,
    ctbCerts,
    ctbWithdrawals,
    ctbTxfee,
    ctbVldt,
    ctbReqSignerHashes,
    ctbMint,
    ctbScriptIntegrityHash,
    ctbAdHash,
    ctbTxNetworkId,
    ctbVotingProcedures,
    ctbProposalProcedures,
    ctbCurrentTreasuryValue,
    ctbTreasuryDonation
  ),
  ConwayTxBodyRaw (..),
  conwayTotalDepositsTxBody,
  conwayProposalsDeposits,
) where

import Cardano.Ledger.Alonzo.TxBody (Indexable (..))
import Cardano.Ledger.Babbage.Core
import Cardano.Ledger.Babbage.TxBody (
  TxBody (..),
  allSizedOutputsBabbageTxBodyF,
  babbageAllInputsTxBodyF,
  babbageSpendableInputsTxBodyF,
 )
import Cardano.Ledger.BaseTypes (Network, fromSMaybe, isSJust)
import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
  Sized (..),
  ToCBOR (..),
  mkSized,
 )
import Cardano.Ledger.Binary.Coders (
  Decode (..),
  Density (..),
  Encode (..),
  Field (..),
  Wrapped (..),
  decode,
  encode,
  encodeKeyedStrictMaybe,
  field,
  fieldGuarded,
  invalidField,
  ofield,
  (!>),
 )
import Cardano.Ledger.Coin (Coin (..), decodePositiveCoin)
import Cardano.Ledger.Conway.Era (ConwayEra)
import Cardano.Ledger.Conway.Governance.Procedures (ProposalProcedure, VotingProcedures (..))
import Cardano.Ledger.Conway.PParams (ConwayEraPParams, ppGovActionDepositL)
import Cardano.Ledger.Conway.Scripts (ConwayEraScript, ConwayPlutusPurpose (..))
import Cardano.Ledger.Conway.TxCert (
  ConwayEraTxCert,
  ConwayTxCertUpgradeError,
 )
import Cardano.Ledger.Conway.TxOut ()
import Cardano.Ledger.Mary.Value (MultiAsset (..), policies)
import Cardano.Ledger.MemoBytes (
  EqRaw,
  MemoBytes (..),
  MemoHashIndex,
  Memoized (..),
  getMemoRawType,
  getMemoSafeHash,
  lensMemoRawType,
  mkMemoizedEra,
 )
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.Ledger.Val (Val (..))
import Control.Arrow (left)
import Control.DeepSeq (NFData)
import Control.Monad (unless, when)
import Data.Maybe.Strict (StrictMaybe (..))
import qualified Data.OSet.Strict as OSet
import Data.Sequence.Strict (StrictSeq)
import Data.Set (Set)
import GHC.Generics (Generic)
import Lens.Micro (Lens', to, (^.))
import NoThunks.Class (NoThunks)

instance Memoized (TxBody ConwayEra) where
  type RawType (TxBody ConwayEra) = ConwayTxBodyRaw

data ConwayTxBodyRaw = ConwayTxBodyRaw
  { ConwayTxBodyRaw -> Set TxIn
ctbrSpendInputs :: !(Set TxIn)
  , ConwayTxBodyRaw -> Set TxIn
ctbrCollateralInputs :: !(Set TxIn)
  , ConwayTxBodyRaw -> Set TxIn
ctbrReferenceInputs :: !(Set TxIn)
  , ConwayTxBodyRaw -> StrictSeq (Sized (TxOut ConwayEra))
ctbrOutputs :: !(StrictSeq (Sized (TxOut ConwayEra)))
  , ConwayTxBodyRaw -> StrictMaybe (Sized (TxOut ConwayEra))
ctbrCollateralReturn :: !(StrictMaybe (Sized (TxOut ConwayEra)))
  , ConwayTxBodyRaw -> StrictMaybe Coin
ctbrTotalCollateral :: !(StrictMaybe Coin)
  , ConwayTxBodyRaw -> OSet (TxCert ConwayEra)
ctbrCerts :: !(OSet.OSet (TxCert ConwayEra))
  , ConwayTxBodyRaw -> Withdrawals
ctbrWithdrawals :: !Withdrawals
  , ConwayTxBodyRaw -> Coin
ctbrFee :: !Coin
  , ConwayTxBodyRaw -> ValidityInterval
ctbrVldt :: !ValidityInterval
  , ConwayTxBodyRaw -> Set (KeyHash 'Witness)
ctbrReqSignerHashes :: !(Set (KeyHash 'Witness))
  , ConwayTxBodyRaw -> MultiAsset
ctbrMint :: !MultiAsset
  , ConwayTxBodyRaw -> StrictMaybe ScriptIntegrityHash
ctbrScriptIntegrityHash :: !(StrictMaybe ScriptIntegrityHash)
  , ConwayTxBodyRaw -> StrictMaybe TxAuxDataHash
ctbrAuxDataHash :: !(StrictMaybe TxAuxDataHash)
  , ConwayTxBodyRaw -> StrictMaybe Network
ctbrNetworkId :: !(StrictMaybe Network)
  , ConwayTxBodyRaw -> VotingProcedures ConwayEra
ctbrVotingProcedures :: !(VotingProcedures ConwayEra)
  , ConwayTxBodyRaw -> OSet (ProposalProcedure ConwayEra)
ctbrProposalProcedures :: !(OSet.OSet (ProposalProcedure ConwayEra))
  , ConwayTxBodyRaw -> StrictMaybe Coin
ctbrCurrentTreasuryValue :: !(StrictMaybe Coin)
  , ConwayTxBodyRaw -> Coin
ctbrTreasuryDonation :: !Coin
  }
  deriving ((forall x. ConwayTxBodyRaw -> Rep ConwayTxBodyRaw x)
-> (forall x. Rep ConwayTxBodyRaw x -> ConwayTxBodyRaw)
-> Generic ConwayTxBodyRaw
forall x. Rep ConwayTxBodyRaw x -> ConwayTxBodyRaw
forall x. ConwayTxBodyRaw -> Rep ConwayTxBodyRaw x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConwayTxBodyRaw -> Rep ConwayTxBodyRaw x
from :: forall x. ConwayTxBodyRaw -> Rep ConwayTxBodyRaw x
$cto :: forall x. Rep ConwayTxBodyRaw x -> ConwayTxBodyRaw
to :: forall x. Rep ConwayTxBodyRaw x -> ConwayTxBodyRaw
Generic)

deriving instance Eq ConwayTxBodyRaw

instance NoThunks ConwayTxBodyRaw

instance NFData ConwayTxBodyRaw

deriving instance Show ConwayTxBodyRaw

instance DecCBOR ConwayTxBodyRaw where
  decCBOR :: forall s. Decoder s ConwayTxBodyRaw
decCBOR =
    Decode ('Closed 'Dense) ConwayTxBodyRaw
-> Decoder s ConwayTxBodyRaw
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) ConwayTxBodyRaw
 -> Decoder s ConwayTxBodyRaw)
-> Decode ('Closed 'Dense) ConwayTxBodyRaw
-> Decoder s ConwayTxBodyRaw
forall a b. (a -> b) -> a -> b
$
      String
-> ConwayTxBodyRaw
-> (Word -> Field ConwayTxBodyRaw)
-> [(Word, String)]
-> Decode ('Closed 'Dense) ConwayTxBodyRaw
forall t.
Typeable t =>
String
-> t
-> (Word -> Field t)
-> [(Word, String)]
-> Decode ('Closed 'Dense) t
SparseKeyed
        String
"TxBodyRaw"
        ConwayTxBodyRaw
basicConwayTxBodyRaw
        Word -> Field ConwayTxBodyRaw
bodyFields
        [(Word, String)]
requiredFields
    where
      bodyFields :: Word -> Field ConwayTxBodyRaw
      bodyFields :: Word -> Field ConwayTxBodyRaw
bodyFields Word
0 = (Set TxIn -> ConwayTxBodyRaw -> ConwayTxBodyRaw)
-> Decode ('Closed Any) (Set TxIn) -> Field ConwayTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Set TxIn
x ConwayTxBodyRaw
tx -> ConwayTxBodyRaw
tx {ctbrSpendInputs = x}) Decode ('Closed Any) (Set TxIn)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
1 = (StrictSeq (Sized (BabbageTxOut ConwayEra))
 -> ConwayTxBodyRaw -> ConwayTxBodyRaw)
-> Decode
     ('Closed Any) (StrictSeq (Sized (BabbageTxOut ConwayEra)))
-> Field ConwayTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\StrictSeq (Sized (BabbageTxOut ConwayEra))
x ConwayTxBodyRaw
tx -> ConwayTxBodyRaw
tx {ctbrOutputs = x}) Decode ('Closed Any) (StrictSeq (Sized (BabbageTxOut ConwayEra)))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
2 = (Coin -> ConwayTxBodyRaw -> ConwayTxBodyRaw)
-> Decode ('Closed Any) Coin -> Field ConwayTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Coin
x ConwayTxBodyRaw
tx -> ConwayTxBodyRaw
tx {ctbrFee = x}) Decode ('Closed Any) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
3 =
        (StrictMaybe SlotNo -> ConwayTxBodyRaw -> ConwayTxBodyRaw)
-> Decode ('Closed Any) SlotNo -> Field ConwayTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield
          (\StrictMaybe SlotNo
x ConwayTxBodyRaw
tx -> ConwayTxBodyRaw
tx {ctbrVldt = (ctbrVldt tx) {invalidHereafter = x}})
          Decode ('Closed Any) SlotNo
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
4 =
        String
-> (OSet (ConwayTxCert ConwayEra) -> Bool)
-> (OSet (ConwayTxCert ConwayEra)
    -> ConwayTxBodyRaw -> ConwayTxBodyRaw)
-> Decode ('Closed Any) (OSet (ConwayTxCert ConwayEra))
-> Field ConwayTxBodyRaw
forall x t (d :: Density).
Typeable x =>
String
-> (x -> Bool) -> (x -> t -> t) -> Decode ('Closed d) x -> Field t
fieldGuarded
          (String -> ShowS
emptyFailure String
"Certificates" String
"non-empty")
          OSet (ConwayTxCert ConwayEra) -> Bool
forall a. OSet a -> Bool
OSet.null
          (\OSet (ConwayTxCert ConwayEra)
x ConwayTxBodyRaw
tx -> ConwayTxBodyRaw
tx {ctbrCerts = x})
          Decode ('Closed Any) (OSet (ConwayTxCert ConwayEra))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
5 =
        String
-> (Withdrawals -> Bool)
-> (Withdrawals -> ConwayTxBodyRaw -> ConwayTxBodyRaw)
-> Decode ('Closed Any) Withdrawals
-> Field ConwayTxBodyRaw
forall x t (d :: Density).
Typeable x =>
String
-> (x -> Bool) -> (x -> t -> t) -> Decode ('Closed d) x -> Field t
fieldGuarded
          (String -> ShowS
emptyFailure String
"Withdrawals" String
"non-empty")
          (Map RewardAccount Coin -> Bool
forall a. Map RewardAccount a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map RewardAccount Coin -> Bool)
-> (Withdrawals -> Map RewardAccount Coin) -> Withdrawals -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Withdrawals -> Map RewardAccount Coin
unWithdrawals)
          (\Withdrawals
x ConwayTxBodyRaw
tx -> ConwayTxBodyRaw
tx {ctbrWithdrawals = x})
          Decode ('Closed Any) Withdrawals
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
7 = (StrictMaybe TxAuxDataHash -> ConwayTxBodyRaw -> ConwayTxBodyRaw)
-> Decode ('Closed Any) TxAuxDataHash -> Field ConwayTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield (\StrictMaybe TxAuxDataHash
x ConwayTxBodyRaw
tx -> ConwayTxBodyRaw
tx {ctbrAuxDataHash = x}) Decode ('Closed Any) TxAuxDataHash
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
8 =
        (StrictMaybe SlotNo -> ConwayTxBodyRaw -> ConwayTxBodyRaw)
-> Decode ('Closed Any) SlotNo -> Field ConwayTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield
          (\StrictMaybe SlotNo
x ConwayTxBodyRaw
tx -> ConwayTxBodyRaw
tx {ctbrVldt = (ctbrVldt tx) {invalidBefore = x}})
          Decode ('Closed Any) SlotNo
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
9 =
        String
-> (MultiAsset -> Bool)
-> (MultiAsset -> ConwayTxBodyRaw -> ConwayTxBodyRaw)
-> Decode ('Closed Any) MultiAsset
-> Field ConwayTxBodyRaw
forall x t (d :: Density).
Typeable x =>
String
-> (x -> Bool) -> (x -> t -> t) -> Decode ('Closed d) x -> Field t
fieldGuarded
          (String -> ShowS
emptyFailure String
"Mint" String
"non-empty")
          (MultiAsset -> MultiAsset -> Bool
forall a. Eq a => a -> a -> Bool
== MultiAsset
forall a. Monoid a => a
mempty)
          (\MultiAsset
x ConwayTxBodyRaw
tx -> ConwayTxBodyRaw
tx {ctbrMint = x})
          Decode ('Closed Any) MultiAsset
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
11 = (StrictMaybe ScriptIntegrityHash
 -> ConwayTxBodyRaw -> ConwayTxBodyRaw)
-> Decode ('Closed Any) ScriptIntegrityHash
-> Field ConwayTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield (\StrictMaybe ScriptIntegrityHash
x ConwayTxBodyRaw
tx -> ConwayTxBodyRaw
tx {ctbrScriptIntegrityHash = x}) Decode ('Closed Any) ScriptIntegrityHash
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
13 =
        String
-> (Set TxIn -> Bool)
-> (Set TxIn -> ConwayTxBodyRaw -> ConwayTxBodyRaw)
-> Decode ('Closed Any) (Set TxIn)
-> Field ConwayTxBodyRaw
forall x t (d :: Density).
Typeable x =>
String
-> (x -> Bool) -> (x -> t -> t) -> Decode ('Closed d) x -> Field t
fieldGuarded
          (String -> ShowS
emptyFailure String
"Collateral Inputs" String
"non-empty")
          Set TxIn -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
          (\Set TxIn
x ConwayTxBodyRaw
tx -> ConwayTxBodyRaw
tx {ctbrCollateralInputs = x})
          Decode ('Closed Any) (Set TxIn)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
14 =
        String
-> (Set (KeyHash 'Witness) -> Bool)
-> (Set (KeyHash 'Witness) -> ConwayTxBodyRaw -> ConwayTxBodyRaw)
-> Decode ('Closed Any) (Set (KeyHash 'Witness))
-> Field ConwayTxBodyRaw
forall x t (d :: Density).
Typeable x =>
String
-> (x -> Bool) -> (x -> t -> t) -> Decode ('Closed d) x -> Field t
fieldGuarded
          (String -> ShowS
emptyFailure String
"Required Signer Hashes" String
"non-empty")
          Set (KeyHash 'Witness) -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
          (\Set (KeyHash 'Witness)
x ConwayTxBodyRaw
tx -> ConwayTxBodyRaw
tx {ctbrReqSignerHashes = x})
          Decode ('Closed Any) (Set (KeyHash 'Witness))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
15 = (StrictMaybe Network -> ConwayTxBodyRaw -> ConwayTxBodyRaw)
-> Decode ('Closed Any) Network -> Field ConwayTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield (\StrictMaybe Network
x ConwayTxBodyRaw
tx -> ConwayTxBodyRaw
tx {ctbrNetworkId = x}) Decode ('Closed Any) Network
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
16 = (StrictMaybe (Sized (BabbageTxOut ConwayEra))
 -> ConwayTxBodyRaw -> ConwayTxBodyRaw)
-> Decode ('Closed Any) (Sized (BabbageTxOut ConwayEra))
-> Field ConwayTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield (\StrictMaybe (Sized (BabbageTxOut ConwayEra))
x ConwayTxBodyRaw
tx -> ConwayTxBodyRaw
tx {ctbrCollateralReturn = x}) Decode ('Closed Any) (Sized (BabbageTxOut ConwayEra))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
17 = (StrictMaybe Coin -> ConwayTxBodyRaw -> ConwayTxBodyRaw)
-> Decode ('Closed Any) Coin -> Field ConwayTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield (\StrictMaybe Coin
x ConwayTxBodyRaw
tx -> ConwayTxBodyRaw
tx {ctbrTotalCollateral = x}) Decode ('Closed Any) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
18 =
        String
-> (Set TxIn -> Bool)
-> (Set TxIn -> ConwayTxBodyRaw -> ConwayTxBodyRaw)
-> Decode ('Closed Any) (Set TxIn)
-> Field ConwayTxBodyRaw
forall x t (d :: Density).
Typeable x =>
String
-> (x -> Bool) -> (x -> t -> t) -> Decode ('Closed d) x -> Field t
fieldGuarded
          (String -> ShowS
emptyFailure String
"Reference Inputs" String
"non-empty")
          Set TxIn -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
          (\Set TxIn
x ConwayTxBodyRaw
tx -> ConwayTxBodyRaw
tx {ctbrReferenceInputs = x})
          Decode ('Closed Any) (Set TxIn)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
19 =
        String
-> (VotingProcedures ConwayEra -> Bool)
-> (VotingProcedures ConwayEra
    -> ConwayTxBodyRaw -> ConwayTxBodyRaw)
-> Decode ('Closed Any) (VotingProcedures ConwayEra)
-> Field ConwayTxBodyRaw
forall x t (d :: Density).
Typeable x =>
String
-> (x -> Bool) -> (x -> t -> t) -> Decode ('Closed d) x -> Field t
fieldGuarded
          (String -> ShowS
emptyFailure String
"VotingProcedures" String
"non-empty")
          (Map Voter (Map GovActionId (VotingProcedure ConwayEra)) -> Bool
forall a. Map Voter a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map Voter (Map GovActionId (VotingProcedure ConwayEra)) -> Bool)
-> (VotingProcedures ConwayEra
    -> Map Voter (Map GovActionId (VotingProcedure ConwayEra)))
-> VotingProcedures ConwayEra
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VotingProcedures ConwayEra
-> Map Voter (Map GovActionId (VotingProcedure ConwayEra))
forall era.
VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
unVotingProcedures)
          (\VotingProcedures ConwayEra
x ConwayTxBodyRaw
tx -> ConwayTxBodyRaw
tx {ctbrVotingProcedures = x})
          Decode ('Closed Any) (VotingProcedures ConwayEra)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
20 =
        String
-> (OSet (ProposalProcedure ConwayEra) -> Bool)
-> (OSet (ProposalProcedure ConwayEra)
    -> ConwayTxBodyRaw -> ConwayTxBodyRaw)
-> Decode ('Closed Any) (OSet (ProposalProcedure ConwayEra))
-> Field ConwayTxBodyRaw
forall x t (d :: Density).
Typeable x =>
String
-> (x -> Bool) -> (x -> t -> t) -> Decode ('Closed d) x -> Field t
fieldGuarded
          (String -> ShowS
emptyFailure String
"ProposalProcedures" String
"non-empty")
          OSet (ProposalProcedure ConwayEra) -> Bool
forall a. OSet a -> Bool
OSet.null
          (\OSet (ProposalProcedure ConwayEra)
x ConwayTxBodyRaw
tx -> ConwayTxBodyRaw
tx {ctbrProposalProcedures = x})
          Decode ('Closed Any) (OSet (ProposalProcedure ConwayEra))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
21 = (StrictMaybe Coin -> ConwayTxBodyRaw -> ConwayTxBodyRaw)
-> Decode ('Closed Any) Coin -> Field ConwayTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield (\StrictMaybe Coin
x ConwayTxBodyRaw
tx -> ConwayTxBodyRaw
tx {ctbrCurrentTreasuryValue = x}) Decode ('Closed Any) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
22 =
        (StrictMaybe Coin -> ConwayTxBodyRaw -> ConwayTxBodyRaw)
-> Decode ('Closed 'Dense) Coin -> Field ConwayTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield
          (\StrictMaybe Coin
x ConwayTxBodyRaw
tx -> ConwayTxBodyRaw
tx {ctbrTreasuryDonation = fromSMaybe zero x})
          ((forall s. Decoder s Coin) -> Decode ('Closed 'Dense) Coin
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (String -> Decoder s Coin
forall s. String -> Decoder s Coin
decodePositiveCoin (String -> Decoder s Coin) -> String -> Decoder s Coin
forall a b. (a -> b) -> a -> b
$ String -> ShowS
emptyFailure String
"Treasury Donation" String
"non-zero"))
      bodyFields Word
n = Word -> Field ConwayTxBodyRaw
forall t. Word -> Field t
invalidField Word
n
      requiredFields :: [(Word, String)]
      requiredFields :: [(Word, String)]
requiredFields =
        [ (Word
0, String
"inputs")
        , (Word
1, String
"outputs")
        , (Word
2, String
"fee")
        ]
      emptyFailure :: String -> ShowS
emptyFailure String
fieldName String
requirement =
        String
"TxBody: '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
fieldName String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"' must be " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
requirement String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" when supplied"

deriving newtype instance DecCBOR (TxBody ConwayEra)

deriving instance NoThunks (TxBody ConwayEra)

deriving instance Eq (TxBody ConwayEra)

deriving newtype instance NFData (TxBody ConwayEra)

deriving instance Show (TxBody ConwayEra)

type instance MemoHashIndex ConwayTxBodyRaw = EraIndependentTxBody

instance HashAnnotated (TxBody ConwayEra) EraIndependentTxBody where
  hashAnnotated :: TxBody ConwayEra -> SafeHash EraIndependentTxBody
hashAnnotated = TxBody ConwayEra -> SafeHash EraIndependentTxBody
TxBody ConwayEra
-> SafeHash (MemoHashIndex (RawType (TxBody ConwayEra)))
forall t. Memoized t => t -> SafeHash (MemoHashIndex (RawType t))
getMemoSafeHash

mkConwayTxBody :: TxBody ConwayEra
mkConwayTxBody :: TxBody ConwayEra
mkConwayTxBody = forall era t.
(Era era, EncCBOR (RawType t), Memoized t) =>
RawType t -> t
mkMemoizedEra @ConwayEra RawType (TxBody ConwayEra)
ConwayTxBodyRaw
basicConwayTxBodyRaw

basicConwayTxBodyRaw :: ConwayTxBodyRaw
basicConwayTxBodyRaw :: ConwayTxBodyRaw
basicConwayTxBodyRaw =
  Set TxIn
-> Set TxIn
-> Set TxIn
-> StrictSeq (Sized (TxOut ConwayEra))
-> StrictMaybe (Sized (TxOut ConwayEra))
-> StrictMaybe Coin
-> OSet (TxCert ConwayEra)
-> Withdrawals
-> Coin
-> ValidityInterval
-> Set (KeyHash 'Witness)
-> MultiAsset
-> StrictMaybe ScriptIntegrityHash
-> StrictMaybe TxAuxDataHash
-> StrictMaybe Network
-> VotingProcedures ConwayEra
-> OSet (ProposalProcedure ConwayEra)
-> StrictMaybe Coin
-> Coin
-> ConwayTxBodyRaw
ConwayTxBodyRaw
    Set TxIn
forall a. Monoid a => a
mempty
    Set TxIn
forall a. Monoid a => a
mempty
    Set TxIn
forall a. Monoid a => a
mempty
    StrictSeq (Sized (TxOut ConwayEra))
StrictSeq (Sized (BabbageTxOut ConwayEra))
forall a. Monoid a => a
mempty
    StrictMaybe (Sized (TxOut ConwayEra))
StrictMaybe (Sized (BabbageTxOut ConwayEra))
forall a. StrictMaybe a
SNothing
    StrictMaybe Coin
forall a. StrictMaybe a
SNothing
    OSet (TxCert ConwayEra)
OSet (ConwayTxCert ConwayEra)
forall a. OSet a
OSet.empty
    (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
forall a. Monoid a => a
mempty)
    Coin
forall a. Monoid a => a
mempty
    (StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval StrictMaybe SlotNo
forall a. StrictMaybe a
SNothing StrictMaybe SlotNo
forall a. StrictMaybe a
SNothing)
    Set (KeyHash 'Witness)
forall a. Monoid a => a
mempty
    MultiAsset
forall a. Monoid a => a
mempty
    StrictMaybe ScriptIntegrityHash
forall a. StrictMaybe a
SNothing
    StrictMaybe TxAuxDataHash
forall a. StrictMaybe a
SNothing
    StrictMaybe Network
forall a. StrictMaybe a
SNothing
    (Map Voter (Map GovActionId (VotingProcedure ConwayEra))
-> VotingProcedures ConwayEra
forall era.
Map Voter (Map GovActionId (VotingProcedure era))
-> VotingProcedures era
VotingProcedures Map Voter (Map GovActionId (VotingProcedure ConwayEra))
forall a. Monoid a => a
mempty)
    OSet (ProposalProcedure ConwayEra)
forall a. OSet a
OSet.empty
    StrictMaybe Coin
forall a. StrictMaybe a
SNothing
    Coin
forall a. Monoid a => a
mempty

data ConwayTxBodyUpgradeError
  = CTBUETxCert ConwayTxCertUpgradeError
  | -- | The TxBody contains an update proposal from a pre-Conway era. Since
    --   this can only have come from the genesis delegates, we just discard it.
    CTBUEContainsUpdate
  | -- | In eras prior to Conway duplicate certificates where allowed
    CTBUEContainsDuplicateCerts (Set (TxCert ConwayEra))
  deriving (ConwayTxBodyUpgradeError -> ConwayTxBodyUpgradeError -> Bool
(ConwayTxBodyUpgradeError -> ConwayTxBodyUpgradeError -> Bool)
-> (ConwayTxBodyUpgradeError -> ConwayTxBodyUpgradeError -> Bool)
-> Eq ConwayTxBodyUpgradeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConwayTxBodyUpgradeError -> ConwayTxBodyUpgradeError -> Bool
== :: ConwayTxBodyUpgradeError -> ConwayTxBodyUpgradeError -> Bool
$c/= :: ConwayTxBodyUpgradeError -> ConwayTxBodyUpgradeError -> Bool
/= :: ConwayTxBodyUpgradeError -> ConwayTxBodyUpgradeError -> Bool
Eq, Int -> ConwayTxBodyUpgradeError -> ShowS
[ConwayTxBodyUpgradeError] -> ShowS
ConwayTxBodyUpgradeError -> String
(Int -> ConwayTxBodyUpgradeError -> ShowS)
-> (ConwayTxBodyUpgradeError -> String)
-> ([ConwayTxBodyUpgradeError] -> ShowS)
-> Show ConwayTxBodyUpgradeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConwayTxBodyUpgradeError -> ShowS
showsPrec :: Int -> ConwayTxBodyUpgradeError -> ShowS
$cshow :: ConwayTxBodyUpgradeError -> String
show :: ConwayTxBodyUpgradeError -> String
$cshowList :: [ConwayTxBodyUpgradeError] -> ShowS
showList :: [ConwayTxBodyUpgradeError] -> ShowS
Show)

instance EraTxBody ConwayEra where
  newtype TxBody ConwayEra = MkConwayTxBody (MemoBytes ConwayTxBodyRaw)
    deriving ((forall x. TxBody ConwayEra -> Rep (TxBody ConwayEra) x)
-> (forall x. Rep (TxBody ConwayEra) x -> TxBody ConwayEra)
-> Generic (TxBody ConwayEra)
forall x. Rep (TxBody ConwayEra) x -> TxBody ConwayEra
forall x. TxBody ConwayEra -> Rep (TxBody ConwayEra) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TxBody ConwayEra -> Rep (TxBody ConwayEra) x
from :: forall x. TxBody ConwayEra -> Rep (TxBody ConwayEra) x
$cto :: forall x. Rep (TxBody ConwayEra) x -> TxBody ConwayEra
to :: forall x. Rep (TxBody ConwayEra) x -> TxBody ConwayEra
Generic, TxBody ConwayEra -> Int
TxBody ConwayEra -> ByteString
(TxBody ConwayEra -> ByteString)
-> (TxBody ConwayEra -> Int)
-> (forall i. Proxy i -> TxBody ConwayEra -> SafeHash i)
-> SafeToHash (TxBody ConwayEra)
forall i. Proxy i -> TxBody ConwayEra -> SafeHash i
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall i. Proxy i -> t -> SafeHash i)
-> SafeToHash t
$coriginalBytes :: TxBody ConwayEra -> ByteString
originalBytes :: TxBody ConwayEra -> ByteString
$coriginalBytesSize :: TxBody ConwayEra -> Int
originalBytesSize :: TxBody ConwayEra -> Int
$cmakeHashWithExplicitProxys :: forall i. Proxy i -> TxBody ConwayEra -> SafeHash i
makeHashWithExplicitProxys :: forall i. Proxy i -> TxBody ConwayEra -> SafeHash i
SafeToHash, Typeable (TxBody ConwayEra)
Typeable (TxBody ConwayEra) =>
(TxBody ConwayEra -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (TxBody ConwayEra) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [TxBody ConwayEra] -> Size)
-> ToCBOR (TxBody ConwayEra)
TxBody ConwayEra -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TxBody ConwayEra] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (TxBody ConwayEra) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: TxBody ConwayEra -> Encoding
toCBOR :: TxBody ConwayEra -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (TxBody ConwayEra) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (TxBody ConwayEra) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TxBody ConwayEra] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TxBody ConwayEra] -> Size
ToCBOR)
  type TxBodyUpgradeError ConwayEra = ConwayTxBodyUpgradeError

  mkBasicTxBody :: TxBody ConwayEra
mkBasicTxBody = TxBody ConwayEra
mkConwayTxBody

  inputsTxBodyL :: Lens' (TxBody ConwayEra) (Set TxIn)
inputsTxBodyL = forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ConwayEra RawType (TxBody ConwayEra) -> Set TxIn
ConwayTxBodyRaw -> Set TxIn
ctbrSpendInputs ((RawType (TxBody ConwayEra)
  -> Set TxIn -> RawType (TxBody ConwayEra))
 -> Lens' (TxBody ConwayEra) (Set TxIn))
-> (RawType (TxBody ConwayEra)
    -> Set TxIn -> RawType (TxBody ConwayEra))
-> Lens' (TxBody ConwayEra) (Set TxIn)
forall a b. (a -> b) -> a -> b
$
    \RawType (TxBody ConwayEra)
txb Set TxIn
x -> RawType (TxBody ConwayEra)
txb {ctbrSpendInputs = x}
  {-# INLINE inputsTxBodyL #-}

  outputsTxBodyL :: Lens' (TxBody ConwayEra) (StrictSeq (TxOut ConwayEra))
outputsTxBodyL =
    forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ConwayEra ((Sized (BabbageTxOut ConwayEra) -> BabbageTxOut ConwayEra)
-> StrictSeq (Sized (BabbageTxOut ConwayEra))
-> StrictSeq (BabbageTxOut ConwayEra)
forall a b. (a -> b) -> StrictSeq a -> StrictSeq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sized (BabbageTxOut ConwayEra) -> BabbageTxOut ConwayEra
forall a. Sized a -> a
sizedValue (StrictSeq (Sized (BabbageTxOut ConwayEra))
 -> StrictSeq (BabbageTxOut ConwayEra))
-> (ConwayTxBodyRaw -> StrictSeq (Sized (BabbageTxOut ConwayEra)))
-> ConwayTxBodyRaw
-> StrictSeq (BabbageTxOut ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayTxBodyRaw -> StrictSeq (Sized (TxOut ConwayEra))
ConwayTxBodyRaw -> StrictSeq (Sized (BabbageTxOut ConwayEra))
ctbrOutputs) ((RawType (TxBody ConwayEra)
  -> StrictSeq (TxOut ConwayEra) -> RawType (TxBody ConwayEra))
 -> Lens' (TxBody ConwayEra) (StrictSeq (TxOut ConwayEra)))
-> (RawType (TxBody ConwayEra)
    -> StrictSeq (TxOut ConwayEra) -> RawType (TxBody ConwayEra))
-> Lens' (TxBody ConwayEra) (StrictSeq (TxOut ConwayEra))
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody ConwayEra)
txb StrictSeq (TxOut ConwayEra)
x -> RawType (TxBody ConwayEra)
txb {ctbrOutputs = mkSized (eraProtVerLow @ConwayEra) <$> x}
  {-# INLINE outputsTxBodyL #-}

  feeTxBodyL :: Lens' (TxBody ConwayEra) Coin
feeTxBodyL = forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ConwayEra RawType (TxBody ConwayEra) -> Coin
ConwayTxBodyRaw -> Coin
ctbrFee (\RawType (TxBody ConwayEra)
txb Coin
x -> RawType (TxBody ConwayEra)
txb {ctbrFee = x})
  {-# INLINE feeTxBodyL #-}

  auxDataHashTxBodyL :: Lens' (TxBody ConwayEra) (StrictMaybe TxAuxDataHash)
auxDataHashTxBodyL = forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ConwayEra RawType (TxBody ConwayEra) -> StrictMaybe TxAuxDataHash
ConwayTxBodyRaw -> StrictMaybe TxAuxDataHash
ctbrAuxDataHash ((RawType (TxBody ConwayEra)
  -> StrictMaybe TxAuxDataHash -> RawType (TxBody ConwayEra))
 -> Lens' (TxBody ConwayEra) (StrictMaybe TxAuxDataHash))
-> (RawType (TxBody ConwayEra)
    -> StrictMaybe TxAuxDataHash -> RawType (TxBody ConwayEra))
-> Lens' (TxBody ConwayEra) (StrictMaybe TxAuxDataHash)
forall a b. (a -> b) -> a -> b
$
    \RawType (TxBody ConwayEra)
txb StrictMaybe TxAuxDataHash
x -> RawType (TxBody ConwayEra)
txb {ctbrAuxDataHash = x}
  {-# INLINE auxDataHashTxBodyL #-}

  spendableInputsTxBodyF :: SimpleGetter (TxBody ConwayEra) (Set TxIn)
spendableInputsTxBodyF = Getting r (TxBody ConwayEra) (Set TxIn)
forall era.
BabbageEraTxBody era =>
SimpleGetter (TxBody era) (Set TxIn)
SimpleGetter (TxBody ConwayEra) (Set TxIn)
babbageSpendableInputsTxBodyF
  {-# INLINE spendableInputsTxBodyF #-}

  allInputsTxBodyF :: SimpleGetter (TxBody ConwayEra) (Set TxIn)
allInputsTxBodyF = Getting r (TxBody ConwayEra) (Set TxIn)
forall era.
BabbageEraTxBody era =>
SimpleGetter (TxBody era) (Set TxIn)
SimpleGetter (TxBody ConwayEra) (Set TxIn)
babbageAllInputsTxBodyF
  {-# INLINE allInputsTxBodyF #-}

  withdrawalsTxBodyL :: Lens' (TxBody ConwayEra) Withdrawals
withdrawalsTxBodyL = forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ConwayEra RawType (TxBody ConwayEra) -> Withdrawals
ConwayTxBodyRaw -> Withdrawals
ctbrWithdrawals ((RawType (TxBody ConwayEra)
  -> Withdrawals -> RawType (TxBody ConwayEra))
 -> Lens' (TxBody ConwayEra) Withdrawals)
-> (RawType (TxBody ConwayEra)
    -> Withdrawals -> RawType (TxBody ConwayEra))
-> Lens' (TxBody ConwayEra) Withdrawals
forall a b. (a -> b) -> a -> b
$
    \RawType (TxBody ConwayEra)
txb Withdrawals
x -> RawType (TxBody ConwayEra)
txb {ctbrWithdrawals = x}
  {-# INLINE withdrawalsTxBodyL #-}

  certsTxBodyL :: Lens' (TxBody ConwayEra) (StrictSeq (TxCert ConwayEra))
certsTxBodyL =
    forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ConwayEra (OSet (ConwayTxCert ConwayEra) -> StrictSeq (ConwayTxCert ConwayEra)
forall a. OSet a -> StrictSeq a
OSet.toStrictSeq (OSet (ConwayTxCert ConwayEra)
 -> StrictSeq (ConwayTxCert ConwayEra))
-> (ConwayTxBodyRaw -> OSet (ConwayTxCert ConwayEra))
-> ConwayTxBodyRaw
-> StrictSeq (ConwayTxCert ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayTxBodyRaw -> OSet (TxCert ConwayEra)
ConwayTxBodyRaw -> OSet (ConwayTxCert ConwayEra)
ctbrCerts) ((RawType (TxBody ConwayEra)
  -> StrictSeq (TxCert ConwayEra) -> RawType (TxBody ConwayEra))
 -> Lens' (TxBody ConwayEra) (StrictSeq (TxCert ConwayEra)))
-> (RawType (TxBody ConwayEra)
    -> StrictSeq (TxCert ConwayEra) -> RawType (TxBody ConwayEra))
-> Lens' (TxBody ConwayEra) (StrictSeq (TxCert ConwayEra))
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody ConwayEra)
txb StrictSeq (TxCert ConwayEra)
x -> RawType (TxBody ConwayEra)
txb {ctbrCerts = OSet.fromStrictSeq x}
  {-# INLINE certsTxBodyL #-}

  getTotalDepositsTxBody :: PParams ConwayEra
-> (KeyHash 'StakePool -> Bool) -> TxBody ConwayEra -> Coin
getTotalDepositsTxBody = PParams ConwayEra
-> (KeyHash 'StakePool -> Bool) -> TxBody ConwayEra -> Coin
conwayTotalDepositsTxBody

  getTotalRefundsTxBody :: PParams ConwayEra
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> TxBody ConwayEra
-> Coin
getTotalRefundsTxBody PParams ConwayEra
pp Credential 'Staking -> Maybe Coin
lookupStakingDeposit Credential 'DRepRole -> Maybe Coin
lookupDRepDeposit TxBody ConwayEra
txBody =
    PParams ConwayEra
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> StrictSeq (TxCert ConwayEra)
-> Coin
forall era (f :: * -> *).
(EraTxCert era, Foldable f) =>
PParams era
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> f (TxCert era)
-> Coin
forall (f :: * -> *).
Foldable f =>
PParams ConwayEra
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> f (TxCert ConwayEra)
-> Coin
getTotalRefundsTxCerts PParams ConwayEra
pp Credential 'Staking -> Maybe Coin
lookupStakingDeposit Credential 'DRepRole -> Maybe Coin
lookupDRepDeposit (TxBody ConwayEra
txBody TxBody ConwayEra
-> Getting
     (StrictSeq (ConwayTxCert ConwayEra))
     (TxBody ConwayEra)
     (StrictSeq (ConwayTxCert ConwayEra))
-> StrictSeq (ConwayTxCert ConwayEra)
forall s a. s -> Getting a s a -> a
^. (StrictSeq (TxCert ConwayEra)
 -> Const
      (StrictSeq (ConwayTxCert ConwayEra))
      (StrictSeq (TxCert ConwayEra)))
-> TxBody ConwayEra
-> Const (StrictSeq (ConwayTxCert ConwayEra)) (TxBody ConwayEra)
Getting
  (StrictSeq (ConwayTxCert ConwayEra))
  (TxBody ConwayEra)
  (StrictSeq (ConwayTxCert ConwayEra))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody ConwayEra) (StrictSeq (TxCert ConwayEra))
certsTxBodyL)

  upgradeTxBody :: EraTxBody (PreviousEra ConwayEra) =>
TxBody (PreviousEra ConwayEra)
-> Either (TxBodyUpgradeError ConwayEra) (TxBody ConwayEra)
upgradeTxBody TxBody (PreviousEra ConwayEra)
btb = do
    Bool
-> Either ConwayTxBodyUpgradeError ()
-> Either ConwayTxBodyUpgradeError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StrictMaybe (Update BabbageEra) -> Bool
forall a. StrictMaybe a -> Bool
isSJust (TxBody BabbageEra -> StrictMaybe (Update BabbageEra)
btbUpdate TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb)) (Either ConwayTxBodyUpgradeError ()
 -> Either ConwayTxBodyUpgradeError ())
-> Either ConwayTxBodyUpgradeError ()
-> Either ConwayTxBodyUpgradeError ()
forall a b. (a -> b) -> a -> b
$ ConwayTxBodyUpgradeError -> Either ConwayTxBodyUpgradeError ()
forall a b. a -> Either a b
Left ConwayTxBodyUpgradeError
CTBUEContainsUpdate
    StrictSeq (TxCert ConwayEra)
certs <- (TxCert (PreviousEra ConwayEra)
 -> Either ConwayTxBodyUpgradeError (TxCert ConwayEra))
-> StrictSeq (TxCert (PreviousEra ConwayEra))
-> Either ConwayTxBodyUpgradeError (StrictSeq (TxCert ConwayEra))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StrictSeq a -> f (StrictSeq b)
traverse ((ConwayTxCertUpgradeError -> ConwayTxBodyUpgradeError)
-> Either ConwayTxCertUpgradeError (TxCert ConwayEra)
-> Either ConwayTxBodyUpgradeError (TxCert ConwayEra)
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left ConwayTxCertUpgradeError -> ConwayTxBodyUpgradeError
CTBUETxCert (Either ConwayTxCertUpgradeError (TxCert ConwayEra)
 -> Either ConwayTxBodyUpgradeError (TxCert ConwayEra))
-> (TxCert (PreviousEra ConwayEra)
    -> Either ConwayTxCertUpgradeError (TxCert ConwayEra))
-> TxCert (PreviousEra ConwayEra)
-> Either ConwayTxBodyUpgradeError (TxCert ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxCert (PreviousEra ConwayEra)
-> Either (TxCertUpgradeError ConwayEra) (TxCert ConwayEra)
TxCert (PreviousEra ConwayEra)
-> Either ConwayTxCertUpgradeError (TxCert ConwayEra)
forall era.
(EraTxCert era, EraTxCert (PreviousEra era)) =>
TxCert (PreviousEra era)
-> Either (TxCertUpgradeError era) (TxCert era)
upgradeTxCert) (TxBody BabbageEra -> StrictSeq (TxCert BabbageEra)
btbCerts TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb)
    let (Set (TxCert ConwayEra)
duplicates, OSet (TxCert ConwayEra)
certsOSet) = StrictSeq (TxCert ConwayEra)
-> (Set (TxCert ConwayEra), OSet (TxCert ConwayEra))
forall a. Ord a => StrictSeq a -> (Set a, OSet a)
OSet.fromStrictSeqDuplicates StrictSeq (TxCert ConwayEra)
certs
    Bool
-> Either ConwayTxBodyUpgradeError ()
-> Either ConwayTxBodyUpgradeError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set (TxCert ConwayEra) -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set (TxCert ConwayEra)
duplicates) (Either ConwayTxBodyUpgradeError ()
 -> Either ConwayTxBodyUpgradeError ())
-> Either ConwayTxBodyUpgradeError ()
-> Either ConwayTxBodyUpgradeError ()
forall a b. (a -> b) -> a -> b
$ ConwayTxBodyUpgradeError -> Either ConwayTxBodyUpgradeError ()
forall a b. a -> Either a b
Left (ConwayTxBodyUpgradeError -> Either ConwayTxBodyUpgradeError ())
-> ConwayTxBodyUpgradeError -> Either ConwayTxBodyUpgradeError ()
forall a b. (a -> b) -> a -> b
$ Set (TxCert ConwayEra) -> ConwayTxBodyUpgradeError
CTBUEContainsDuplicateCerts Set (TxCert ConwayEra)
duplicates
    TxBody ConwayEra
-> Either ConwayTxBodyUpgradeError (TxBody ConwayEra)
forall a. a -> Either ConwayTxBodyUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxBody ConwayEra
 -> Either ConwayTxBodyUpgradeError (TxBody ConwayEra))
-> TxBody ConwayEra
-> Either ConwayTxBodyUpgradeError (TxBody ConwayEra)
forall a b. (a -> b) -> a -> b
$
      ConwayTxBody
        { ctbSpendInputs :: Set TxIn
ctbSpendInputs = TxBody BabbageEra -> Set TxIn
btbInputs TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbOutputs :: StrictSeq (Sized (TxOut ConwayEra))
ctbOutputs =
            Version -> BabbageTxOut ConwayEra -> Sized (BabbageTxOut ConwayEra)
forall a. EncCBOR a => Version -> a -> Sized a
mkSized (forall era. Era era => Version
eraProtVerLow @ConwayEra)
              (BabbageTxOut ConwayEra -> Sized (BabbageTxOut ConwayEra))
-> (Sized (TxOut (PreviousEra ConwayEra))
    -> BabbageTxOut ConwayEra)
-> Sized (TxOut (PreviousEra ConwayEra))
-> Sized (BabbageTxOut ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut (PreviousEra ConwayEra) -> TxOut ConwayEra
TxOut (PreviousEra ConwayEra) -> BabbageTxOut ConwayEra
forall era.
(EraTxOut era, EraTxOut (PreviousEra era)) =>
TxOut (PreviousEra era) -> TxOut era
upgradeTxOut
              (TxOut (PreviousEra ConwayEra) -> BabbageTxOut ConwayEra)
-> (Sized (TxOut (PreviousEra ConwayEra))
    -> TxOut (PreviousEra ConwayEra))
-> Sized (TxOut (PreviousEra ConwayEra))
-> BabbageTxOut ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sized (TxOut (PreviousEra ConwayEra))
-> TxOut (PreviousEra ConwayEra)
forall a. Sized a -> a
sizedValue
              (Sized (TxOut (PreviousEra ConwayEra))
 -> Sized (BabbageTxOut ConwayEra))
-> StrictSeq (Sized (TxOut (PreviousEra ConwayEra)))
-> StrictSeq (Sized (BabbageTxOut ConwayEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxBody BabbageEra -> StrictSeq (Sized (TxOut BabbageEra))
btbOutputs TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbCerts :: OSet (TxCert ConwayEra)
ctbCerts = OSet (TxCert ConwayEra)
certsOSet
        , ctbWithdrawals :: Withdrawals
ctbWithdrawals = TxBody BabbageEra -> Withdrawals
btbWithdrawals TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbTxfee :: Coin
ctbTxfee = TxBody BabbageEra -> Coin
btbTxFee TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbVldt :: ValidityInterval
ctbVldt = TxBody BabbageEra -> ValidityInterval
btbValidityInterval TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbAdHash :: StrictMaybe TxAuxDataHash
ctbAdHash = TxBody BabbageEra -> StrictMaybe TxAuxDataHash
btbAuxDataHash TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbMint :: MultiAsset
ctbMint = TxBody BabbageEra -> MultiAsset
btbMint TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbCollateralInputs :: Set TxIn
ctbCollateralInputs = TxBody BabbageEra -> Set TxIn
btbCollateral TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbReqSignerHashes :: Set (KeyHash 'Witness)
ctbReqSignerHashes = TxBody BabbageEra -> Set (KeyHash 'Witness)
btbReqSignerHashes TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbScriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
ctbScriptIntegrityHash = TxBody BabbageEra -> StrictMaybe ScriptIntegrityHash
btbScriptIntegrityHash TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbTxNetworkId :: StrictMaybe Network
ctbTxNetworkId = TxBody BabbageEra -> StrictMaybe Network
btbTxNetworkId TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbReferenceInputs :: Set TxIn
ctbReferenceInputs = TxBody BabbageEra -> Set TxIn
btbReferenceInputs TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbCollateralReturn :: StrictMaybe (Sized (TxOut ConwayEra))
ctbCollateralReturn =
            Version -> BabbageTxOut ConwayEra -> Sized (BabbageTxOut ConwayEra)
forall a. EncCBOR a => Version -> a -> Sized a
mkSized (forall era. Era era => Version
eraProtVerLow @ConwayEra)
              (BabbageTxOut ConwayEra -> Sized (BabbageTxOut ConwayEra))
-> (Sized (TxOut (PreviousEra ConwayEra))
    -> BabbageTxOut ConwayEra)
-> Sized (TxOut (PreviousEra ConwayEra))
-> Sized (BabbageTxOut ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut (PreviousEra ConwayEra) -> TxOut ConwayEra
TxOut (PreviousEra ConwayEra) -> BabbageTxOut ConwayEra
forall era.
(EraTxOut era, EraTxOut (PreviousEra era)) =>
TxOut (PreviousEra era) -> TxOut era
upgradeTxOut
              (TxOut (PreviousEra ConwayEra) -> BabbageTxOut ConwayEra)
-> (Sized (TxOut (PreviousEra ConwayEra))
    -> TxOut (PreviousEra ConwayEra))
-> Sized (TxOut (PreviousEra ConwayEra))
-> BabbageTxOut ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sized (TxOut (PreviousEra ConwayEra))
-> TxOut (PreviousEra ConwayEra)
forall a. Sized a -> a
sizedValue
              (Sized (TxOut (PreviousEra ConwayEra))
 -> Sized (BabbageTxOut ConwayEra))
-> StrictMaybe (Sized (TxOut (PreviousEra ConwayEra)))
-> StrictMaybe (Sized (BabbageTxOut ConwayEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxBody BabbageEra -> StrictMaybe (Sized (TxOut BabbageEra))
btbCollateralReturn TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbTotalCollateral :: StrictMaybe Coin
ctbTotalCollateral = TxBody BabbageEra -> StrictMaybe Coin
btbTotalCollateral TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbCurrentTreasuryValue :: StrictMaybe Coin
ctbCurrentTreasuryValue = StrictMaybe Coin
forall a. StrictMaybe a
SNothing
        , ctbProposalProcedures :: OSet (ProposalProcedure ConwayEra)
ctbProposalProcedures = OSet (ProposalProcedure ConwayEra)
forall a. OSet a
OSet.empty
        , ctbVotingProcedures :: VotingProcedures ConwayEra
ctbVotingProcedures = Map Voter (Map GovActionId (VotingProcedure ConwayEra))
-> VotingProcedures ConwayEra
forall era.
Map Voter (Map GovActionId (VotingProcedure era))
-> VotingProcedures era
VotingProcedures Map Voter (Map GovActionId (VotingProcedure ConwayEra))
forall a. Monoid a => a
mempty
        , ctbTreasuryDonation :: Coin
ctbTreasuryDonation = Integer -> Coin
Coin Integer
0
        }

-- ==========================================
-- Deposits and Refunds for Conway TxBody

-- | Compute all the deposits in a TxBody. This includes deposits for:
--
--   1. registering Stake
--   2. registering a StakePool
--   3. registering a DRep
--   4. submitting a Proposal
--
-- This is the contribution of a TxBody towards the total
-- `Cardano.Ledger.CertState.Obligations`
conwayTotalDepositsTxBody ::
  PParams ConwayEra ->
  (KeyHash 'StakePool -> Bool) ->
  TxBody ConwayEra ->
  Coin
conwayTotalDepositsTxBody :: PParams ConwayEra
-> (KeyHash 'StakePool -> Bool) -> TxBody ConwayEra -> Coin
conwayTotalDepositsTxBody PParams ConwayEra
pp KeyHash 'StakePool -> Bool
isPoolRegisted TxBody ConwayEra
txBody =
  PParams ConwayEra
-> (KeyHash 'StakePool -> Bool)
-> StrictSeq (TxCert ConwayEra)
-> Coin
forall era (f :: * -> *).
(EraTxCert era, Foldable f) =>
PParams era
-> (KeyHash 'StakePool -> Bool) -> f (TxCert era) -> Coin
forall (f :: * -> *).
Foldable f =>
PParams ConwayEra
-> (KeyHash 'StakePool -> Bool) -> f (TxCert ConwayEra) -> Coin
getTotalDepositsTxCerts PParams ConwayEra
pp KeyHash 'StakePool -> Bool
isPoolRegisted (TxBody ConwayEra
txBody TxBody ConwayEra
-> Getting
     (StrictSeq (ConwayTxCert ConwayEra))
     (TxBody ConwayEra)
     (StrictSeq (ConwayTxCert ConwayEra))
-> StrictSeq (ConwayTxCert ConwayEra)
forall s a. s -> Getting a s a -> a
^. (StrictSeq (TxCert ConwayEra)
 -> Const
      (StrictSeq (ConwayTxCert ConwayEra))
      (StrictSeq (TxCert ConwayEra)))
-> TxBody ConwayEra
-> Const (StrictSeq (ConwayTxCert ConwayEra)) (TxBody ConwayEra)
Getting
  (StrictSeq (ConwayTxCert ConwayEra))
  (TxBody ConwayEra)
  (StrictSeq (ConwayTxCert ConwayEra))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody ConwayEra) (StrictSeq (TxCert ConwayEra))
certsTxBodyL)
    Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> PParams ConwayEra -> TxBody ConwayEra -> Coin
forall era.
ConwayEraTxBody era =>
PParams era -> TxBody era -> Coin
conwayProposalsDeposits PParams ConwayEra
pp TxBody ConwayEra
txBody

-- | Total number of deposits in the proposals in TxBody
conwayProposalsDeposits ::
  ConwayEraTxBody era =>
  PParams era ->
  TxBody era ->
  Coin
conwayProposalsDeposits :: forall era.
ConwayEraTxBody era =>
PParams era -> TxBody era -> Coin
conwayProposalsDeposits PParams era
pp TxBody era
txBody = Int
numProposals Int -> Coin -> Coin
forall i. Integral i => i -> Coin -> Coin
forall t i. (Val t, Integral i) => i -> t -> t
<×> Coin
depositPerProposal
  where
    numProposals :: Int
numProposals = OSet (ProposalProcedure era) -> Int
forall a. OSet a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (TxBody era
txBody TxBody era
-> Getting
     (OSet (ProposalProcedure era))
     (TxBody era)
     (OSet (ProposalProcedure era))
-> OSet (ProposalProcedure era)
forall s a. s -> Getting a s a -> a
^. Getting
  (OSet (ProposalProcedure era))
  (TxBody era)
  (OSet (ProposalProcedure era))
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (OSet (ProposalProcedure era))
Lens' (TxBody era) (OSet (ProposalProcedure era))
proposalProceduresTxBodyL)
    depositPerProposal :: Coin
depositPerProposal = PParams era
pp PParams era -> Getting Coin (PParams era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams era) Coin
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppGovActionDepositL

instance AllegraEraTxBody ConwayEra where
  vldtTxBodyL :: Lens' (TxBody ConwayEra) ValidityInterval
vldtTxBodyL = forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ConwayEra RawType (TxBody ConwayEra) -> ValidityInterval
ConwayTxBodyRaw -> ValidityInterval
ctbrVldt ((RawType (TxBody ConwayEra)
  -> ValidityInterval -> RawType (TxBody ConwayEra))
 -> Lens' (TxBody ConwayEra) ValidityInterval)
-> (RawType (TxBody ConwayEra)
    -> ValidityInterval -> RawType (TxBody ConwayEra))
-> Lens' (TxBody ConwayEra) ValidityInterval
forall a b. (a -> b) -> a -> b
$
    \RawType (TxBody ConwayEra)
txb ValidityInterval
x -> RawType (TxBody ConwayEra)
txb {ctbrVldt = x}
  {-# INLINE vldtTxBodyL #-}

instance MaryEraTxBody ConwayEra where
  mintTxBodyL :: Lens' (TxBody ConwayEra) MultiAsset
mintTxBodyL = forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ConwayEra RawType (TxBody ConwayEra) -> MultiAsset
ConwayTxBodyRaw -> MultiAsset
ctbrMint ((RawType (TxBody ConwayEra)
  -> MultiAsset -> RawType (TxBody ConwayEra))
 -> Lens' (TxBody ConwayEra) MultiAsset)
-> (RawType (TxBody ConwayEra)
    -> MultiAsset -> RawType (TxBody ConwayEra))
-> Lens' (TxBody ConwayEra) MultiAsset
forall a b. (a -> b) -> a -> b
$
    \RawType (TxBody ConwayEra)
txb MultiAsset
x -> RawType (TxBody ConwayEra)
txb {ctbrMint = x}
  {-# INLINE mintTxBodyL #-}

  mintedTxBodyF :: SimpleGetter (TxBody ConwayEra) (Set PolicyID)
mintedTxBodyF = (TxBody ConwayEra -> Set PolicyID)
-> SimpleGetter (TxBody ConwayEra) (Set PolicyID)
forall s a. (s -> a) -> SimpleGetter s a
to ((TxBody ConwayEra -> Set PolicyID)
 -> SimpleGetter (TxBody ConwayEra) (Set PolicyID))
-> (TxBody ConwayEra -> Set PolicyID)
-> SimpleGetter (TxBody ConwayEra) (Set PolicyID)
forall a b. (a -> b) -> a -> b
$ \TxBody ConwayEra
txBody -> MultiAsset -> Set PolicyID
policies (ConwayTxBodyRaw -> MultiAsset
ctbrMint (TxBody ConwayEra -> RawType (TxBody ConwayEra)
forall t. Memoized t => t -> RawType t
getMemoRawType TxBody ConwayEra
txBody))
  {-# INLINE mintedTxBodyF #-}

instance AlonzoEraTxBody ConwayEra where
  collateralInputsTxBodyL :: Lens' (TxBody ConwayEra) (Set TxIn)
collateralInputsTxBodyL =
    forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ConwayEra RawType (TxBody ConwayEra) -> Set TxIn
ConwayTxBodyRaw -> Set TxIn
ctbrCollateralInputs ((RawType (TxBody ConwayEra)
  -> Set TxIn -> RawType (TxBody ConwayEra))
 -> Lens' (TxBody ConwayEra) (Set TxIn))
-> (RawType (TxBody ConwayEra)
    -> Set TxIn -> RawType (TxBody ConwayEra))
-> Lens' (TxBody ConwayEra) (Set TxIn)
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody ConwayEra)
txb Set TxIn
x -> RawType (TxBody ConwayEra)
txb {ctbrCollateralInputs = x}
  {-# INLINE collateralInputsTxBodyL #-}

  reqSignerHashesTxBodyL :: Lens' (TxBody ConwayEra) (Set (KeyHash 'Witness))
reqSignerHashesTxBodyL =
    forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ConwayEra RawType (TxBody ConwayEra) -> Set (KeyHash 'Witness)
ConwayTxBodyRaw -> Set (KeyHash 'Witness)
ctbrReqSignerHashes ((RawType (TxBody ConwayEra)
  -> Set (KeyHash 'Witness) -> RawType (TxBody ConwayEra))
 -> Lens' (TxBody ConwayEra) (Set (KeyHash 'Witness)))
-> (RawType (TxBody ConwayEra)
    -> Set (KeyHash 'Witness) -> RawType (TxBody ConwayEra))
-> Lens' (TxBody ConwayEra) (Set (KeyHash 'Witness))
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody ConwayEra)
txb Set (KeyHash 'Witness)
x -> RawType (TxBody ConwayEra)
txb {ctbrReqSignerHashes = x}
  {-# INLINE reqSignerHashesTxBodyL #-}

  scriptIntegrityHashTxBodyL :: Lens' (TxBody ConwayEra) (StrictMaybe ScriptIntegrityHash)
scriptIntegrityHashTxBodyL =
    forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ConwayEra RawType (TxBody ConwayEra) -> StrictMaybe ScriptIntegrityHash
ConwayTxBodyRaw -> StrictMaybe ScriptIntegrityHash
ctbrScriptIntegrityHash ((RawType (TxBody ConwayEra)
  -> StrictMaybe ScriptIntegrityHash -> RawType (TxBody ConwayEra))
 -> Lens' (TxBody ConwayEra) (StrictMaybe ScriptIntegrityHash))
-> (RawType (TxBody ConwayEra)
    -> StrictMaybe ScriptIntegrityHash -> RawType (TxBody ConwayEra))
-> Lens' (TxBody ConwayEra) (StrictMaybe ScriptIntegrityHash)
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody ConwayEra)
txb StrictMaybe ScriptIntegrityHash
x -> RawType (TxBody ConwayEra)
txb {ctbrScriptIntegrityHash = x}
  {-# INLINE scriptIntegrityHashTxBodyL #-}

  networkIdTxBodyL :: Lens' (TxBody ConwayEra) (StrictMaybe Network)
networkIdTxBodyL = forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ConwayEra RawType (TxBody ConwayEra) -> StrictMaybe Network
ConwayTxBodyRaw -> StrictMaybe Network
ctbrNetworkId ((RawType (TxBody ConwayEra)
  -> StrictMaybe Network -> RawType (TxBody ConwayEra))
 -> Lens' (TxBody ConwayEra) (StrictMaybe Network))
-> (RawType (TxBody ConwayEra)
    -> StrictMaybe Network -> RawType (TxBody ConwayEra))
-> Lens' (TxBody ConwayEra) (StrictMaybe Network)
forall a b. (a -> b) -> a -> b
$
    \RawType (TxBody ConwayEra)
txb StrictMaybe Network
x -> RawType (TxBody ConwayEra)
txb {ctbrNetworkId = x}
  {-# INLINE networkIdTxBodyL #-}

  redeemerPointer :: TxBody ConwayEra
-> PlutusPurpose AsItem ConwayEra
-> StrictMaybe (PlutusPurpose AsIx ConwayEra)
redeemerPointer = TxBody ConwayEra
-> PlutusPurpose AsItem ConwayEra
-> StrictMaybe (PlutusPurpose AsIx ConwayEra)
TxBody ConwayEra
-> ConwayPlutusPurpose AsItem ConwayEra
-> StrictMaybe (ConwayPlutusPurpose AsIx ConwayEra)
forall era.
ConwayEraTxBody era =>
TxBody era
-> ConwayPlutusPurpose AsItem era
-> StrictMaybe (ConwayPlutusPurpose AsIx era)
conwayRedeemerPointer

  redeemerPointerInverse :: TxBody ConwayEra
-> PlutusPurpose AsIx ConwayEra
-> StrictMaybe (PlutusPurpose AsIxItem ConwayEra)
redeemerPointerInverse = TxBody ConwayEra
-> PlutusPurpose AsIx ConwayEra
-> StrictMaybe (PlutusPurpose AsIxItem ConwayEra)
TxBody ConwayEra
-> ConwayPlutusPurpose AsIx ConwayEra
-> StrictMaybe (ConwayPlutusPurpose AsIxItem ConwayEra)
forall era.
ConwayEraTxBody era =>
TxBody era
-> ConwayPlutusPurpose AsIx era
-> StrictMaybe (ConwayPlutusPurpose AsIxItem era)
conwayRedeemerPointerInverse

instance BabbageEraTxBody ConwayEra where
  sizedOutputsTxBodyL :: Lens' (TxBody ConwayEra) (StrictSeq (Sized (TxOut ConwayEra)))
sizedOutputsTxBodyL = forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ConwayEra RawType (TxBody ConwayEra) -> StrictSeq (Sized (TxOut ConwayEra))
ConwayTxBodyRaw -> StrictSeq (Sized (TxOut ConwayEra))
ctbrOutputs ((RawType (TxBody ConwayEra)
  -> StrictSeq (Sized (TxOut ConwayEra))
  -> RawType (TxBody ConwayEra))
 -> Lens' (TxBody ConwayEra) (StrictSeq (Sized (TxOut ConwayEra))))
-> (RawType (TxBody ConwayEra)
    -> StrictSeq (Sized (TxOut ConwayEra))
    -> RawType (TxBody ConwayEra))
-> Lens' (TxBody ConwayEra) (StrictSeq (Sized (TxOut ConwayEra)))
forall a b. (a -> b) -> a -> b
$
    \RawType (TxBody ConwayEra)
txb StrictSeq (Sized (TxOut ConwayEra))
x -> RawType (TxBody ConwayEra)
txb {ctbrOutputs = x}
  {-# INLINE sizedOutputsTxBodyL #-}

  referenceInputsTxBodyL :: Lens' (TxBody ConwayEra) (Set TxIn)
referenceInputsTxBodyL =
    forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ConwayEra RawType (TxBody ConwayEra) -> Set TxIn
ConwayTxBodyRaw -> Set TxIn
ctbrReferenceInputs ((RawType (TxBody ConwayEra)
  -> Set TxIn -> RawType (TxBody ConwayEra))
 -> Lens' (TxBody ConwayEra) (Set TxIn))
-> (RawType (TxBody ConwayEra)
    -> Set TxIn -> RawType (TxBody ConwayEra))
-> Lens' (TxBody ConwayEra) (Set TxIn)
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody ConwayEra)
txb Set TxIn
x -> RawType (TxBody ConwayEra)
txb {ctbrReferenceInputs = x}
  {-# INLINE referenceInputsTxBodyL #-}

  totalCollateralTxBodyL :: Lens' (TxBody ConwayEra) (StrictMaybe Coin)
totalCollateralTxBodyL =
    forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ConwayEra RawType (TxBody ConwayEra) -> StrictMaybe Coin
ConwayTxBodyRaw -> StrictMaybe Coin
ctbrTotalCollateral ((RawType (TxBody ConwayEra)
  -> StrictMaybe Coin -> RawType (TxBody ConwayEra))
 -> Lens' (TxBody ConwayEra) (StrictMaybe Coin))
-> (RawType (TxBody ConwayEra)
    -> StrictMaybe Coin -> RawType (TxBody ConwayEra))
-> Lens' (TxBody ConwayEra) (StrictMaybe Coin)
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody ConwayEra)
txb StrictMaybe Coin
x -> RawType (TxBody ConwayEra)
txb {ctbrTotalCollateral = x}
  {-# INLINE totalCollateralTxBodyL #-}

  collateralReturnTxBodyL :: Lens' (TxBody ConwayEra) (StrictMaybe (TxOut ConwayEra))
collateralReturnTxBodyL =
    forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ConwayEra ((Sized (BabbageTxOut ConwayEra) -> BabbageTxOut ConwayEra)
-> StrictMaybe (Sized (BabbageTxOut ConwayEra))
-> StrictMaybe (BabbageTxOut ConwayEra)
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sized (BabbageTxOut ConwayEra) -> BabbageTxOut ConwayEra
forall a. Sized a -> a
sizedValue (StrictMaybe (Sized (BabbageTxOut ConwayEra))
 -> StrictMaybe (BabbageTxOut ConwayEra))
-> (ConwayTxBodyRaw
    -> StrictMaybe (Sized (BabbageTxOut ConwayEra)))
-> ConwayTxBodyRaw
-> StrictMaybe (BabbageTxOut ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayTxBodyRaw -> StrictMaybe (Sized (TxOut ConwayEra))
ConwayTxBodyRaw -> StrictMaybe (Sized (BabbageTxOut ConwayEra))
ctbrCollateralReturn) ((RawType (TxBody ConwayEra)
  -> StrictMaybe (TxOut ConwayEra) -> RawType (TxBody ConwayEra))
 -> Lens' (TxBody ConwayEra) (StrictMaybe (TxOut ConwayEra)))
-> (RawType (TxBody ConwayEra)
    -> StrictMaybe (TxOut ConwayEra) -> RawType (TxBody ConwayEra))
-> Lens' (TxBody ConwayEra) (StrictMaybe (TxOut ConwayEra))
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody ConwayEra)
txb StrictMaybe (TxOut ConwayEra)
x -> RawType (TxBody ConwayEra)
txb {ctbrCollateralReturn = mkSized (eraProtVerLow @ConwayEra) <$> x}
  {-# INLINE collateralReturnTxBodyL #-}

  sizedCollateralReturnTxBodyL :: Lens' (TxBody ConwayEra) (StrictMaybe (Sized (TxOut ConwayEra)))
sizedCollateralReturnTxBodyL =
    forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ConwayEra RawType (TxBody ConwayEra) -> StrictMaybe (Sized (TxOut ConwayEra))
ConwayTxBodyRaw -> StrictMaybe (Sized (TxOut ConwayEra))
ctbrCollateralReturn ((RawType (TxBody ConwayEra)
  -> StrictMaybe (Sized (TxOut ConwayEra))
  -> RawType (TxBody ConwayEra))
 -> Lens'
      (TxBody ConwayEra) (StrictMaybe (Sized (TxOut ConwayEra))))
-> (RawType (TxBody ConwayEra)
    -> StrictMaybe (Sized (TxOut ConwayEra))
    -> RawType (TxBody ConwayEra))
-> Lens' (TxBody ConwayEra) (StrictMaybe (Sized (TxOut ConwayEra)))
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody ConwayEra)
txb StrictMaybe (Sized (TxOut ConwayEra))
x -> RawType (TxBody ConwayEra)
txb {ctbrCollateralReturn = x}
  {-# INLINE sizedCollateralReturnTxBodyL #-}

  allSizedOutputsTxBodyF :: SimpleGetter
  (TxBody ConwayEra) (StrictSeq (Sized (TxOut ConwayEra)))
allSizedOutputsTxBodyF = Getting r (TxBody ConwayEra) (StrictSeq (Sized (TxOut ConwayEra)))
forall era.
BabbageEraTxBody era =>
SimpleGetter (TxBody era) (StrictSeq (Sized (TxOut era)))
SimpleGetter
  (TxBody ConwayEra) (StrictSeq (Sized (TxOut ConwayEra)))
allSizedOutputsBabbageTxBodyF
  {-# INLINE allSizedOutputsTxBodyF #-}

instance ConwayEraTxBody ConwayEra where
  votingProceduresTxBodyL :: Lens' (TxBody ConwayEra) (VotingProcedures ConwayEra)
votingProceduresTxBodyL =
    forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ConwayEra RawType (TxBody ConwayEra) -> VotingProcedures ConwayEra
ConwayTxBodyRaw -> VotingProcedures ConwayEra
ctbrVotingProcedures ((RawType (TxBody ConwayEra)
  -> VotingProcedures ConwayEra -> RawType (TxBody ConwayEra))
 -> Lens' (TxBody ConwayEra) (VotingProcedures ConwayEra))
-> (RawType (TxBody ConwayEra)
    -> VotingProcedures ConwayEra -> RawType (TxBody ConwayEra))
-> Lens' (TxBody ConwayEra) (VotingProcedures ConwayEra)
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody ConwayEra)
txb VotingProcedures ConwayEra
x -> RawType (TxBody ConwayEra)
txb {ctbrVotingProcedures = x}
  {-# INLINE votingProceduresTxBodyL #-}
  proposalProceduresTxBodyL :: Lens' (TxBody ConwayEra) (OSet (ProposalProcedure ConwayEra))
proposalProceduresTxBodyL =
    forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ConwayEra RawType (TxBody ConwayEra) -> OSet (ProposalProcedure ConwayEra)
ConwayTxBodyRaw -> OSet (ProposalProcedure ConwayEra)
ctbrProposalProcedures ((RawType (TxBody ConwayEra)
  -> OSet (ProposalProcedure ConwayEra)
  -> RawType (TxBody ConwayEra))
 -> Lens' (TxBody ConwayEra) (OSet (ProposalProcedure ConwayEra)))
-> (RawType (TxBody ConwayEra)
    -> OSet (ProposalProcedure ConwayEra)
    -> RawType (TxBody ConwayEra))
-> Lens' (TxBody ConwayEra) (OSet (ProposalProcedure ConwayEra))
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody ConwayEra)
txb OSet (ProposalProcedure ConwayEra)
x -> RawType (TxBody ConwayEra)
txb {ctbrProposalProcedures = x}
  {-# INLINE proposalProceduresTxBodyL #-}
  currentTreasuryValueTxBodyL :: Lens' (TxBody ConwayEra) (StrictMaybe Coin)
currentTreasuryValueTxBodyL =
    forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ConwayEra RawType (TxBody ConwayEra) -> StrictMaybe Coin
ConwayTxBodyRaw -> StrictMaybe Coin
ctbrCurrentTreasuryValue ((RawType (TxBody ConwayEra)
  -> StrictMaybe Coin -> RawType (TxBody ConwayEra))
 -> Lens' (TxBody ConwayEra) (StrictMaybe Coin))
-> (RawType (TxBody ConwayEra)
    -> StrictMaybe Coin -> RawType (TxBody ConwayEra))
-> Lens' (TxBody ConwayEra) (StrictMaybe Coin)
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody ConwayEra)
txb StrictMaybe Coin
x -> RawType (TxBody ConwayEra)
txb {ctbrCurrentTreasuryValue = x}
  {-# INLINE currentTreasuryValueTxBodyL #-}
  treasuryDonationTxBodyL :: Lens' (TxBody ConwayEra) Coin
treasuryDonationTxBodyL =
    forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ConwayEra RawType (TxBody ConwayEra) -> Coin
ConwayTxBodyRaw -> Coin
ctbrTreasuryDonation ((RawType (TxBody ConwayEra) -> Coin -> RawType (TxBody ConwayEra))
 -> Lens' (TxBody ConwayEra) Coin)
-> (RawType (TxBody ConwayEra)
    -> Coin -> RawType (TxBody ConwayEra))
-> Lens' (TxBody ConwayEra) Coin
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody ConwayEra)
txb Coin
x -> RawType (TxBody ConwayEra)
txb {ctbrTreasuryDonation = x}
  {-# INLINE treasuryDonationTxBodyL #-}

instance EqRaw (TxBody ConwayEra)

pattern ConwayTxBody ::
  Set TxIn ->
  Set TxIn ->
  Set TxIn ->
  StrictSeq (Sized (TxOut ConwayEra)) ->
  StrictMaybe (Sized (TxOut ConwayEra)) ->
  StrictMaybe Coin ->
  OSet.OSet (TxCert ConwayEra) ->
  Withdrawals ->
  Coin ->
  ValidityInterval ->
  Set (KeyHash 'Witness) ->
  MultiAsset ->
  StrictMaybe ScriptIntegrityHash ->
  StrictMaybe TxAuxDataHash ->
  StrictMaybe Network ->
  VotingProcedures ConwayEra ->
  OSet.OSet (ProposalProcedure ConwayEra) ->
  StrictMaybe Coin ->
  Coin ->
  TxBody ConwayEra
pattern $mConwayTxBody :: forall {r}.
TxBody ConwayEra
-> (Set TxIn
    -> Set TxIn
    -> Set TxIn
    -> StrictSeq (Sized (TxOut ConwayEra))
    -> StrictMaybe (Sized (TxOut ConwayEra))
    -> StrictMaybe Coin
    -> OSet (TxCert ConwayEra)
    -> Withdrawals
    -> Coin
    -> ValidityInterval
    -> Set (KeyHash 'Witness)
    -> MultiAsset
    -> StrictMaybe ScriptIntegrityHash
    -> StrictMaybe TxAuxDataHash
    -> StrictMaybe Network
    -> VotingProcedures ConwayEra
    -> OSet (ProposalProcedure ConwayEra)
    -> StrictMaybe Coin
    -> Coin
    -> r)
-> ((# #) -> r)
-> r
$bConwayTxBody :: Set TxIn
-> Set TxIn
-> Set TxIn
-> StrictSeq (Sized (TxOut ConwayEra))
-> StrictMaybe (Sized (TxOut ConwayEra))
-> StrictMaybe Coin
-> OSet (TxCert ConwayEra)
-> Withdrawals
-> Coin
-> ValidityInterval
-> Set (KeyHash 'Witness)
-> MultiAsset
-> StrictMaybe ScriptIntegrityHash
-> StrictMaybe TxAuxDataHash
-> StrictMaybe Network
-> VotingProcedures ConwayEra
-> OSet (ProposalProcedure ConwayEra)
-> StrictMaybe Coin
-> Coin
-> TxBody ConwayEra
ConwayTxBody
  { TxBody ConwayEra -> Set TxIn
ctbSpendInputs
  , TxBody ConwayEra -> Set TxIn
ctbCollateralInputs
  , TxBody ConwayEra -> Set TxIn
ctbReferenceInputs
  , TxBody ConwayEra -> StrictSeq (Sized (TxOut ConwayEra))
ctbOutputs
  , TxBody ConwayEra -> StrictMaybe (Sized (TxOut ConwayEra))
ctbCollateralReturn
  , TxBody ConwayEra -> StrictMaybe Coin
ctbTotalCollateral
  , TxBody ConwayEra -> OSet (TxCert ConwayEra)
ctbCerts
  , TxBody ConwayEra -> Withdrawals
ctbWithdrawals
  , TxBody ConwayEra -> Coin
ctbTxfee
  , TxBody ConwayEra -> ValidityInterval
ctbVldt
  , TxBody ConwayEra -> Set (KeyHash 'Witness)
ctbReqSignerHashes
  , TxBody ConwayEra -> MultiAsset
ctbMint
  , TxBody ConwayEra -> StrictMaybe ScriptIntegrityHash
ctbScriptIntegrityHash
  , TxBody ConwayEra -> StrictMaybe TxAuxDataHash
ctbAdHash
  , TxBody ConwayEra -> StrictMaybe Network
ctbTxNetworkId
  , TxBody ConwayEra -> VotingProcedures ConwayEra
ctbVotingProcedures
  , TxBody ConwayEra -> OSet (ProposalProcedure ConwayEra)
ctbProposalProcedures
  , TxBody ConwayEra -> StrictMaybe Coin
ctbCurrentTreasuryValue
  , TxBody ConwayEra -> Coin
ctbTreasuryDonation
  } <-
  ( getMemoRawType ->
      ConwayTxBodyRaw
        { ctbrSpendInputs = ctbSpendInputs
        , ctbrCollateralInputs = ctbCollateralInputs
        , ctbrReferenceInputs = ctbReferenceInputs
        , ctbrOutputs = ctbOutputs
        , ctbrCollateralReturn = ctbCollateralReturn
        , ctbrTotalCollateral = ctbTotalCollateral
        , ctbrCerts = ctbCerts
        , ctbrWithdrawals = ctbWithdrawals
        , ctbrFee = ctbTxfee
        , ctbrVldt = ctbVldt
        , ctbrReqSignerHashes = ctbReqSignerHashes
        , ctbrMint = ctbMint
        , ctbrScriptIntegrityHash = ctbScriptIntegrityHash
        , ctbrAuxDataHash = ctbAdHash
        , ctbrNetworkId = ctbTxNetworkId
        , ctbrVotingProcedures = ctbVotingProcedures
        , ctbrProposalProcedures = ctbProposalProcedures
        , ctbrCurrentTreasuryValue = ctbCurrentTreasuryValue
        , ctbrTreasuryDonation = ctbTreasuryDonation
        }
    )
  where
    ConwayTxBody
      Set TxIn
inputsX
      Set TxIn
collateralX
      Set TxIn
referenceInputsX
      StrictSeq (Sized (TxOut ConwayEra))
outputsX
      StrictMaybe (Sized (TxOut ConwayEra))
collateralReturnX
      StrictMaybe Coin
totalCollateralX
      OSet (TxCert ConwayEra)
certsX
      Withdrawals
withdrawalsX
      Coin
txfeeX
      ValidityInterval
vldtX
      Set (KeyHash 'Witness)
reqSignerHashesX
      MultiAsset
mintX
      StrictMaybe ScriptIntegrityHash
scriptIntegrityHashX
      StrictMaybe TxAuxDataHash
adHashX
      StrictMaybe Network
txnetworkidX
      VotingProcedures ConwayEra
votingProcedures
      OSet (ProposalProcedure ConwayEra)
proposalProcedures
      StrictMaybe Coin
currentTreasuryValue
      Coin
treasuryDonation =
        forall era t.
(Era era, EncCBOR (RawType t), Memoized t) =>
RawType t -> t
mkMemoizedEra @ConwayEra (RawType (TxBody ConwayEra) -> TxBody ConwayEra)
-> RawType (TxBody ConwayEra) -> TxBody ConwayEra
forall a b. (a -> b) -> a -> b
$
          Set TxIn
-> Set TxIn
-> Set TxIn
-> StrictSeq (Sized (TxOut ConwayEra))
-> StrictMaybe (Sized (TxOut ConwayEra))
-> StrictMaybe Coin
-> OSet (TxCert ConwayEra)
-> Withdrawals
-> Coin
-> ValidityInterval
-> Set (KeyHash 'Witness)
-> MultiAsset
-> StrictMaybe ScriptIntegrityHash
-> StrictMaybe TxAuxDataHash
-> StrictMaybe Network
-> VotingProcedures ConwayEra
-> OSet (ProposalProcedure ConwayEra)
-> StrictMaybe Coin
-> Coin
-> ConwayTxBodyRaw
ConwayTxBodyRaw
            Set TxIn
inputsX
            Set TxIn
collateralX
            Set TxIn
referenceInputsX
            StrictSeq (Sized (TxOut ConwayEra))
outputsX
            StrictMaybe (Sized (TxOut ConwayEra))
collateralReturnX
            StrictMaybe Coin
totalCollateralX
            OSet (TxCert ConwayEra)
certsX
            Withdrawals
withdrawalsX
            Coin
txfeeX
            ValidityInterval
vldtX
            Set (KeyHash 'Witness)
reqSignerHashesX
            MultiAsset
mintX
            StrictMaybe ScriptIntegrityHash
scriptIntegrityHashX
            StrictMaybe TxAuxDataHash
adHashX
            StrictMaybe Network
txnetworkidX
            VotingProcedures ConwayEra
votingProcedures
            OSet (ProposalProcedure ConwayEra)
proposalProcedures
            StrictMaybe Coin
currentTreasuryValue
            Coin
treasuryDonation

{-# COMPLETE ConwayTxBody #-}

--------------------------------------------------------------------------------
-- Serialisation
--------------------------------------------------------------------------------

encodeTxBodyRaw ::
  ConwayTxBodyRaw ->
  Encode ('Closed 'Sparse) ConwayTxBodyRaw
encodeTxBodyRaw :: ConwayTxBodyRaw -> Encode ('Closed 'Sparse) ConwayTxBodyRaw
encodeTxBodyRaw ConwayTxBodyRaw {OSet (TxCert ConwayEra)
OSet (ProposalProcedure ConwayEra)
Set (KeyHash 'Witness)
Set TxIn
StrictMaybe ScriptIntegrityHash
StrictMaybe TxAuxDataHash
StrictMaybe (Sized (TxOut ConwayEra))
StrictMaybe Network
StrictMaybe Coin
ValidityInterval
Withdrawals
StrictSeq (Sized (TxOut ConwayEra))
Coin
MultiAsset
VotingProcedures ConwayEra
ctbrSpendInputs :: ConwayTxBodyRaw -> Set TxIn
ctbrCollateralInputs :: ConwayTxBodyRaw -> Set TxIn
ctbrReferenceInputs :: ConwayTxBodyRaw -> Set TxIn
ctbrOutputs :: ConwayTxBodyRaw -> StrictSeq (Sized (TxOut ConwayEra))
ctbrCollateralReturn :: ConwayTxBodyRaw -> StrictMaybe (Sized (TxOut ConwayEra))
ctbrTotalCollateral :: ConwayTxBodyRaw -> StrictMaybe Coin
ctbrCerts :: ConwayTxBodyRaw -> OSet (TxCert ConwayEra)
ctbrWithdrawals :: ConwayTxBodyRaw -> Withdrawals
ctbrFee :: ConwayTxBodyRaw -> Coin
ctbrVldt :: ConwayTxBodyRaw -> ValidityInterval
ctbrReqSignerHashes :: ConwayTxBodyRaw -> Set (KeyHash 'Witness)
ctbrMint :: ConwayTxBodyRaw -> MultiAsset
ctbrScriptIntegrityHash :: ConwayTxBodyRaw -> StrictMaybe ScriptIntegrityHash
ctbrAuxDataHash :: ConwayTxBodyRaw -> StrictMaybe TxAuxDataHash
ctbrNetworkId :: ConwayTxBodyRaw -> StrictMaybe Network
ctbrVotingProcedures :: ConwayTxBodyRaw -> VotingProcedures ConwayEra
ctbrProposalProcedures :: ConwayTxBodyRaw -> OSet (ProposalProcedure ConwayEra)
ctbrCurrentTreasuryValue :: ConwayTxBodyRaw -> StrictMaybe Coin
ctbrTreasuryDonation :: ConwayTxBodyRaw -> Coin
ctbrSpendInputs :: Set TxIn
ctbrCollateralInputs :: Set TxIn
ctbrReferenceInputs :: Set TxIn
ctbrOutputs :: StrictSeq (Sized (TxOut ConwayEra))
ctbrCollateralReturn :: StrictMaybe (Sized (TxOut ConwayEra))
ctbrTotalCollateral :: StrictMaybe Coin
ctbrCerts :: OSet (TxCert ConwayEra)
ctbrWithdrawals :: Withdrawals
ctbrFee :: Coin
ctbrVldt :: ValidityInterval
ctbrReqSignerHashes :: Set (KeyHash 'Witness)
ctbrMint :: MultiAsset
ctbrScriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
ctbrAuxDataHash :: StrictMaybe TxAuxDataHash
ctbrNetworkId :: StrictMaybe Network
ctbrVotingProcedures :: VotingProcedures ConwayEra
ctbrProposalProcedures :: OSet (ProposalProcedure ConwayEra)
ctbrCurrentTreasuryValue :: StrictMaybe Coin
ctbrTreasuryDonation :: Coin
..} =
  let ValidityInterval StrictMaybe SlotNo
bot StrictMaybe SlotNo
top = ValidityInterval
ctbrVldt
   in (Set TxIn
 -> Set TxIn
 -> Set TxIn
 -> StrictSeq (Sized (BabbageTxOut ConwayEra))
 -> StrictMaybe (Sized (BabbageTxOut ConwayEra))
 -> StrictMaybe Coin
 -> Coin
 -> StrictMaybe SlotNo
 -> OSet (ConwayTxCert ConwayEra)
 -> Withdrawals
 -> StrictMaybe SlotNo
 -> Set (KeyHash 'Witness)
 -> MultiAsset
 -> StrictMaybe ScriptIntegrityHash
 -> StrictMaybe TxAuxDataHash
 -> StrictMaybe Network
 -> VotingProcedures ConwayEra
 -> OSet (ProposalProcedure ConwayEra)
 -> StrictMaybe Coin
 -> Coin
 -> ConwayTxBodyRaw)
-> Encode
     ('Closed 'Sparse)
     (Set TxIn
      -> Set TxIn
      -> Set TxIn
      -> StrictSeq (Sized (BabbageTxOut ConwayEra))
      -> StrictMaybe (Sized (BabbageTxOut ConwayEra))
      -> StrictMaybe Coin
      -> Coin
      -> StrictMaybe SlotNo
      -> OSet (ConwayTxCert ConwayEra)
      -> Withdrawals
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> VotingProcedures ConwayEra
      -> OSet (ProposalProcedure ConwayEra)
      -> StrictMaybe Coin
      -> Coin
      -> ConwayTxBodyRaw)
forall t. t -> Encode ('Closed 'Sparse) t
Keyed
        ( \Set TxIn
i Set TxIn
ci Set TxIn
ri StrictSeq (Sized (BabbageTxOut ConwayEra))
o StrictMaybe (Sized (BabbageTxOut ConwayEra))
cr StrictMaybe Coin
tc Coin
f StrictMaybe SlotNo
t OSet (ConwayTxCert ConwayEra)
c Withdrawals
w StrictMaybe SlotNo
b ->
            Set TxIn
-> Set TxIn
-> Set TxIn
-> StrictSeq (Sized (TxOut ConwayEra))
-> StrictMaybe (Sized (TxOut ConwayEra))
-> StrictMaybe Coin
-> OSet (TxCert ConwayEra)
-> Withdrawals
-> Coin
-> ValidityInterval
-> Set (KeyHash 'Witness)
-> MultiAsset
-> StrictMaybe ScriptIntegrityHash
-> StrictMaybe TxAuxDataHash
-> StrictMaybe Network
-> VotingProcedures ConwayEra
-> OSet (ProposalProcedure ConwayEra)
-> StrictMaybe Coin
-> Coin
-> ConwayTxBodyRaw
ConwayTxBodyRaw Set TxIn
i Set TxIn
ci Set TxIn
ri StrictSeq (Sized (TxOut ConwayEra))
StrictSeq (Sized (BabbageTxOut ConwayEra))
o StrictMaybe (Sized (TxOut ConwayEra))
StrictMaybe (Sized (BabbageTxOut ConwayEra))
cr StrictMaybe Coin
tc OSet (TxCert ConwayEra)
OSet (ConwayTxCert ConwayEra)
c Withdrawals
w Coin
f (StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval StrictMaybe SlotNo
b StrictMaybe SlotNo
t)
        )
        Encode
  ('Closed 'Sparse)
  (Set TxIn
   -> Set TxIn
   -> Set TxIn
   -> StrictSeq (Sized (BabbageTxOut ConwayEra))
   -> StrictMaybe (Sized (BabbageTxOut ConwayEra))
   -> StrictMaybe Coin
   -> Coin
   -> StrictMaybe SlotNo
   -> OSet (ConwayTxCert ConwayEra)
   -> Withdrawals
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> VotingProcedures ConwayEra
   -> OSet (ProposalProcedure ConwayEra)
   -> StrictMaybe Coin
   -> Coin
   -> ConwayTxBodyRaw)
-> Encode ('Closed 'Sparse) (Set TxIn)
-> Encode
     ('Closed 'Sparse)
     (Set TxIn
      -> Set TxIn
      -> StrictSeq (Sized (BabbageTxOut ConwayEra))
      -> StrictMaybe (Sized (BabbageTxOut ConwayEra))
      -> StrictMaybe Coin
      -> Coin
      -> StrictMaybe SlotNo
      -> OSet (ConwayTxCert ConwayEra)
      -> Withdrawals
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> VotingProcedures ConwayEra
      -> OSet (ProposalProcedure ConwayEra)
      -> StrictMaybe Coin
      -> Coin
      -> ConwayTxBodyRaw)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> Encode ('Closed 'Dense) (Set TxIn)
-> Encode ('Closed 'Sparse) (Set TxIn)
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
0 (Set TxIn -> Encode ('Closed 'Dense) (Set TxIn)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set TxIn
ctbrSpendInputs)
        Encode
  ('Closed 'Sparse)
  (Set TxIn
   -> Set TxIn
   -> StrictSeq (Sized (BabbageTxOut ConwayEra))
   -> StrictMaybe (Sized (BabbageTxOut ConwayEra))
   -> StrictMaybe Coin
   -> Coin
   -> StrictMaybe SlotNo
   -> OSet (ConwayTxCert ConwayEra)
   -> Withdrawals
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> VotingProcedures ConwayEra
   -> OSet (ProposalProcedure ConwayEra)
   -> StrictMaybe Coin
   -> Coin
   -> ConwayTxBodyRaw)
-> Encode ('Closed 'Sparse) (Set TxIn)
-> Encode
     ('Closed 'Sparse)
     (Set TxIn
      -> StrictSeq (Sized (BabbageTxOut ConwayEra))
      -> StrictMaybe (Sized (BabbageTxOut ConwayEra))
      -> StrictMaybe Coin
      -> Coin
      -> StrictMaybe SlotNo
      -> OSet (ConwayTxCert ConwayEra)
      -> Withdrawals
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> VotingProcedures ConwayEra
      -> OSet (ProposalProcedure ConwayEra)
      -> StrictMaybe Coin
      -> Coin
      -> ConwayTxBodyRaw)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Set TxIn -> Bool)
-> Encode ('Closed 'Sparse) (Set TxIn)
-> Encode ('Closed 'Sparse) (Set TxIn)
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit Set TxIn -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Word
-> Encode ('Closed 'Dense) (Set TxIn)
-> Encode ('Closed 'Sparse) (Set TxIn)
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
13 (Set TxIn -> Encode ('Closed 'Dense) (Set TxIn)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set TxIn
ctbrCollateralInputs))
        Encode
  ('Closed 'Sparse)
  (Set TxIn
   -> StrictSeq (Sized (BabbageTxOut ConwayEra))
   -> StrictMaybe (Sized (BabbageTxOut ConwayEra))
   -> StrictMaybe Coin
   -> Coin
   -> StrictMaybe SlotNo
   -> OSet (ConwayTxCert ConwayEra)
   -> Withdrawals
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> VotingProcedures ConwayEra
   -> OSet (ProposalProcedure ConwayEra)
   -> StrictMaybe Coin
   -> Coin
   -> ConwayTxBodyRaw)
-> Encode ('Closed 'Sparse) (Set TxIn)
-> Encode
     ('Closed 'Sparse)
     (StrictSeq (Sized (BabbageTxOut ConwayEra))
      -> StrictMaybe (Sized (BabbageTxOut ConwayEra))
      -> StrictMaybe Coin
      -> Coin
      -> StrictMaybe SlotNo
      -> OSet (ConwayTxCert ConwayEra)
      -> Withdrawals
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> VotingProcedures ConwayEra
      -> OSet (ProposalProcedure ConwayEra)
      -> StrictMaybe Coin
      -> Coin
      -> ConwayTxBodyRaw)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Set TxIn -> Bool)
-> Encode ('Closed 'Sparse) (Set TxIn)
-> Encode ('Closed 'Sparse) (Set TxIn)
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit Set TxIn -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Word
-> Encode ('Closed 'Dense) (Set TxIn)
-> Encode ('Closed 'Sparse) (Set TxIn)
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
18 (Set TxIn -> Encode ('Closed 'Dense) (Set TxIn)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set TxIn
ctbrReferenceInputs))
        Encode
  ('Closed 'Sparse)
  (StrictSeq (Sized (BabbageTxOut ConwayEra))
   -> StrictMaybe (Sized (BabbageTxOut ConwayEra))
   -> StrictMaybe Coin
   -> Coin
   -> StrictMaybe SlotNo
   -> OSet (ConwayTxCert ConwayEra)
   -> Withdrawals
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> VotingProcedures ConwayEra
   -> OSet (ProposalProcedure ConwayEra)
   -> StrictMaybe Coin
   -> Coin
   -> ConwayTxBodyRaw)
-> Encode
     ('Closed 'Sparse) (StrictSeq (Sized (BabbageTxOut ConwayEra)))
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe (Sized (BabbageTxOut ConwayEra))
      -> StrictMaybe Coin
      -> Coin
      -> StrictMaybe SlotNo
      -> OSet (ConwayTxCert ConwayEra)
      -> Withdrawals
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> VotingProcedures ConwayEra
      -> OSet (ProposalProcedure ConwayEra)
      -> StrictMaybe Coin
      -> Coin
      -> ConwayTxBodyRaw)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> Encode
     ('Closed 'Dense) (StrictSeq (Sized (BabbageTxOut ConwayEra)))
-> Encode
     ('Closed 'Sparse) (StrictSeq (Sized (BabbageTxOut ConwayEra)))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
1 (StrictSeq (Sized (BabbageTxOut ConwayEra))
-> Encode
     ('Closed 'Dense) (StrictSeq (Sized (BabbageTxOut ConwayEra)))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictSeq (Sized (TxOut ConwayEra))
StrictSeq (Sized (BabbageTxOut ConwayEra))
ctbrOutputs)
        Encode
  ('Closed 'Sparse)
  (StrictMaybe (Sized (BabbageTxOut ConwayEra))
   -> StrictMaybe Coin
   -> Coin
   -> StrictMaybe SlotNo
   -> OSet (ConwayTxCert ConwayEra)
   -> Withdrawals
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> VotingProcedures ConwayEra
   -> OSet (ProposalProcedure ConwayEra)
   -> StrictMaybe Coin
   -> Coin
   -> ConwayTxBodyRaw)
-> Encode
     ('Closed 'Sparse) (StrictMaybe (Sized (BabbageTxOut ConwayEra)))
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe Coin
      -> Coin
      -> StrictMaybe SlotNo
      -> OSet (ConwayTxCert ConwayEra)
      -> Withdrawals
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> VotingProcedures ConwayEra
      -> OSet (ProposalProcedure ConwayEra)
      -> StrictMaybe Coin
      -> Coin
      -> ConwayTxBodyRaw)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe (Sized (BabbageTxOut ConwayEra))
-> Encode
     ('Closed 'Sparse) (StrictMaybe (Sized (BabbageTxOut ConwayEra)))
forall a.
EncCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
16 StrictMaybe (Sized (TxOut ConwayEra))
StrictMaybe (Sized (BabbageTxOut ConwayEra))
ctbrCollateralReturn
        Encode
  ('Closed 'Sparse)
  (StrictMaybe Coin
   -> Coin
   -> StrictMaybe SlotNo
   -> OSet (ConwayTxCert ConwayEra)
   -> Withdrawals
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> VotingProcedures ConwayEra
   -> OSet (ProposalProcedure ConwayEra)
   -> StrictMaybe Coin
   -> Coin
   -> ConwayTxBodyRaw)
-> Encode ('Closed 'Sparse) (StrictMaybe Coin)
-> Encode
     ('Closed 'Sparse)
     (Coin
      -> StrictMaybe SlotNo
      -> OSet (ConwayTxCert ConwayEra)
      -> Withdrawals
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> VotingProcedures ConwayEra
      -> OSet (ProposalProcedure ConwayEra)
      -> StrictMaybe Coin
      -> Coin
      -> ConwayTxBodyRaw)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe Coin -> Encode ('Closed 'Sparse) (StrictMaybe Coin)
forall a.
EncCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
17 StrictMaybe Coin
ctbrTotalCollateral
        Encode
  ('Closed 'Sparse)
  (Coin
   -> StrictMaybe SlotNo
   -> OSet (ConwayTxCert ConwayEra)
   -> Withdrawals
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> VotingProcedures ConwayEra
   -> OSet (ProposalProcedure ConwayEra)
   -> StrictMaybe Coin
   -> Coin
   -> ConwayTxBodyRaw)
-> Encode ('Closed 'Sparse) Coin
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe SlotNo
      -> OSet (ConwayTxCert ConwayEra)
      -> Withdrawals
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> VotingProcedures ConwayEra
      -> OSet (ProposalProcedure ConwayEra)
      -> StrictMaybe Coin
      -> Coin
      -> ConwayTxBodyRaw)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> Encode ('Closed 'Dense) Coin -> Encode ('Closed 'Sparse) Coin
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
2 (Coin -> Encode ('Closed 'Dense) Coin
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
ctbrFee)
        Encode
  ('Closed 'Sparse)
  (StrictMaybe SlotNo
   -> OSet (ConwayTxCert ConwayEra)
   -> Withdrawals
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> VotingProcedures ConwayEra
   -> OSet (ProposalProcedure ConwayEra)
   -> StrictMaybe Coin
   -> Coin
   -> ConwayTxBodyRaw)
-> Encode ('Closed 'Sparse) (StrictMaybe SlotNo)
-> Encode
     ('Closed 'Sparse)
     (OSet (ConwayTxCert ConwayEra)
      -> Withdrawals
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> VotingProcedures ConwayEra
      -> OSet (ProposalProcedure ConwayEra)
      -> StrictMaybe Coin
      -> Coin
      -> ConwayTxBodyRaw)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe SlotNo
-> Encode ('Closed 'Sparse) (StrictMaybe SlotNo)
forall a.
EncCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
3 StrictMaybe SlotNo
top
        Encode
  ('Closed 'Sparse)
  (OSet (ConwayTxCert ConwayEra)
   -> Withdrawals
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> VotingProcedures ConwayEra
   -> OSet (ProposalProcedure ConwayEra)
   -> StrictMaybe Coin
   -> Coin
   -> ConwayTxBodyRaw)
-> Encode ('Closed 'Sparse) (OSet (ConwayTxCert ConwayEra))
-> Encode
     ('Closed 'Sparse)
     (Withdrawals
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> VotingProcedures ConwayEra
      -> OSet (ProposalProcedure ConwayEra)
      -> StrictMaybe Coin
      -> Coin
      -> ConwayTxBodyRaw)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (OSet (ConwayTxCert ConwayEra) -> Bool)
-> Encode ('Closed 'Sparse) (OSet (ConwayTxCert ConwayEra))
-> Encode ('Closed 'Sparse) (OSet (ConwayTxCert ConwayEra))
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit OSet (ConwayTxCert ConwayEra) -> Bool
forall a. OSet a -> Bool
OSet.null (Word
-> Encode ('Closed 'Dense) (OSet (ConwayTxCert ConwayEra))
-> Encode ('Closed 'Sparse) (OSet (ConwayTxCert ConwayEra))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
4 (OSet (ConwayTxCert ConwayEra)
-> Encode ('Closed 'Dense) (OSet (ConwayTxCert ConwayEra))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To OSet (TxCert ConwayEra)
OSet (ConwayTxCert ConwayEra)
ctbrCerts))
        Encode
  ('Closed 'Sparse)
  (Withdrawals
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> VotingProcedures ConwayEra
   -> OSet (ProposalProcedure ConwayEra)
   -> StrictMaybe Coin
   -> Coin
   -> ConwayTxBodyRaw)
-> Encode ('Closed 'Sparse) Withdrawals
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe SlotNo
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> VotingProcedures ConwayEra
      -> OSet (ProposalProcedure ConwayEra)
      -> StrictMaybe Coin
      -> Coin
      -> ConwayTxBodyRaw)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Withdrawals -> Bool)
-> Encode ('Closed 'Sparse) Withdrawals
-> Encode ('Closed 'Sparse) Withdrawals
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit (Map RewardAccount Coin -> Bool
forall a. Map RewardAccount a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map RewardAccount Coin -> Bool)
-> (Withdrawals -> Map RewardAccount Coin) -> Withdrawals -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Withdrawals -> Map RewardAccount Coin
unWithdrawals) (Word
-> Encode ('Closed 'Dense) Withdrawals
-> Encode ('Closed 'Sparse) Withdrawals
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
5 (Withdrawals -> Encode ('Closed 'Dense) Withdrawals
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Withdrawals
ctbrWithdrawals))
        Encode
  ('Closed 'Sparse)
  (StrictMaybe SlotNo
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> VotingProcedures ConwayEra
   -> OSet (ProposalProcedure ConwayEra)
   -> StrictMaybe Coin
   -> Coin
   -> ConwayTxBodyRaw)
-> Encode ('Closed 'Sparse) (StrictMaybe SlotNo)
-> Encode
     ('Closed 'Sparse)
     (Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> VotingProcedures ConwayEra
      -> OSet (ProposalProcedure ConwayEra)
      -> StrictMaybe Coin
      -> Coin
      -> ConwayTxBodyRaw)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe SlotNo
-> Encode ('Closed 'Sparse) (StrictMaybe SlotNo)
forall a.
EncCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
8 StrictMaybe SlotNo
bot
        Encode
  ('Closed 'Sparse)
  (Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> VotingProcedures ConwayEra
   -> OSet (ProposalProcedure ConwayEra)
   -> StrictMaybe Coin
   -> Coin
   -> ConwayTxBodyRaw)
-> Encode ('Closed 'Sparse) (Set (KeyHash 'Witness))
-> Encode
     ('Closed 'Sparse)
     (MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> VotingProcedures ConwayEra
      -> OSet (ProposalProcedure ConwayEra)
      -> StrictMaybe Coin
      -> Coin
      -> ConwayTxBodyRaw)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Set (KeyHash 'Witness) -> Bool)
-> Encode ('Closed 'Sparse) (Set (KeyHash 'Witness))
-> Encode ('Closed 'Sparse) (Set (KeyHash 'Witness))
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit Set (KeyHash 'Witness) -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Word
-> Encode ('Closed 'Dense) (Set (KeyHash 'Witness))
-> Encode ('Closed 'Sparse) (Set (KeyHash 'Witness))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
14 (Set (KeyHash 'Witness)
-> Encode ('Closed 'Dense) (Set (KeyHash 'Witness))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set (KeyHash 'Witness)
ctbrReqSignerHashes))
        Encode
  ('Closed 'Sparse)
  (MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> VotingProcedures ConwayEra
   -> OSet (ProposalProcedure ConwayEra)
   -> StrictMaybe Coin
   -> Coin
   -> ConwayTxBodyRaw)
-> Encode ('Closed 'Sparse) MultiAsset
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> VotingProcedures ConwayEra
      -> OSet (ProposalProcedure ConwayEra)
      -> StrictMaybe Coin
      -> Coin
      -> ConwayTxBodyRaw)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (MultiAsset -> Bool)
-> Encode ('Closed 'Sparse) MultiAsset
-> Encode ('Closed 'Sparse) MultiAsset
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit (MultiAsset -> MultiAsset -> Bool
forall a. Eq a => a -> a -> Bool
== MultiAsset
forall a. Monoid a => a
mempty) (Word
-> Encode ('Closed 'Dense) MultiAsset
-> Encode ('Closed 'Sparse) MultiAsset
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
9 (MultiAsset -> Encode ('Closed 'Dense) MultiAsset
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To MultiAsset
ctbrMint))
        Encode
  ('Closed 'Sparse)
  (StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> VotingProcedures ConwayEra
   -> OSet (ProposalProcedure ConwayEra)
   -> StrictMaybe Coin
   -> Coin
   -> ConwayTxBodyRaw)
-> Encode ('Closed 'Sparse) (StrictMaybe ScriptIntegrityHash)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> VotingProcedures ConwayEra
      -> OSet (ProposalProcedure ConwayEra)
      -> StrictMaybe Coin
      -> Coin
      -> ConwayTxBodyRaw)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe ScriptIntegrityHash
-> Encode ('Closed 'Sparse) (StrictMaybe ScriptIntegrityHash)
forall a.
EncCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
11 StrictMaybe ScriptIntegrityHash
ctbrScriptIntegrityHash
        Encode
  ('Closed 'Sparse)
  (StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> VotingProcedures ConwayEra
   -> OSet (ProposalProcedure ConwayEra)
   -> StrictMaybe Coin
   -> Coin
   -> ConwayTxBodyRaw)
-> Encode ('Closed 'Sparse) (StrictMaybe TxAuxDataHash)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe Network
      -> VotingProcedures ConwayEra
      -> OSet (ProposalProcedure ConwayEra)
      -> StrictMaybe Coin
      -> Coin
      -> ConwayTxBodyRaw)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe TxAuxDataHash
-> Encode ('Closed 'Sparse) (StrictMaybe TxAuxDataHash)
forall a.
EncCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
7 StrictMaybe TxAuxDataHash
ctbrAuxDataHash
        Encode
  ('Closed 'Sparse)
  (StrictMaybe Network
   -> VotingProcedures ConwayEra
   -> OSet (ProposalProcedure ConwayEra)
   -> StrictMaybe Coin
   -> Coin
   -> ConwayTxBodyRaw)
-> Encode ('Closed 'Sparse) (StrictMaybe Network)
-> Encode
     ('Closed 'Sparse)
     (VotingProcedures ConwayEra
      -> OSet (ProposalProcedure ConwayEra)
      -> StrictMaybe Coin
      -> Coin
      -> ConwayTxBodyRaw)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe Network
-> Encode ('Closed 'Sparse) (StrictMaybe Network)
forall a.
EncCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
15 StrictMaybe Network
ctbrNetworkId
        Encode
  ('Closed 'Sparse)
  (VotingProcedures ConwayEra
   -> OSet (ProposalProcedure ConwayEra)
   -> StrictMaybe Coin
   -> Coin
   -> ConwayTxBodyRaw)
-> Encode ('Closed 'Sparse) (VotingProcedures ConwayEra)
-> Encode
     ('Closed 'Sparse)
     (OSet (ProposalProcedure ConwayEra)
      -> StrictMaybe Coin -> Coin -> ConwayTxBodyRaw)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (VotingProcedures ConwayEra -> Bool)
-> Encode ('Closed 'Sparse) (VotingProcedures ConwayEra)
-> Encode ('Closed 'Sparse) (VotingProcedures ConwayEra)
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit (Map Voter (Map GovActionId (VotingProcedure ConwayEra)) -> Bool
forall a. Map Voter a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map Voter (Map GovActionId (VotingProcedure ConwayEra)) -> Bool)
-> (VotingProcedures ConwayEra
    -> Map Voter (Map GovActionId (VotingProcedure ConwayEra)))
-> VotingProcedures ConwayEra
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VotingProcedures ConwayEra
-> Map Voter (Map GovActionId (VotingProcedure ConwayEra))
forall era.
VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
unVotingProcedures) (Word
-> Encode ('Closed 'Dense) (VotingProcedures ConwayEra)
-> Encode ('Closed 'Sparse) (VotingProcedures ConwayEra)
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
19 (VotingProcedures ConwayEra
-> Encode ('Closed 'Dense) (VotingProcedures ConwayEra)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To VotingProcedures ConwayEra
ctbrVotingProcedures))
        Encode
  ('Closed 'Sparse)
  (OSet (ProposalProcedure ConwayEra)
   -> StrictMaybe Coin -> Coin -> ConwayTxBodyRaw)
-> Encode ('Closed 'Sparse) (OSet (ProposalProcedure ConwayEra))
-> Encode
     ('Closed 'Sparse) (StrictMaybe Coin -> Coin -> ConwayTxBodyRaw)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (OSet (ProposalProcedure ConwayEra) -> Bool)
-> Encode ('Closed 'Sparse) (OSet (ProposalProcedure ConwayEra))
-> Encode ('Closed 'Sparse) (OSet (ProposalProcedure ConwayEra))
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit OSet (ProposalProcedure ConwayEra) -> Bool
forall a. OSet a -> Bool
OSet.null (Word
-> Encode ('Closed 'Dense) (OSet (ProposalProcedure ConwayEra))
-> Encode ('Closed 'Sparse) (OSet (ProposalProcedure ConwayEra))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
20 (OSet (ProposalProcedure ConwayEra)
-> Encode ('Closed 'Dense) (OSet (ProposalProcedure ConwayEra))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To OSet (ProposalProcedure ConwayEra)
ctbrProposalProcedures))
        Encode
  ('Closed 'Sparse) (StrictMaybe Coin -> Coin -> ConwayTxBodyRaw)
-> Encode ('Closed 'Sparse) (StrictMaybe Coin)
-> Encode ('Closed 'Sparse) (Coin -> ConwayTxBodyRaw)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe Coin -> Encode ('Closed 'Sparse) (StrictMaybe Coin)
forall a.
EncCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
21 StrictMaybe Coin
ctbrCurrentTreasuryValue
        Encode ('Closed 'Sparse) (Coin -> ConwayTxBodyRaw)
-> Encode ('Closed 'Sparse) Coin
-> Encode ('Closed 'Sparse) ConwayTxBodyRaw
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Coin -> Bool)
-> Encode ('Closed 'Sparse) Coin -> Encode ('Closed 'Sparse) Coin
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit (Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== Coin
forall a. Monoid a => a
mempty) (Word
-> Encode ('Closed 'Dense) Coin -> Encode ('Closed 'Sparse) Coin
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
22 (Encode ('Closed 'Dense) Coin -> Encode ('Closed 'Sparse) Coin)
-> Encode ('Closed 'Dense) Coin -> Encode ('Closed 'Sparse) Coin
forall a b. (a -> b) -> a -> b
$ Coin -> Encode ('Closed 'Dense) Coin
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
ctbrTreasuryDonation)

instance EncCBOR ConwayTxBodyRaw where
  encCBOR :: ConwayTxBodyRaw -> Encoding
encCBOR = Encode ('Closed 'Sparse) ConwayTxBodyRaw -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Sparse) ConwayTxBodyRaw -> Encoding)
-> (ConwayTxBodyRaw -> Encode ('Closed 'Sparse) ConwayTxBodyRaw)
-> ConwayTxBodyRaw
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayTxBodyRaw -> Encode ('Closed 'Sparse) ConwayTxBodyRaw
encodeTxBodyRaw

-- | Encodes memoized bytes created upon construction.
instance EncCBOR (TxBody ConwayEra)

class
  (BabbageEraTxBody era, ConwayEraTxCert era, ConwayEraPParams era, ConwayEraScript era) =>
  ConwayEraTxBody era
  where
  -- | Lens for getting and setting number of `Coin` that is expected to be in the
  -- Treasury at the current Epoch
  currentTreasuryValueTxBodyL :: Lens' (TxBody era) (StrictMaybe Coin)

  -- | Lens for getting and setting `VotingProcedures`.
  votingProceduresTxBodyL :: Lens' (TxBody era) (VotingProcedures era)

  -- | Lens for getting and setting `ProposalProcedures`.
  proposalProceduresTxBodyL :: Lens' (TxBody era) (OSet.OSet (ProposalProcedure era))

  treasuryDonationTxBodyL :: Lens' (TxBody era) Coin

conwayRedeemerPointer ::
  forall era.
  ConwayEraTxBody era =>
  TxBody era ->
  ConwayPlutusPurpose AsItem era ->
  StrictMaybe (ConwayPlutusPurpose AsIx era)
conwayRedeemerPointer :: forall era.
ConwayEraTxBody era =>
TxBody era
-> ConwayPlutusPurpose AsItem era
-> StrictMaybe (ConwayPlutusPurpose AsIx era)
conwayRedeemerPointer TxBody era
txBody = \case
  ConwayMinting AsItem Word32 PolicyID
policyID ->
    AsIx Word32 PolicyID -> ConwayPlutusPurpose AsIx era
forall (f :: * -> * -> *) era.
f Word32 PolicyID -> ConwayPlutusPurpose f era
ConwayMinting (AsIx Word32 PolicyID -> ConwayPlutusPurpose AsIx era)
-> StrictMaybe (AsIx Word32 PolicyID)
-> StrictMaybe (ConwayPlutusPurpose AsIx era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsItem Word32 PolicyID
-> Set PolicyID -> StrictMaybe (AsIx Word32 PolicyID)
forall elem container.
Indexable elem container =>
AsItem Word32 elem -> container -> StrictMaybe (AsIx Word32 elem)
indexOf AsItem Word32 PolicyID
policyID (TxBody era
txBody TxBody era
-> Getting (Set PolicyID) (TxBody era) (Set PolicyID)
-> Set PolicyID
forall s a. s -> Getting a s a -> a
^. Getting (Set PolicyID) (TxBody era) (Set PolicyID)
forall era.
MaryEraTxBody era =>
SimpleGetter (TxBody era) (Set PolicyID)
SimpleGetter (TxBody era) (Set PolicyID)
mintedTxBodyF)
  ConwaySpending AsItem Word32 TxIn
txIn ->
    AsIx Word32 TxIn -> ConwayPlutusPurpose AsIx era
forall (f :: * -> * -> *) era.
f Word32 TxIn -> ConwayPlutusPurpose f era
ConwaySpending (AsIx Word32 TxIn -> ConwayPlutusPurpose AsIx era)
-> StrictMaybe (AsIx Word32 TxIn)
-> StrictMaybe (ConwayPlutusPurpose AsIx era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsItem Word32 TxIn -> Set TxIn -> StrictMaybe (AsIx Word32 TxIn)
forall elem container.
Indexable elem container =>
AsItem Word32 elem -> container -> StrictMaybe (AsIx Word32 elem)
indexOf AsItem Word32 TxIn
txIn (TxBody era
txBody TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL)
  ConwayRewarding AsItem Word32 RewardAccount
rewardAccount ->
    AsIx Word32 RewardAccount -> ConwayPlutusPurpose AsIx era
forall (f :: * -> * -> *) era.
f Word32 RewardAccount -> ConwayPlutusPurpose f era
ConwayRewarding (AsIx Word32 RewardAccount -> ConwayPlutusPurpose AsIx era)
-> StrictMaybe (AsIx Word32 RewardAccount)
-> StrictMaybe (ConwayPlutusPurpose AsIx era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsItem Word32 RewardAccount
-> Map RewardAccount Coin
-> StrictMaybe (AsIx Word32 RewardAccount)
forall elem container.
Indexable elem container =>
AsItem Word32 elem -> container -> StrictMaybe (AsIx Word32 elem)
indexOf AsItem Word32 RewardAccount
rewardAccount (Withdrawals -> Map RewardAccount Coin
unWithdrawals (TxBody era
txBody TxBody era
-> Getting Withdrawals (TxBody era) Withdrawals -> Withdrawals
forall s a. s -> Getting a s a -> a
^. Getting Withdrawals (TxBody era) Withdrawals
forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL))
  ConwayCertifying AsItem Word32 (TxCert era)
txCert ->
    AsIx Word32 (TxCert era) -> ConwayPlutusPurpose AsIx era
forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> ConwayPlutusPurpose f era
ConwayCertifying (AsIx Word32 (TxCert era) -> ConwayPlutusPurpose AsIx era)
-> StrictMaybe (AsIx Word32 (TxCert era))
-> StrictMaybe (ConwayPlutusPurpose AsIx era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsItem Word32 (TxCert era)
-> StrictSeq (TxCert era) -> StrictMaybe (AsIx Word32 (TxCert era))
forall elem container.
Indexable elem container =>
AsItem Word32 elem -> container -> StrictMaybe (AsIx Word32 elem)
indexOf AsItem Word32 (TxCert era)
txCert (TxBody era
txBody TxBody era
-> Getting
     (StrictSeq (TxCert era)) (TxBody era) (StrictSeq (TxCert era))
-> StrictSeq (TxCert era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxCert era)) (TxBody era) (StrictSeq (TxCert era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL)
  ConwayVoting AsItem Word32 Voter
votingProcedure ->
    AsIx Word32 Voter -> ConwayPlutusPurpose AsIx era
forall (f :: * -> * -> *) era.
f Word32 Voter -> ConwayPlutusPurpose f era
ConwayVoting (AsIx Word32 Voter -> ConwayPlutusPurpose AsIx era)
-> StrictMaybe (AsIx Word32 Voter)
-> StrictMaybe (ConwayPlutusPurpose AsIx era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsItem Word32 Voter
-> VotingProcedures era -> StrictMaybe (AsIx Word32 Voter)
forall elem container.
Indexable elem container =>
AsItem Word32 elem -> container -> StrictMaybe (AsIx Word32 elem)
indexOf AsItem Word32 Voter
votingProcedure (TxBody era
txBody TxBody era
-> Getting
     (VotingProcedures era) (TxBody era) (VotingProcedures era)
-> VotingProcedures era
forall s a. s -> Getting a s a -> a
^. Getting (VotingProcedures era) (TxBody era) (VotingProcedures era)
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (VotingProcedures era)
Lens' (TxBody era) (VotingProcedures era)
votingProceduresTxBodyL)
  ConwayProposing AsItem Word32 (ProposalProcedure era)
proposalProcedure ->
    AsIx Word32 (ProposalProcedure era) -> ConwayPlutusPurpose AsIx era
forall (f :: * -> * -> *) era.
f Word32 (ProposalProcedure era) -> ConwayPlutusPurpose f era
ConwayProposing (AsIx Word32 (ProposalProcedure era)
 -> ConwayPlutusPurpose AsIx era)
-> StrictMaybe (AsIx Word32 (ProposalProcedure era))
-> StrictMaybe (ConwayPlutusPurpose AsIx era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsItem Word32 (ProposalProcedure era)
-> OSet (ProposalProcedure era)
-> StrictMaybe (AsIx Word32 (ProposalProcedure era))
forall elem container.
Indexable elem container =>
AsItem Word32 elem -> container -> StrictMaybe (AsIx Word32 elem)
indexOf AsItem Word32 (ProposalProcedure era)
proposalProcedure (TxBody era
txBody TxBody era
-> Getting
     (OSet (ProposalProcedure era))
     (TxBody era)
     (OSet (ProposalProcedure era))
-> OSet (ProposalProcedure era)
forall s a. s -> Getting a s a -> a
^. Getting
  (OSet (ProposalProcedure era))
  (TxBody era)
  (OSet (ProposalProcedure era))
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (OSet (ProposalProcedure era))
Lens' (TxBody era) (OSet (ProposalProcedure era))
proposalProceduresTxBodyL)

conwayRedeemerPointerInverse ::
  ConwayEraTxBody era =>
  TxBody era ->
  ConwayPlutusPurpose AsIx era ->
  StrictMaybe (ConwayPlutusPurpose AsIxItem era)
conwayRedeemerPointerInverse :: forall era.
ConwayEraTxBody era =>
TxBody era
-> ConwayPlutusPurpose AsIx era
-> StrictMaybe (ConwayPlutusPurpose AsIxItem era)
conwayRedeemerPointerInverse TxBody era
txBody = \case
  ConwayMinting AsIx Word32 PolicyID
idx ->
    AsIxItem Word32 PolicyID -> ConwayPlutusPurpose AsIxItem era
forall (f :: * -> * -> *) era.
f Word32 PolicyID -> ConwayPlutusPurpose f era
ConwayMinting (AsIxItem Word32 PolicyID -> ConwayPlutusPurpose AsIxItem era)
-> StrictMaybe (AsIxItem Word32 PolicyID)
-> StrictMaybe (ConwayPlutusPurpose AsIxItem era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsIx Word32 PolicyID
-> Set PolicyID -> StrictMaybe (AsIxItem Word32 PolicyID)
forall elem container.
Indexable elem container =>
AsIx Word32 elem -> container -> StrictMaybe (AsIxItem Word32 elem)
fromIndex AsIx Word32 PolicyID
idx (TxBody era
txBody TxBody era
-> Getting (Set PolicyID) (TxBody era) (Set PolicyID)
-> Set PolicyID
forall s a. s -> Getting a s a -> a
^. Getting (Set PolicyID) (TxBody era) (Set PolicyID)
forall era.
MaryEraTxBody era =>
SimpleGetter (TxBody era) (Set PolicyID)
SimpleGetter (TxBody era) (Set PolicyID)
mintedTxBodyF)
  ConwaySpending AsIx Word32 TxIn
idx ->
    AsIxItem Word32 TxIn -> ConwayPlutusPurpose AsIxItem era
forall (f :: * -> * -> *) era.
f Word32 TxIn -> ConwayPlutusPurpose f era
ConwaySpending (AsIxItem Word32 TxIn -> ConwayPlutusPurpose AsIxItem era)
-> StrictMaybe (AsIxItem Word32 TxIn)
-> StrictMaybe (ConwayPlutusPurpose AsIxItem era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsIx Word32 TxIn -> Set TxIn -> StrictMaybe (AsIxItem Word32 TxIn)
forall elem container.
Indexable elem container =>
AsIx Word32 elem -> container -> StrictMaybe (AsIxItem Word32 elem)
fromIndex AsIx Word32 TxIn
idx (TxBody era
txBody TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL)
  ConwayRewarding AsIx Word32 RewardAccount
idx ->
    AsIxItem Word32 RewardAccount -> ConwayPlutusPurpose AsIxItem era
forall (f :: * -> * -> *) era.
f Word32 RewardAccount -> ConwayPlutusPurpose f era
ConwayRewarding (AsIxItem Word32 RewardAccount -> ConwayPlutusPurpose AsIxItem era)
-> StrictMaybe (AsIxItem Word32 RewardAccount)
-> StrictMaybe (ConwayPlutusPurpose AsIxItem era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsIx Word32 RewardAccount
-> Map RewardAccount Coin
-> StrictMaybe (AsIxItem Word32 RewardAccount)
forall elem container.
Indexable elem container =>
AsIx Word32 elem -> container -> StrictMaybe (AsIxItem Word32 elem)
fromIndex AsIx Word32 RewardAccount
idx (Withdrawals -> Map RewardAccount Coin
unWithdrawals (TxBody era
txBody TxBody era
-> Getting Withdrawals (TxBody era) Withdrawals -> Withdrawals
forall s a. s -> Getting a s a -> a
^. Getting Withdrawals (TxBody era) Withdrawals
forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL))
  ConwayCertifying AsIx Word32 (TxCert era)
idx ->
    AsIxItem Word32 (TxCert era) -> ConwayPlutusPurpose AsIxItem era
forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> ConwayPlutusPurpose f era
ConwayCertifying (AsIxItem Word32 (TxCert era) -> ConwayPlutusPurpose AsIxItem era)
-> StrictMaybe (AsIxItem Word32 (TxCert era))
-> StrictMaybe (ConwayPlutusPurpose AsIxItem era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsIx Word32 (TxCert era)
-> StrictSeq (TxCert era)
-> StrictMaybe (AsIxItem Word32 (TxCert era))
forall elem container.
Indexable elem container =>
AsIx Word32 elem -> container -> StrictMaybe (AsIxItem Word32 elem)
fromIndex AsIx Word32 (TxCert era)
idx (TxBody era
txBody TxBody era
-> Getting
     (StrictSeq (TxCert era)) (TxBody era) (StrictSeq (TxCert era))
-> StrictSeq (TxCert era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxCert era)) (TxBody era) (StrictSeq (TxCert era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL)
  ConwayVoting AsIx Word32 Voter
idx ->
    AsIxItem Word32 Voter -> ConwayPlutusPurpose AsIxItem era
forall (f :: * -> * -> *) era.
f Word32 Voter -> ConwayPlutusPurpose f era
ConwayVoting (AsIxItem Word32 Voter -> ConwayPlutusPurpose AsIxItem era)
-> StrictMaybe (AsIxItem Word32 Voter)
-> StrictMaybe (ConwayPlutusPurpose AsIxItem era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsIx Word32 Voter
-> VotingProcedures era -> StrictMaybe (AsIxItem Word32 Voter)
forall elem container.
Indexable elem container =>
AsIx Word32 elem -> container -> StrictMaybe (AsIxItem Word32 elem)
fromIndex AsIx Word32 Voter
idx (TxBody era
txBody TxBody era
-> Getting
     (VotingProcedures era) (TxBody era) (VotingProcedures era)
-> VotingProcedures era
forall s a. s -> Getting a s a -> a
^. Getting (VotingProcedures era) (TxBody era) (VotingProcedures era)
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (VotingProcedures era)
Lens' (TxBody era) (VotingProcedures era)
votingProceduresTxBodyL)
  ConwayProposing AsIx Word32 (ProposalProcedure era)
idx ->
    AsIxItem Word32 (ProposalProcedure era)
-> ConwayPlutusPurpose AsIxItem era
forall (f :: * -> * -> *) era.
f Word32 (ProposalProcedure era) -> ConwayPlutusPurpose f era
ConwayProposing (AsIxItem Word32 (ProposalProcedure era)
 -> ConwayPlutusPurpose AsIxItem era)
-> StrictMaybe (AsIxItem Word32 (ProposalProcedure era))
-> StrictMaybe (ConwayPlutusPurpose AsIxItem era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsIx Word32 (ProposalProcedure era)
-> OSet (ProposalProcedure era)
-> StrictMaybe (AsIxItem Word32 (ProposalProcedure era))
forall elem container.
Indexable elem container =>
AsIx Word32 elem -> container -> StrictMaybe (AsIxItem Word32 elem)
fromIndex AsIx Word32 (ProposalProcedure era)
idx (TxBody era
txBody TxBody era
-> Getting
     (OSet (ProposalProcedure era))
     (TxBody era)
     (OSet (ProposalProcedure era))
-> OSet (ProposalProcedure era)
forall s a. s -> Getting a s a -> a
^. Getting
  (OSet (ProposalProcedure era))
  (TxBody era)
  (OSet (ProposalProcedure era))
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (OSet (ProposalProcedure era))
Lens' (TxBody era) (OSet (ProposalProcedure era))
proposalProceduresTxBodyL)