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

module Cardano.Ledger.Alonzo.TxBody (
  AlonzoTxOut (..),
  AlonzoEraTxOut (..),
  -- Constructors are not exported for safety:
  Addr28Extra,
  DataHash32,
  TxBody (
    MkAlonzoTxBody,
    AlonzoTxBody,
    atbInputs,
    atbCollateral,
    atbOutputs,
    atbCerts,
    atbWithdrawals,
    atbTxFee,
    atbValidityInterval,
    atbUpdate,
    atbReqSignerHashes,
    atbMint,
    atbScriptIntegrityHash,
    atbAuxDataHash,
    atbTxNetworkId
  ),
  AlonzoTxBodyRaw (..),
  AlonzoTxBodyUpgradeError (..),
  AlonzoEraTxBody (..),
  ShelleyEraTxBody (..),
  AllegraEraTxBody (..),
  MaryEraTxBody (..),
  Indexable (..),
  inputs',
  collateral',
  outputs',
  certs',
  withdrawals',
  txfee',
  vldt',
  update',
  reqSignerHashes',
  mint',
  scriptIntegrityHash',
  adHash',
  txnetworkid',
  getAdaOnly,
  decodeDataHash32,
  encodeDataHash32,
  encodeAddress28,
  decodeAddress28,
  viewCompactTxOut,
  viewTxOut,
  EraIndependentScriptIntegrity,
  ScriptIntegrityHash,
  getAlonzoTxOutEitherAddr,
  utxoEntrySize,
  alonzoRedeemerPointer,
  alonzoRedeemerPointerInverse,
) where

import Cardano.Ledger.Alonzo.Era
import Cardano.Ledger.Alonzo.PParams ()
import Cardano.Ledger.Alonzo.Scripts (
  AlonzoPlutusPurpose (..),
  AsItem (..),
  AsIx (..),
  AsIxItem (..),
  PlutusPurpose,
 )
import Cardano.Ledger.Alonzo.TxAuxData ()
import Cardano.Ledger.Alonzo.TxCert ()
import Cardano.Ledger.Alonzo.TxOut
import Cardano.Ledger.BaseTypes (
  Network (..),
  StrictMaybe (..),
 )
import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
  ToCBOR (..),
 )
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Mary (MaryEra)
import Cardano.Ledger.Mary.Core
import Cardano.Ledger.Mary.TxBody (
  TxBody (..),
 )
import Cardano.Ledger.Mary.Value (
  MultiAsset (..),
  PolicyID (..),
  policies,
 )
import Cardano.Ledger.MemoBytes (
  EqRaw,
  MemoBytes,
  MemoHashIndex,
  Memoized (..),
  getMemoRawType,
  getMemoSafeHash,
  lensMemoRawType,
  mkMemoizedEra,
 )
import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates (..), Update (..))
import Cardano.Ledger.Shelley.TxBody (getShelleyGenesisKeyHashCountTxBody)
import Cardano.Ledger.TxIn (TxIn (..))
import Control.Arrow (left)
import Control.DeepSeq (NFData (..))
import Control.Monad (when)
import Data.Default (def)
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict (isSJust)
import Data.OSet.Strict (OSet)
import qualified Data.OSet.Strict as OSet
import Data.Sequence.Strict (StrictSeq)
import qualified Data.Sequence.Strict as StrictSeq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Void (absurd)
import Data.Word (Word32)
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks)

type ScriptIntegrityHash = SafeHash EraIndependentScriptIntegrity

class (MaryEraTxBody era, AlonzoEraTxOut era) => AlonzoEraTxBody era where
  collateralInputsTxBodyL :: Lens' (TxBody era) (Set TxIn)

  reqSignerHashesTxBodyL :: Lens' (TxBody era) (Set (KeyHash 'Witness))

  scriptIntegrityHashTxBodyL ::
    Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)

  networkIdTxBodyL :: Lens' (TxBody era) (StrictMaybe Network)

  -- | This function is called @rdptr@ in the spec. Given a `TxBody` and a plutus
  -- purpose with an item, we should be able to find the plutus purpose as in index
  redeemerPointer ::
    TxBody era ->
    PlutusPurpose AsItem era ->
    StrictMaybe (PlutusPurpose AsIx era)

  -- | This is an inverse of `redeemerPointer`. Given purpose as an index return it as an item.
  redeemerPointerInverse ::
    TxBody era ->
    PlutusPurpose AsIx era ->
    StrictMaybe (PlutusPurpose AsIxItem era)

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

data AlonzoTxBodyRaw = AlonzoTxBodyRaw
  { AlonzoTxBodyRaw -> Set TxIn
atbrInputs :: !(Set TxIn)
  , AlonzoTxBodyRaw -> Set TxIn
atbrCollateral :: !(Set TxIn)
  , AlonzoTxBodyRaw -> StrictSeq (TxOut AlonzoEra)
atbrOutputs :: !(StrictSeq (TxOut AlonzoEra))
  , AlonzoTxBodyRaw -> StrictSeq (TxCert AlonzoEra)
atbrCerts :: !(StrictSeq (TxCert AlonzoEra))
  , AlonzoTxBodyRaw -> Withdrawals
atbrWithdrawals :: !Withdrawals
  , AlonzoTxBodyRaw -> Coin
atbrTxFee :: !Coin
  , AlonzoTxBodyRaw -> ValidityInterval
atbrValidityInterval :: !ValidityInterval
  , AlonzoTxBodyRaw -> StrictMaybe (Update AlonzoEra)
atbrUpdate :: !(StrictMaybe (Update AlonzoEra))
  , AlonzoTxBodyRaw -> Set (KeyHash 'Witness)
atbrReqSignerHashes :: Set (KeyHash 'Witness)
  , AlonzoTxBodyRaw -> MultiAsset
atbrMint :: !MultiAsset
  , AlonzoTxBodyRaw -> StrictMaybe ScriptIntegrityHash
atbrScriptIntegrityHash :: !(StrictMaybe ScriptIntegrityHash)
  , AlonzoTxBodyRaw -> StrictMaybe TxAuxDataHash
atbrAuxDataHash :: !(StrictMaybe TxAuxDataHash)
  , AlonzoTxBodyRaw -> StrictMaybe Network
atbrTxNetworkId :: !(StrictMaybe Network)
  }
  deriving ((forall x. AlonzoTxBodyRaw -> Rep AlonzoTxBodyRaw x)
-> (forall x. Rep AlonzoTxBodyRaw x -> AlonzoTxBodyRaw)
-> Generic AlonzoTxBodyRaw
forall x. Rep AlonzoTxBodyRaw x -> AlonzoTxBodyRaw
forall x. AlonzoTxBodyRaw -> Rep AlonzoTxBodyRaw x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AlonzoTxBodyRaw -> Rep AlonzoTxBodyRaw x
from :: forall x. AlonzoTxBodyRaw -> Rep AlonzoTxBodyRaw x
$cto :: forall x. Rep AlonzoTxBodyRaw x -> AlonzoTxBodyRaw
to :: forall x. Rep AlonzoTxBodyRaw x -> AlonzoTxBodyRaw
Generic)

deriving instance Eq AlonzoTxBodyRaw

instance NoThunks AlonzoTxBodyRaw

instance NFData AlonzoTxBodyRaw

deriving instance Show AlonzoTxBodyRaw

instance Memoized (TxBody AlonzoEra) where
  type RawType (TxBody AlonzoEra) = AlonzoTxBodyRaw

data AlonzoTxBodyUpgradeError
  = -- | The TxBody contains a protocol parameter update that attempts to update
    -- the min UTxO. Since this doesn't exist in Alonzo, we fail if an attempt is
    -- made to update it.
    ATBUEMinUTxOUpdated
  deriving (Int -> AlonzoTxBodyUpgradeError -> ShowS
[AlonzoTxBodyUpgradeError] -> ShowS
AlonzoTxBodyUpgradeError -> String
(Int -> AlonzoTxBodyUpgradeError -> ShowS)
-> (AlonzoTxBodyUpgradeError -> String)
-> ([AlonzoTxBodyUpgradeError] -> ShowS)
-> Show AlonzoTxBodyUpgradeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AlonzoTxBodyUpgradeError -> ShowS
showsPrec :: Int -> AlonzoTxBodyUpgradeError -> ShowS
$cshow :: AlonzoTxBodyUpgradeError -> String
show :: AlonzoTxBodyUpgradeError -> String
$cshowList :: [AlonzoTxBodyUpgradeError] -> ShowS
showList :: [AlonzoTxBodyUpgradeError] -> ShowS
Show)

instance EraTxBody AlonzoEra where
  newtype TxBody AlonzoEra = MkAlonzoTxBody (MemoBytes AlonzoTxBodyRaw)
    deriving (Typeable (TxBody AlonzoEra)
Typeable (TxBody AlonzoEra) =>
(TxBody AlonzoEra -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (TxBody AlonzoEra) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [TxBody AlonzoEra] -> Size)
-> ToCBOR (TxBody AlonzoEra)
TxBody AlonzoEra -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TxBody AlonzoEra] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (TxBody AlonzoEra) -> 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 AlonzoEra -> Encoding
toCBOR :: TxBody AlonzoEra -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (TxBody AlonzoEra) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (TxBody AlonzoEra) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TxBody AlonzoEra] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TxBody AlonzoEra] -> Size
ToCBOR, (forall x. TxBody AlonzoEra -> Rep (TxBody AlonzoEra) x)
-> (forall x. Rep (TxBody AlonzoEra) x -> TxBody AlonzoEra)
-> Generic (TxBody AlonzoEra)
forall x. Rep (TxBody AlonzoEra) x -> TxBody AlonzoEra
forall x. TxBody AlonzoEra -> Rep (TxBody AlonzoEra) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TxBody AlonzoEra -> Rep (TxBody AlonzoEra) x
from :: forall x. TxBody AlonzoEra -> Rep (TxBody AlonzoEra) x
$cto :: forall x. Rep (TxBody AlonzoEra) x -> TxBody AlonzoEra
to :: forall x. Rep (TxBody AlonzoEra) x -> TxBody AlonzoEra
Generic)
    deriving newtype (TxBody AlonzoEra -> Int
TxBody AlonzoEra -> ByteString
(TxBody AlonzoEra -> ByteString)
-> (TxBody AlonzoEra -> Int)
-> (forall i. Proxy i -> TxBody AlonzoEra -> SafeHash i)
-> SafeToHash (TxBody AlonzoEra)
forall i. Proxy i -> TxBody AlonzoEra -> SafeHash i
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall i. Proxy i -> t -> SafeHash i)
-> SafeToHash t
$coriginalBytes :: TxBody AlonzoEra -> ByteString
originalBytes :: TxBody AlonzoEra -> ByteString
$coriginalBytesSize :: TxBody AlonzoEra -> Int
originalBytesSize :: TxBody AlonzoEra -> Int
$cmakeHashWithExplicitProxys :: forall i. Proxy i -> TxBody AlonzoEra -> SafeHash i
makeHashWithExplicitProxys :: forall i. Proxy i -> TxBody AlonzoEra -> SafeHash i
SafeToHash)
  type TxBodyUpgradeError AlonzoEra = AlonzoTxBodyUpgradeError

  mkBasicTxBody :: TxBody AlonzoEra
mkBasicTxBody = forall era t.
(Era era, EncCBOR (RawType t), Memoized t) =>
RawType t -> t
mkMemoizedEra @AlonzoEra RawType (TxBody AlonzoEra)
AlonzoTxBodyRaw
emptyAlonzoTxBodyRaw

  inputsTxBodyL :: Lens' (TxBody AlonzoEra) (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 @AlonzoEra RawType (TxBody AlonzoEra) -> Set TxIn
AlonzoTxBodyRaw -> Set TxIn
atbrInputs ((RawType (TxBody AlonzoEra)
  -> Set TxIn -> RawType (TxBody AlonzoEra))
 -> Lens' (TxBody AlonzoEra) (Set TxIn))
-> (RawType (TxBody AlonzoEra)
    -> Set TxIn -> RawType (TxBody AlonzoEra))
-> Lens' (TxBody AlonzoEra) (Set TxIn)
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody AlonzoEra)
txBodyRaw Set TxIn
inputs_ -> RawType (TxBody AlonzoEra)
txBodyRaw {atbrInputs = inputs_}
  {-# INLINEABLE inputsTxBodyL #-}

  outputsTxBodyL :: Lens' (TxBody AlonzoEra) (StrictSeq (TxOut AlonzoEra))
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 @AlonzoEra RawType (TxBody AlonzoEra) -> StrictSeq (TxOut AlonzoEra)
AlonzoTxBodyRaw -> StrictSeq (TxOut AlonzoEra)
atbrOutputs ((RawType (TxBody AlonzoEra)
  -> StrictSeq (TxOut AlonzoEra) -> RawType (TxBody AlonzoEra))
 -> Lens' (TxBody AlonzoEra) (StrictSeq (TxOut AlonzoEra)))
-> (RawType (TxBody AlonzoEra)
    -> StrictSeq (TxOut AlonzoEra) -> RawType (TxBody AlonzoEra))
-> Lens' (TxBody AlonzoEra) (StrictSeq (TxOut AlonzoEra))
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody AlonzoEra)
txBodyRaw StrictSeq (TxOut AlonzoEra)
outputs_ -> RawType (TxBody AlonzoEra)
txBodyRaw {atbrOutputs = outputs_}
  {-# INLINEABLE outputsTxBodyL #-}

  feeTxBodyL :: Lens' (TxBody AlonzoEra) 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 @AlonzoEra RawType (TxBody AlonzoEra) -> Coin
AlonzoTxBodyRaw -> Coin
atbrTxFee ((RawType (TxBody AlonzoEra) -> Coin -> RawType (TxBody AlonzoEra))
 -> Lens' (TxBody AlonzoEra) Coin)
-> (RawType (TxBody AlonzoEra)
    -> Coin -> RawType (TxBody AlonzoEra))
-> Lens' (TxBody AlonzoEra) Coin
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody AlonzoEra)
txBodyRaw Coin
fee_ -> RawType (TxBody AlonzoEra)
txBodyRaw {atbrTxFee = fee_}
  {-# INLINEABLE feeTxBodyL #-}

  auxDataHashTxBodyL :: Lens' (TxBody AlonzoEra) (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 @AlonzoEra RawType (TxBody AlonzoEra) -> StrictMaybe TxAuxDataHash
AlonzoTxBodyRaw -> StrictMaybe TxAuxDataHash
atbrAuxDataHash ((RawType (TxBody AlonzoEra)
  -> StrictMaybe TxAuxDataHash -> RawType (TxBody AlonzoEra))
 -> Lens' (TxBody AlonzoEra) (StrictMaybe TxAuxDataHash))
-> (RawType (TxBody AlonzoEra)
    -> StrictMaybe TxAuxDataHash -> RawType (TxBody AlonzoEra))
-> Lens' (TxBody AlonzoEra) (StrictMaybe TxAuxDataHash)
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody AlonzoEra)
txBodyRaw StrictMaybe TxAuxDataHash
auxDataHash -> RawType (TxBody AlonzoEra)
txBodyRaw {atbrAuxDataHash = auxDataHash}
  {-# INLINEABLE auxDataHashTxBodyL #-}

  spendableInputsTxBodyF :: SimpleGetter (TxBody AlonzoEra) (Set TxIn)
spendableInputsTxBodyF = Getting r (TxBody AlonzoEra) (Set TxIn)
forall era. EraTxBody era => SimpleGetter (TxBody era) (Set TxIn)
SimpleGetter (TxBody AlonzoEra) (Set TxIn)
allInputsTxBodyF
  {-# INLINE spendableInputsTxBodyF #-}

  allInputsTxBodyF :: SimpleGetter (TxBody AlonzoEra) (Set TxIn)
allInputsTxBodyF =
    (TxBody AlonzoEra -> Set TxIn)
-> SimpleGetter (TxBody AlonzoEra) (Set TxIn)
forall s a. (s -> a) -> SimpleGetter s a
to ((TxBody AlonzoEra -> Set TxIn)
 -> SimpleGetter (TxBody AlonzoEra) (Set TxIn))
-> (TxBody AlonzoEra -> Set TxIn)
-> SimpleGetter (TxBody AlonzoEra) (Set TxIn)
forall a b. (a -> b) -> a -> b
$ \TxBody AlonzoEra
txBody -> (TxBody AlonzoEra
txBody TxBody AlonzoEra
-> Getting (Set TxIn) (TxBody AlonzoEra) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody AlonzoEra) (Set TxIn)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody AlonzoEra) (Set TxIn)
inputsTxBodyL) Set TxIn -> Set TxIn -> Set TxIn
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` (TxBody AlonzoEra
txBody TxBody AlonzoEra
-> Getting (Set TxIn) (TxBody AlonzoEra) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody AlonzoEra) (Set TxIn)
forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody AlonzoEra) (Set TxIn)
collateralInputsTxBodyL)
  {-# INLINEABLE allInputsTxBodyF #-}

  withdrawalsTxBodyL :: Lens' (TxBody AlonzoEra) 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 @AlonzoEra RawType (TxBody AlonzoEra) -> Withdrawals
AlonzoTxBodyRaw -> Withdrawals
atbrWithdrawals ((RawType (TxBody AlonzoEra)
  -> Withdrawals -> RawType (TxBody AlonzoEra))
 -> Lens' (TxBody AlonzoEra) Withdrawals)
-> (RawType (TxBody AlonzoEra)
    -> Withdrawals -> RawType (TxBody AlonzoEra))
-> Lens' (TxBody AlonzoEra) Withdrawals
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody AlonzoEra)
txBodyRaw Withdrawals
withdrawals_ -> RawType (TxBody AlonzoEra)
txBodyRaw {atbrWithdrawals = withdrawals_}
  {-# INLINEABLE withdrawalsTxBodyL #-}

  certsTxBodyL :: Lens' (TxBody AlonzoEra) (StrictSeq (TxCert AlonzoEra))
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 @AlonzoEra RawType (TxBody AlonzoEra) -> StrictSeq (TxCert AlonzoEra)
AlonzoTxBodyRaw -> StrictSeq (TxCert AlonzoEra)
atbrCerts ((RawType (TxBody AlonzoEra)
  -> StrictSeq (TxCert AlonzoEra) -> RawType (TxBody AlonzoEra))
 -> Lens' (TxBody AlonzoEra) (StrictSeq (TxCert AlonzoEra)))
-> (RawType (TxBody AlonzoEra)
    -> StrictSeq (TxCert AlonzoEra) -> RawType (TxBody AlonzoEra))
-> Lens' (TxBody AlonzoEra) (StrictSeq (TxCert AlonzoEra))
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody AlonzoEra)
txBodyRaw StrictSeq (TxCert AlonzoEra)
certs_ -> RawType (TxBody AlonzoEra)
txBodyRaw {atbrCerts = certs_}
  {-# INLINEABLE certsTxBodyL #-}

  getGenesisKeyHashCountTxBody :: TxBody AlonzoEra -> Int
getGenesisKeyHashCountTxBody = TxBody AlonzoEra -> Int
forall era. ShelleyEraTxBody era => TxBody era -> Int
getShelleyGenesisKeyHashCountTxBody

  upgradeTxBody :: EraTxBody (PreviousEra AlonzoEra) =>
TxBody (PreviousEra AlonzoEra)
-> Either (TxBodyUpgradeError AlonzoEra) (TxBody AlonzoEra)
upgradeTxBody
    MaryTxBody
      { Set TxIn
mtbInputs :: Set TxIn
mtbInputs :: (EraTxOut MaryEra, EraTxCert MaryEra) => TxBody MaryEra -> Set TxIn
mtbInputs
      , StrictSeq (TxOut MaryEra)
mtbOutputs :: StrictSeq (TxOut MaryEra)
mtbOutputs :: (EraTxOut MaryEra, EraTxCert MaryEra) =>
TxBody MaryEra -> StrictSeq (TxOut MaryEra)
mtbOutputs
      , StrictSeq (TxCert MaryEra)
mtbCerts :: StrictSeq (TxCert MaryEra)
mtbCerts :: (EraTxOut MaryEra, EraTxCert MaryEra) =>
TxBody MaryEra -> StrictSeq (TxCert MaryEra)
mtbCerts
      , Withdrawals
mtbWithdrawals :: Withdrawals
mtbWithdrawals :: (EraTxOut MaryEra, EraTxCert MaryEra) =>
TxBody MaryEra -> Withdrawals
mtbWithdrawals
      , Coin
mtbTxFee :: Coin
mtbTxFee :: (EraTxOut MaryEra, EraTxCert MaryEra) => TxBody MaryEra -> Coin
mtbTxFee
      , ValidityInterval
mtbValidityInterval :: ValidityInterval
mtbValidityInterval :: (EraTxOut MaryEra, EraTxCert MaryEra) =>
TxBody MaryEra -> ValidityInterval
mtbValidityInterval
      , StrictMaybe (Update MaryEra)
mtbUpdate :: StrictMaybe (Update MaryEra)
mtbUpdate :: (EraTxOut MaryEra, EraTxCert MaryEra) =>
TxBody MaryEra -> StrictMaybe (Update MaryEra)
mtbUpdate
      , StrictMaybe TxAuxDataHash
mtbAuxDataHash :: StrictMaybe TxAuxDataHash
mtbAuxDataHash :: (EraTxOut MaryEra, EraTxCert MaryEra) =>
TxBody MaryEra -> StrictMaybe TxAuxDataHash
mtbAuxDataHash
      , MultiAsset
mtbMint :: MultiAsset
mtbMint :: (EraTxOut MaryEra, EraTxCert MaryEra) =>
TxBody MaryEra -> MultiAsset
mtbMint
      } = do
      StrictSeq (TxCert AlonzoEra)
certs <-
        (TxCert (PreviousEra AlonzoEra)
 -> Either AlonzoTxBodyUpgradeError (TxCert AlonzoEra))
-> StrictSeq (TxCert (PreviousEra AlonzoEra))
-> Either AlonzoTxBodyUpgradeError (StrictSeq (TxCert AlonzoEra))
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
          ((Void -> AlonzoTxBodyUpgradeError)
-> Either Void (TxCert AlonzoEra)
-> Either AlonzoTxBodyUpgradeError (TxCert AlonzoEra)
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 Void -> AlonzoTxBodyUpgradeError
forall a. Void -> a
absurd (Either Void (TxCert AlonzoEra)
 -> Either AlonzoTxBodyUpgradeError (TxCert AlonzoEra))
-> (TxCert (PreviousEra AlonzoEra)
    -> Either Void (TxCert AlonzoEra))
-> TxCert (PreviousEra AlonzoEra)
-> Either AlonzoTxBodyUpgradeError (TxCert AlonzoEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxCert (PreviousEra AlonzoEra) -> Either Void (TxCert AlonzoEra)
TxCert (PreviousEra AlonzoEra)
-> Either (TxCertUpgradeError AlonzoEra) (TxCert AlonzoEra)
forall era.
(EraTxCert era, EraTxCert (PreviousEra era)) =>
TxCert (PreviousEra era)
-> Either (TxCertUpgradeError era) (TxCert era)
upgradeTxCert)
          StrictSeq (TxCert (PreviousEra AlonzoEra))
StrictSeq (TxCert MaryEra)
mtbCerts

      StrictMaybe (Update AlonzoEra)
updates <- (Update MaryEra
 -> Either AlonzoTxBodyUpgradeError (Update AlonzoEra))
-> StrictMaybe (Update MaryEra)
-> Either AlonzoTxBodyUpgradeError (StrictMaybe (Update AlonzoEra))
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) -> StrictMaybe a -> f (StrictMaybe b)
traverse Update MaryEra
-> Either AlonzoTxBodyUpgradeError (Update AlonzoEra)
upgradeUpdate StrictMaybe (Update MaryEra)
mtbUpdate
      TxBody AlonzoEra
-> Either AlonzoTxBodyUpgradeError (TxBody AlonzoEra)
forall a. a -> Either AlonzoTxBodyUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxBody AlonzoEra
 -> Either AlonzoTxBodyUpgradeError (TxBody AlonzoEra))
-> TxBody AlonzoEra
-> Either AlonzoTxBodyUpgradeError (TxBody AlonzoEra)
forall a b. (a -> b) -> a -> b
$
        AlonzoTxBody
          { atbInputs :: Set TxIn
atbInputs = Set TxIn
mtbInputs
          , atbOutputs :: StrictSeq (TxOut AlonzoEra)
atbOutputs = TxOut (PreviousEra AlonzoEra) -> TxOut AlonzoEra
TxOut (PreviousEra AlonzoEra) -> AlonzoTxOut AlonzoEra
forall era.
(EraTxOut era, EraTxOut (PreviousEra era)) =>
TxOut (PreviousEra era) -> TxOut era
upgradeTxOut (TxOut (PreviousEra AlonzoEra) -> AlonzoTxOut AlonzoEra)
-> StrictSeq (TxOut (PreviousEra AlonzoEra))
-> StrictSeq (AlonzoTxOut AlonzoEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (TxOut (PreviousEra AlonzoEra))
StrictSeq (TxOut MaryEra)
mtbOutputs
          , atbCerts :: StrictSeq (TxCert AlonzoEra)
atbCerts = StrictSeq (TxCert AlonzoEra)
certs
          , atbWithdrawals :: Withdrawals
atbWithdrawals = Withdrawals
mtbWithdrawals
          , atbTxFee :: Coin
atbTxFee = Coin
mtbTxFee
          , atbValidityInterval :: ValidityInterval
atbValidityInterval = ValidityInterval
mtbValidityInterval
          , atbUpdate :: StrictMaybe (Update AlonzoEra)
atbUpdate = StrictMaybe (Update AlonzoEra)
updates
          , atbAuxDataHash :: StrictMaybe TxAuxDataHash
atbAuxDataHash = StrictMaybe TxAuxDataHash
mtbAuxDataHash
          , atbMint :: MultiAsset
atbMint = MultiAsset
mtbMint
          , atbCollateral :: Set TxIn
atbCollateral = Set TxIn
forall a. Monoid a => a
mempty
          , atbReqSignerHashes :: Set (KeyHash 'Witness)
atbReqSignerHashes = Set (KeyHash 'Witness)
forall a. Monoid a => a
mempty
          , atbScriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
atbScriptIntegrityHash = StrictMaybe ScriptIntegrityHash
forall a. StrictMaybe a
SNothing
          , atbTxNetworkId :: StrictMaybe Network
atbTxNetworkId = StrictMaybe Network
forall a. StrictMaybe a
SNothing
          }
      where
        upgradeUpdate ::
          Update MaryEra ->
          Either AlonzoTxBodyUpgradeError (Update AlonzoEra)
        upgradeUpdate :: Update MaryEra
-> Either AlonzoTxBodyUpgradeError (Update AlonzoEra)
upgradeUpdate (Update ProposedPPUpdates MaryEra
pp EpochNo
epoch) =
          ProposedPPUpdates AlonzoEra -> EpochNo -> Update AlonzoEra
forall era. ProposedPPUpdates era -> EpochNo -> Update era
Update (ProposedPPUpdates AlonzoEra -> EpochNo -> Update AlonzoEra)
-> Either AlonzoTxBodyUpgradeError (ProposedPPUpdates AlonzoEra)
-> Either AlonzoTxBodyUpgradeError (EpochNo -> Update AlonzoEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProposedPPUpdates MaryEra
-> Either AlonzoTxBodyUpgradeError (ProposedPPUpdates AlonzoEra)
upgradeProposedPPUpdates ProposedPPUpdates MaryEra
pp Either AlonzoTxBodyUpgradeError (EpochNo -> Update AlonzoEra)
-> Either AlonzoTxBodyUpgradeError EpochNo
-> Either AlonzoTxBodyUpgradeError (Update AlonzoEra)
forall a b.
Either AlonzoTxBodyUpgradeError (a -> b)
-> Either AlonzoTxBodyUpgradeError a
-> Either AlonzoTxBodyUpgradeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EpochNo -> Either AlonzoTxBodyUpgradeError EpochNo
forall a. a -> Either AlonzoTxBodyUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EpochNo
epoch

        upgradeProposedPPUpdates ::
          ProposedPPUpdates MaryEra ->
          Either AlonzoTxBodyUpgradeError (ProposedPPUpdates AlonzoEra)
        upgradeProposedPPUpdates :: ProposedPPUpdates MaryEra
-> Either AlonzoTxBodyUpgradeError (ProposedPPUpdates AlonzoEra)
upgradeProposedPPUpdates (ProposedPPUpdates Map (KeyHash 'Genesis) (PParamsUpdate MaryEra)
m) =
          Map (KeyHash 'Genesis) (PParamsUpdate AlonzoEra)
-> ProposedPPUpdates AlonzoEra
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
ProposedPPUpdates
            (Map (KeyHash 'Genesis) (PParamsUpdate AlonzoEra)
 -> ProposedPPUpdates AlonzoEra)
-> Either
     AlonzoTxBodyUpgradeError
     (Map (KeyHash 'Genesis) (PParamsUpdate AlonzoEra))
-> Either AlonzoTxBodyUpgradeError (ProposedPPUpdates AlonzoEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PParamsUpdate MaryEra
 -> Either AlonzoTxBodyUpgradeError (PParamsUpdate AlonzoEra))
-> Map (KeyHash 'Genesis) (PParamsUpdate MaryEra)
-> Either
     AlonzoTxBodyUpgradeError
     (Map (KeyHash 'Genesis) (PParamsUpdate AlonzoEra))
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)
-> Map (KeyHash 'Genesis) a -> f (Map (KeyHash 'Genesis) b)
traverse
              ( \PParamsUpdate MaryEra
ppu -> do
                  Bool
-> Either AlonzoTxBodyUpgradeError ()
-> Either AlonzoTxBodyUpgradeError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StrictMaybe Coin -> Bool
forall a. StrictMaybe a -> Bool
isSJust (StrictMaybe Coin -> Bool) -> StrictMaybe Coin -> Bool
forall a b. (a -> b) -> a -> b
$ PParamsUpdate MaryEra
ppu PParamsUpdate MaryEra
-> Getting
     (StrictMaybe Coin) (PParamsUpdate MaryEra) (StrictMaybe Coin)
-> StrictMaybe Coin
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe Coin) (PParamsUpdate MaryEra) (StrictMaybe Coin)
forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate MaryEra) (StrictMaybe Coin)
ppuMinUTxOValueL) (Either AlonzoTxBodyUpgradeError ()
 -> Either AlonzoTxBodyUpgradeError ())
-> Either AlonzoTxBodyUpgradeError ()
-> Either AlonzoTxBodyUpgradeError ()
forall a b. (a -> b) -> a -> b
$
                    AlonzoTxBodyUpgradeError -> Either AlonzoTxBodyUpgradeError ()
forall a b. a -> Either a b
Left AlonzoTxBodyUpgradeError
ATBUEMinUTxOUpdated
                  PParamsUpdate AlonzoEra
-> Either AlonzoTxBodyUpgradeError (PParamsUpdate AlonzoEra)
forall a. a -> Either AlonzoTxBodyUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParamsUpdate AlonzoEra
 -> Either AlonzoTxBodyUpgradeError (PParamsUpdate AlonzoEra))
-> PParamsUpdate AlonzoEra
-> Either AlonzoTxBodyUpgradeError (PParamsUpdate AlonzoEra)
forall a b. (a -> b) -> a -> b
$ UpgradePParams StrictMaybe AlonzoEra
-> PParamsUpdate (PreviousEra AlonzoEra) -> PParamsUpdate AlonzoEra
forall era.
(EraPParams era, EraPParams (PreviousEra era)) =>
UpgradePParams StrictMaybe era
-> PParamsUpdate (PreviousEra era) -> PParamsUpdate era
upgradePParamsUpdate UpgradePParams StrictMaybe AlonzoEra
UpgradeAlonzoPParams StrictMaybe
forall a. Default a => a
def PParamsUpdate (PreviousEra AlonzoEra)
PParamsUpdate MaryEra
ppu
              )
              Map (KeyHash 'Genesis) (PParamsUpdate MaryEra)
m

instance ShelleyEraTxBody AlonzoEra where
  ttlTxBodyL :: ExactEra ShelleyEra AlonzoEra => Lens' (TxBody AlonzoEra) SlotNo
ttlTxBodyL = (SlotNo -> f SlotNo) -> TxBody AlonzoEra -> f (TxBody AlonzoEra)
forall a b. HasCallStack => Lens' a b
Lens' (TxBody AlonzoEra) SlotNo
notSupportedInThisEraL

  updateTxBodyL :: Lens' (TxBody AlonzoEra) (StrictMaybe (Update AlonzoEra))
updateTxBodyL =
    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 @AlonzoEra RawType (TxBody AlonzoEra) -> StrictMaybe (Update AlonzoEra)
AlonzoTxBodyRaw -> StrictMaybe (Update AlonzoEra)
atbrUpdate ((RawType (TxBody AlonzoEra)
  -> StrictMaybe (Update AlonzoEra) -> RawType (TxBody AlonzoEra))
 -> Lens' (TxBody AlonzoEra) (StrictMaybe (Update AlonzoEra)))
-> (RawType (TxBody AlonzoEra)
    -> StrictMaybe (Update AlonzoEra) -> RawType (TxBody AlonzoEra))
-> Lens' (TxBody AlonzoEra) (StrictMaybe (Update AlonzoEra))
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody AlonzoEra)
txBodyRaw StrictMaybe (Update AlonzoEra)
update_ -> RawType (TxBody AlonzoEra)
txBodyRaw {atbrUpdate = update_}
  {-# INLINEABLE updateTxBodyL #-}

instance AllegraEraTxBody AlonzoEra where
  vldtTxBodyL :: Lens' (TxBody AlonzoEra) 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 @AlonzoEra RawType (TxBody AlonzoEra) -> ValidityInterval
AlonzoTxBodyRaw -> ValidityInterval
atbrValidityInterval ((RawType (TxBody AlonzoEra)
  -> ValidityInterval -> RawType (TxBody AlonzoEra))
 -> Lens' (TxBody AlonzoEra) ValidityInterval)
-> (RawType (TxBody AlonzoEra)
    -> ValidityInterval -> RawType (TxBody AlonzoEra))
-> Lens' (TxBody AlonzoEra) ValidityInterval
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody AlonzoEra)
txBodyRaw ValidityInterval
vldt_ -> RawType (TxBody AlonzoEra)
txBodyRaw {atbrValidityInterval = vldt_}
  {-# INLINEABLE vldtTxBodyL #-}

instance MaryEraTxBody AlonzoEra where
  mintTxBodyL :: Lens' (TxBody AlonzoEra) 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 @AlonzoEra RawType (TxBody AlonzoEra) -> MultiAsset
AlonzoTxBodyRaw -> MultiAsset
atbrMint ((RawType (TxBody AlonzoEra)
  -> MultiAsset -> RawType (TxBody AlonzoEra))
 -> Lens' (TxBody AlonzoEra) MultiAsset)
-> (RawType (TxBody AlonzoEra)
    -> MultiAsset -> RawType (TxBody AlonzoEra))
-> Lens' (TxBody AlonzoEra) MultiAsset
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody AlonzoEra)
txBodyRaw MultiAsset
mint_ -> RawType (TxBody AlonzoEra)
txBodyRaw {atbrMint = mint_}
  {-# INLINEABLE mintTxBodyL #-}

  mintedTxBodyF :: SimpleGetter (TxBody AlonzoEra) (Set PolicyID)
mintedTxBodyF = (TxBody AlonzoEra -> Set PolicyID)
-> SimpleGetter (TxBody AlonzoEra) (Set PolicyID)
forall s a. (s -> a) -> SimpleGetter s a
to (MultiAsset -> Set PolicyID
policies (MultiAsset -> Set PolicyID)
-> (TxBody AlonzoEra -> MultiAsset)
-> TxBody AlonzoEra
-> Set PolicyID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoTxBodyRaw -> MultiAsset
atbrMint (AlonzoTxBodyRaw -> MultiAsset)
-> (TxBody AlonzoEra -> AlonzoTxBodyRaw)
-> TxBody AlonzoEra
-> MultiAsset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody AlonzoEra -> RawType (TxBody AlonzoEra)
TxBody AlonzoEra -> AlonzoTxBodyRaw
forall t. Memoized t => t -> RawType t
getMemoRawType)
  {-# INLINEABLE mintedTxBodyF #-}

instance AlonzoEraTxBody AlonzoEra where
  collateralInputsTxBodyL :: Lens' (TxBody AlonzoEra) (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 @AlonzoEra RawType (TxBody AlonzoEra) -> Set TxIn
AlonzoTxBodyRaw -> Set TxIn
atbrCollateral ((RawType (TxBody AlonzoEra)
  -> Set TxIn -> RawType (TxBody AlonzoEra))
 -> Lens' (TxBody AlonzoEra) (Set TxIn))
-> (RawType (TxBody AlonzoEra)
    -> Set TxIn -> RawType (TxBody AlonzoEra))
-> Lens' (TxBody AlonzoEra) (Set TxIn)
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody AlonzoEra)
txBodyRaw Set TxIn
collateral_ -> RawType (TxBody AlonzoEra)
txBodyRaw {atbrCollateral = collateral_}
  {-# INLINEABLE collateralInputsTxBodyL #-}

  reqSignerHashesTxBodyL :: Lens' (TxBody AlonzoEra) (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 @AlonzoEra RawType (TxBody AlonzoEra) -> Set (KeyHash 'Witness)
AlonzoTxBodyRaw -> Set (KeyHash 'Witness)
atbrReqSignerHashes ((RawType (TxBody AlonzoEra)
  -> Set (KeyHash 'Witness) -> RawType (TxBody AlonzoEra))
 -> Lens' (TxBody AlonzoEra) (Set (KeyHash 'Witness)))
-> (RawType (TxBody AlonzoEra)
    -> Set (KeyHash 'Witness) -> RawType (TxBody AlonzoEra))
-> Lens' (TxBody AlonzoEra) (Set (KeyHash 'Witness))
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody AlonzoEra)
txBodyRaw Set (KeyHash 'Witness)
reqSignerHashes_ -> RawType (TxBody AlonzoEra)
txBodyRaw {atbrReqSignerHashes = reqSignerHashes_}
  {-# INLINEABLE reqSignerHashesTxBodyL #-}

  scriptIntegrityHashTxBodyL :: Lens' (TxBody AlonzoEra) (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 @AlonzoEra RawType (TxBody AlonzoEra) -> StrictMaybe ScriptIntegrityHash
AlonzoTxBodyRaw -> StrictMaybe ScriptIntegrityHash
atbrScriptIntegrityHash ((RawType (TxBody AlonzoEra)
  -> StrictMaybe ScriptIntegrityHash -> RawType (TxBody AlonzoEra))
 -> Lens' (TxBody AlonzoEra) (StrictMaybe ScriptIntegrityHash))
-> (RawType (TxBody AlonzoEra)
    -> StrictMaybe ScriptIntegrityHash -> RawType (TxBody AlonzoEra))
-> Lens' (TxBody AlonzoEra) (StrictMaybe ScriptIntegrityHash)
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody AlonzoEra)
txBodyRaw StrictMaybe ScriptIntegrityHash
scriptIntegrityHash_ -> RawType (TxBody AlonzoEra)
txBodyRaw {atbrScriptIntegrityHash = scriptIntegrityHash_}
  {-# INLINEABLE scriptIntegrityHashTxBodyL #-}

  networkIdTxBodyL :: Lens' (TxBody AlonzoEra) (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 @AlonzoEra RawType (TxBody AlonzoEra) -> StrictMaybe Network
AlonzoTxBodyRaw -> StrictMaybe Network
atbrTxNetworkId ((RawType (TxBody AlonzoEra)
  -> StrictMaybe Network -> RawType (TxBody AlonzoEra))
 -> Lens' (TxBody AlonzoEra) (StrictMaybe Network))
-> (RawType (TxBody AlonzoEra)
    -> StrictMaybe Network -> RawType (TxBody AlonzoEra))
-> Lens' (TxBody AlonzoEra) (StrictMaybe Network)
forall a b. (a -> b) -> a -> b
$
      \RawType (TxBody AlonzoEra)
txBodyRaw StrictMaybe Network
networkId -> RawType (TxBody AlonzoEra)
txBodyRaw {atbrTxNetworkId = networkId}
  {-# INLINEABLE networkIdTxBodyL #-}

  redeemerPointer :: TxBody AlonzoEra
-> PlutusPurpose AsItem AlonzoEra
-> StrictMaybe (PlutusPurpose AsIx AlonzoEra)
redeemerPointer = TxBody AlonzoEra
-> AlonzoPlutusPurpose AsItem AlonzoEra
-> StrictMaybe (AlonzoPlutusPurpose AsIx AlonzoEra)
TxBody AlonzoEra
-> PlutusPurpose AsItem AlonzoEra
-> StrictMaybe (PlutusPurpose AsIx AlonzoEra)
forall era.
MaryEraTxBody era =>
TxBody era
-> AlonzoPlutusPurpose AsItem era
-> StrictMaybe (AlonzoPlutusPurpose AsIx era)
alonzoRedeemerPointer

  redeemerPointerInverse :: TxBody AlonzoEra
-> PlutusPurpose AsIx AlonzoEra
-> StrictMaybe (PlutusPurpose AsIxItem AlonzoEra)
redeemerPointerInverse = TxBody AlonzoEra
-> AlonzoPlutusPurpose AsIx AlonzoEra
-> StrictMaybe (AlonzoPlutusPurpose AsIxItem AlonzoEra)
TxBody AlonzoEra
-> PlutusPurpose AsIx AlonzoEra
-> StrictMaybe (PlutusPurpose AsIxItem AlonzoEra)
forall era.
MaryEraTxBody era =>
TxBody era
-> AlonzoPlutusPurpose AsIx era
-> StrictMaybe (AlonzoPlutusPurpose AsIxItem era)
alonzoRedeemerPointerInverse

deriving newtype instance Eq (TxBody AlonzoEra)

deriving instance NoThunks (TxBody AlonzoEra)

deriving instance NFData (TxBody AlonzoEra)

deriving instance Show (TxBody AlonzoEra)

deriving newtype instance DecCBOR (TxBody AlonzoEra)

pattern AlonzoTxBody ::
  Set TxIn ->
  Set TxIn ->
  StrictSeq (TxOut AlonzoEra) ->
  StrictSeq (TxCert AlonzoEra) ->
  Withdrawals ->
  Coin ->
  ValidityInterval ->
  StrictMaybe (Update AlonzoEra) ->
  Set (KeyHash 'Witness) ->
  MultiAsset ->
  StrictMaybe ScriptIntegrityHash ->
  StrictMaybe TxAuxDataHash ->
  StrictMaybe Network ->
  TxBody AlonzoEra
pattern $mAlonzoTxBody :: forall {r}.
TxBody AlonzoEra
-> (Set TxIn
    -> Set TxIn
    -> StrictSeq (TxOut AlonzoEra)
    -> StrictSeq (TxCert AlonzoEra)
    -> Withdrawals
    -> Coin
    -> ValidityInterval
    -> StrictMaybe (Update AlonzoEra)
    -> Set (KeyHash 'Witness)
    -> MultiAsset
    -> StrictMaybe ScriptIntegrityHash
    -> StrictMaybe TxAuxDataHash
    -> StrictMaybe Network
    -> r)
-> ((# #) -> r)
-> r
$bAlonzoTxBody :: Set TxIn
-> Set TxIn
-> StrictSeq (TxOut AlonzoEra)
-> StrictSeq (TxCert AlonzoEra)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update AlonzoEra)
-> Set (KeyHash 'Witness)
-> MultiAsset
-> StrictMaybe ScriptIntegrityHash
-> StrictMaybe TxAuxDataHash
-> StrictMaybe Network
-> TxBody AlonzoEra
AlonzoTxBody
  { TxBody AlonzoEra -> Set TxIn
atbInputs
  , TxBody AlonzoEra -> Set TxIn
atbCollateral
  , TxBody AlonzoEra -> StrictSeq (TxOut AlonzoEra)
atbOutputs
  , TxBody AlonzoEra -> StrictSeq (TxCert AlonzoEra)
atbCerts
  , TxBody AlonzoEra -> Withdrawals
atbWithdrawals
  , TxBody AlonzoEra -> Coin
atbTxFee
  , TxBody AlonzoEra -> ValidityInterval
atbValidityInterval
  , TxBody AlonzoEra -> StrictMaybe (Update AlonzoEra)
atbUpdate
  , TxBody AlonzoEra -> Set (KeyHash 'Witness)
atbReqSignerHashes
  , TxBody AlonzoEra -> MultiAsset
atbMint
  , TxBody AlonzoEra -> StrictMaybe ScriptIntegrityHash
atbScriptIntegrityHash
  , TxBody AlonzoEra -> StrictMaybe TxAuxDataHash
atbAuxDataHash
  , TxBody AlonzoEra -> StrictMaybe Network
atbTxNetworkId
  } <-
  ( getMemoRawType ->
      AlonzoTxBodyRaw
        { atbrInputs = atbInputs
        , atbrCollateral = atbCollateral
        , atbrOutputs = atbOutputs
        , atbrCerts = atbCerts
        , atbrWithdrawals = atbWithdrawals
        , atbrTxFee = atbTxFee
        , atbrValidityInterval = atbValidityInterval
        , atbrUpdate = atbUpdate
        , atbrReqSignerHashes = atbReqSignerHashes
        , atbrMint = atbMint
        , atbrScriptIntegrityHash = atbScriptIntegrityHash
        , atbrAuxDataHash = atbAuxDataHash
        , atbrTxNetworkId = atbTxNetworkId
        }
    )
  where
    AlonzoTxBody
      Set TxIn
inputs
      Set TxIn
collateral
      StrictSeq (TxOut AlonzoEra)
outputs
      StrictSeq (TxCert AlonzoEra)
certs
      Withdrawals
withdrawals
      Coin
txFee
      ValidityInterval
validityInterval
      StrictMaybe (Update AlonzoEra)
update
      Set (KeyHash 'Witness)
reqSignerHashes
      MultiAsset
mint
      StrictMaybe ScriptIntegrityHash
scriptIntegrityHash
      StrictMaybe TxAuxDataHash
auxDataHash
      StrictMaybe Network
txNetworkId =
        forall era t.
(Era era, EncCBOR (RawType t), Memoized t) =>
RawType t -> t
mkMemoizedEra @AlonzoEra (RawType (TxBody AlonzoEra) -> TxBody AlonzoEra)
-> RawType (TxBody AlonzoEra) -> TxBody AlonzoEra
forall a b. (a -> b) -> a -> b
$
          AlonzoTxBodyRaw
            { atbrInputs :: Set TxIn
atbrInputs = Set TxIn
inputs
            , atbrCollateral :: Set TxIn
atbrCollateral = Set TxIn
collateral
            , atbrOutputs :: StrictSeq (TxOut AlonzoEra)
atbrOutputs = StrictSeq (TxOut AlonzoEra)
outputs
            , atbrCerts :: StrictSeq (TxCert AlonzoEra)
atbrCerts = StrictSeq (TxCert AlonzoEra)
certs
            , atbrWithdrawals :: Withdrawals
atbrWithdrawals = Withdrawals
withdrawals
            , atbrTxFee :: Coin
atbrTxFee = Coin
txFee
            , atbrValidityInterval :: ValidityInterval
atbrValidityInterval = ValidityInterval
validityInterval
            , atbrUpdate :: StrictMaybe (Update AlonzoEra)
atbrUpdate = StrictMaybe (Update AlonzoEra)
update
            , atbrReqSignerHashes :: Set (KeyHash 'Witness)
atbrReqSignerHashes = Set (KeyHash 'Witness)
reqSignerHashes
            , atbrMint :: MultiAsset
atbrMint = MultiAsset
mint
            , atbrScriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
atbrScriptIntegrityHash = StrictMaybe ScriptIntegrityHash
scriptIntegrityHash
            , atbrAuxDataHash :: StrictMaybe TxAuxDataHash
atbrAuxDataHash = StrictMaybe TxAuxDataHash
auxDataHash
            , atbrTxNetworkId :: StrictMaybe Network
atbrTxNetworkId = StrictMaybe Network
txNetworkId
            }

{-# COMPLETE AlonzoTxBody #-}

type instance MemoHashIndex AlonzoTxBodyRaw = EraIndependentTxBody

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

-- ==============================================================================
-- We define these accessor functions manually, because if we define them using
-- the record syntax in the TxBody pattern, they inherit the (AlonzoBody era)
-- constraint as a precondition. This is unnecessary, as one can see below
-- they need not be constrained at all. This should be fixed in the GHC compiler.

inputs' :: TxBody AlonzoEra -> Set TxIn
collateral' :: TxBody AlonzoEra -> Set TxIn
outputs' :: TxBody AlonzoEra -> StrictSeq (TxOut AlonzoEra)
certs' :: TxBody AlonzoEra -> StrictSeq (TxCert AlonzoEra)
txfee' :: TxBody AlonzoEra -> Coin
withdrawals' :: TxBody AlonzoEra -> Withdrawals
vldt' :: TxBody AlonzoEra -> ValidityInterval
update' :: TxBody AlonzoEra -> StrictMaybe (Update AlonzoEra)
reqSignerHashes' :: TxBody AlonzoEra -> Set (KeyHash 'Witness)
adHash' :: TxBody AlonzoEra -> StrictMaybe TxAuxDataHash
mint' :: TxBody AlonzoEra -> MultiAsset
scriptIntegrityHash' :: TxBody AlonzoEra -> StrictMaybe ScriptIntegrityHash
txnetworkid' :: TxBody AlonzoEra -> StrictMaybe Network
inputs' :: TxBody AlonzoEra -> Set TxIn
inputs' = AlonzoTxBodyRaw -> Set TxIn
atbrInputs (AlonzoTxBodyRaw -> Set TxIn)
-> (TxBody AlonzoEra -> AlonzoTxBodyRaw)
-> TxBody AlonzoEra
-> Set TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody AlonzoEra -> RawType (TxBody AlonzoEra)
TxBody AlonzoEra -> AlonzoTxBodyRaw
forall t. Memoized t => t -> RawType t
getMemoRawType
{-# DEPRECATED inputs' "In favor of inputsTxBodyL" #-}

collateral' :: TxBody AlonzoEra -> Set TxIn
collateral' = AlonzoTxBodyRaw -> Set TxIn
atbrCollateral (AlonzoTxBodyRaw -> Set TxIn)
-> (TxBody AlonzoEra -> AlonzoTxBodyRaw)
-> TxBody AlonzoEra
-> Set TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody AlonzoEra -> RawType (TxBody AlonzoEra)
TxBody AlonzoEra -> AlonzoTxBodyRaw
forall t. Memoized t => t -> RawType t
getMemoRawType
{-# DEPRECATED collateral' "In favor of collateralInputsTxBodyL" #-}

outputs' :: TxBody AlonzoEra -> StrictSeq (TxOut AlonzoEra)
outputs' = AlonzoTxBodyRaw -> StrictSeq (TxOut AlonzoEra)
AlonzoTxBodyRaw -> StrictSeq (AlonzoTxOut AlonzoEra)
atbrOutputs (AlonzoTxBodyRaw -> StrictSeq (AlonzoTxOut AlonzoEra))
-> (TxBody AlonzoEra -> AlonzoTxBodyRaw)
-> TxBody AlonzoEra
-> StrictSeq (AlonzoTxOut AlonzoEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody AlonzoEra -> RawType (TxBody AlonzoEra)
TxBody AlonzoEra -> AlonzoTxBodyRaw
forall t. Memoized t => t -> RawType t
getMemoRawType
{-# DEPRECATED outputs' "In favor of outputsTxBodyL" #-}

certs' :: TxBody AlonzoEra -> StrictSeq (TxCert AlonzoEra)
certs' = AlonzoTxBodyRaw -> StrictSeq (TxCert AlonzoEra)
AlonzoTxBodyRaw -> StrictSeq (ShelleyTxCert AlonzoEra)
atbrCerts (AlonzoTxBodyRaw -> StrictSeq (ShelleyTxCert AlonzoEra))
-> (TxBody AlonzoEra -> AlonzoTxBodyRaw)
-> TxBody AlonzoEra
-> StrictSeq (ShelleyTxCert AlonzoEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody AlonzoEra -> RawType (TxBody AlonzoEra)
TxBody AlonzoEra -> AlonzoTxBodyRaw
forall t. Memoized t => t -> RawType t
getMemoRawType
{-# DEPRECATED certs' "In favor of certsTxBodyL" #-}

withdrawals' :: TxBody AlonzoEra -> Withdrawals
withdrawals' = AlonzoTxBodyRaw -> Withdrawals
atbrWithdrawals (AlonzoTxBodyRaw -> Withdrawals)
-> (TxBody AlonzoEra -> AlonzoTxBodyRaw)
-> TxBody AlonzoEra
-> Withdrawals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody AlonzoEra -> RawType (TxBody AlonzoEra)
TxBody AlonzoEra -> AlonzoTxBodyRaw
forall t. Memoized t => t -> RawType t
getMemoRawType
{-# DEPRECATED withdrawals' "In favor of withdrawalsTxBodyL" #-}

txfee' :: TxBody AlonzoEra -> Coin
txfee' = AlonzoTxBodyRaw -> Coin
atbrTxFee (AlonzoTxBodyRaw -> Coin)
-> (TxBody AlonzoEra -> AlonzoTxBodyRaw)
-> TxBody AlonzoEra
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody AlonzoEra -> RawType (TxBody AlonzoEra)
TxBody AlonzoEra -> AlonzoTxBodyRaw
forall t. Memoized t => t -> RawType t
getMemoRawType
{-# DEPRECATED txfee' "In favor of feeTxBodyL" #-}

vldt' :: TxBody AlonzoEra -> ValidityInterval
vldt' = AlonzoTxBodyRaw -> ValidityInterval
atbrValidityInterval (AlonzoTxBodyRaw -> ValidityInterval)
-> (TxBody AlonzoEra -> AlonzoTxBodyRaw)
-> TxBody AlonzoEra
-> ValidityInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody AlonzoEra -> RawType (TxBody AlonzoEra)
TxBody AlonzoEra -> AlonzoTxBodyRaw
forall t. Memoized t => t -> RawType t
getMemoRawType
{-# DEPRECATED vldt' "In favor of vldtTxBodyL" #-}

update' :: TxBody AlonzoEra -> StrictMaybe (Update AlonzoEra)
update' = AlonzoTxBodyRaw -> StrictMaybe (Update AlonzoEra)
atbrUpdate (AlonzoTxBodyRaw -> StrictMaybe (Update AlonzoEra))
-> (TxBody AlonzoEra -> AlonzoTxBodyRaw)
-> TxBody AlonzoEra
-> StrictMaybe (Update AlonzoEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody AlonzoEra -> RawType (TxBody AlonzoEra)
TxBody AlonzoEra -> AlonzoTxBodyRaw
forall t. Memoized t => t -> RawType t
getMemoRawType
{-# DEPRECATED update' "In favor of updateTxBodyL" #-}

reqSignerHashes' :: TxBody AlonzoEra -> Set (KeyHash 'Witness)
reqSignerHashes' = AlonzoTxBodyRaw -> Set (KeyHash 'Witness)
atbrReqSignerHashes (AlonzoTxBodyRaw -> Set (KeyHash 'Witness))
-> (TxBody AlonzoEra -> AlonzoTxBodyRaw)
-> TxBody AlonzoEra
-> Set (KeyHash 'Witness)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody AlonzoEra -> RawType (TxBody AlonzoEra)
TxBody AlonzoEra -> AlonzoTxBodyRaw
forall t. Memoized t => t -> RawType t
getMemoRawType
{-# DEPRECATED reqSignerHashes' "In favor of reqSignerHashesTxBodyL" #-}

adHash' :: TxBody AlonzoEra -> StrictMaybe TxAuxDataHash
adHash' = AlonzoTxBodyRaw -> StrictMaybe TxAuxDataHash
atbrAuxDataHash (AlonzoTxBodyRaw -> StrictMaybe TxAuxDataHash)
-> (TxBody AlonzoEra -> AlonzoTxBodyRaw)
-> TxBody AlonzoEra
-> StrictMaybe TxAuxDataHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody AlonzoEra -> RawType (TxBody AlonzoEra)
TxBody AlonzoEra -> AlonzoTxBodyRaw
forall t. Memoized t => t -> RawType t
getMemoRawType
{-# DEPRECATED adHash' "In favor of auxDataHashTxBodyL" #-}

mint' :: TxBody AlonzoEra -> MultiAsset
mint' = AlonzoTxBodyRaw -> MultiAsset
atbrMint (AlonzoTxBodyRaw -> MultiAsset)
-> (TxBody AlonzoEra -> AlonzoTxBodyRaw)
-> TxBody AlonzoEra
-> MultiAsset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody AlonzoEra -> RawType (TxBody AlonzoEra)
TxBody AlonzoEra -> AlonzoTxBodyRaw
forall t. Memoized t => t -> RawType t
getMemoRawType
{-# DEPRECATED mint' "In favor of mintTxBodyL" #-}

scriptIntegrityHash' :: TxBody AlonzoEra -> StrictMaybe ScriptIntegrityHash
scriptIntegrityHash' = AlonzoTxBodyRaw -> StrictMaybe ScriptIntegrityHash
atbrScriptIntegrityHash (AlonzoTxBodyRaw -> StrictMaybe ScriptIntegrityHash)
-> (TxBody AlonzoEra -> AlonzoTxBodyRaw)
-> TxBody AlonzoEra
-> StrictMaybe ScriptIntegrityHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody AlonzoEra -> RawType (TxBody AlonzoEra)
TxBody AlonzoEra -> AlonzoTxBodyRaw
forall t. Memoized t => t -> RawType t
getMemoRawType
{-# DEPRECATED scriptIntegrityHash' "In favor of scriptIntegrityHashTxBodyL" #-}

txnetworkid' :: TxBody AlonzoEra -> StrictMaybe Network
txnetworkid' = AlonzoTxBodyRaw -> StrictMaybe Network
atbrTxNetworkId (AlonzoTxBodyRaw -> StrictMaybe Network)
-> (TxBody AlonzoEra -> AlonzoTxBodyRaw)
-> TxBody AlonzoEra
-> StrictMaybe Network
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody AlonzoEra -> RawType (TxBody AlonzoEra)
TxBody AlonzoEra -> AlonzoTxBodyRaw
forall t. Memoized t => t -> RawType t
getMemoRawType
{-# DEPRECATED txnetworkid' "In favor of networkIdTxBodyL" #-}

instance EqRaw (TxBody AlonzoEra)

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

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

instance EncCBOR AlonzoTxBodyRaw where
  encCBOR :: AlonzoTxBodyRaw -> Encoding
encCBOR
    AlonzoTxBodyRaw
      { Set TxIn
atbrInputs :: AlonzoTxBodyRaw -> Set TxIn
atbrInputs :: Set TxIn
atbrInputs
      , Set TxIn
atbrCollateral :: AlonzoTxBodyRaw -> Set TxIn
atbrCollateral :: Set TxIn
atbrCollateral
      , StrictSeq (TxOut AlonzoEra)
atbrOutputs :: AlonzoTxBodyRaw -> StrictSeq (TxOut AlonzoEra)
atbrOutputs :: StrictSeq (TxOut AlonzoEra)
atbrOutputs
      , StrictSeq (TxCert AlonzoEra)
atbrCerts :: AlonzoTxBodyRaw -> StrictSeq (TxCert AlonzoEra)
atbrCerts :: StrictSeq (TxCert AlonzoEra)
atbrCerts
      , Withdrawals
atbrWithdrawals :: AlonzoTxBodyRaw -> Withdrawals
atbrWithdrawals :: Withdrawals
atbrWithdrawals
      , Coin
atbrTxFee :: AlonzoTxBodyRaw -> Coin
atbrTxFee :: Coin
atbrTxFee
      , atbrValidityInterval :: AlonzoTxBodyRaw -> ValidityInterval
atbrValidityInterval = ValidityInterval StrictMaybe SlotNo
bot StrictMaybe SlotNo
top
      , StrictMaybe (Update AlonzoEra)
atbrUpdate :: AlonzoTxBodyRaw -> StrictMaybe (Update AlonzoEra)
atbrUpdate :: StrictMaybe (Update AlonzoEra)
atbrUpdate
      , Set (KeyHash 'Witness)
atbrReqSignerHashes :: AlonzoTxBodyRaw -> Set (KeyHash 'Witness)
atbrReqSignerHashes :: Set (KeyHash 'Witness)
atbrReqSignerHashes
      , MultiAsset
atbrMint :: AlonzoTxBodyRaw -> MultiAsset
atbrMint :: MultiAsset
atbrMint
      , StrictMaybe ScriptIntegrityHash
atbrScriptIntegrityHash :: AlonzoTxBodyRaw -> StrictMaybe ScriptIntegrityHash
atbrScriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
atbrScriptIntegrityHash
      , StrictMaybe TxAuxDataHash
atbrAuxDataHash :: AlonzoTxBodyRaw -> StrictMaybe TxAuxDataHash
atbrAuxDataHash :: StrictMaybe TxAuxDataHash
atbrAuxDataHash
      , StrictMaybe Network
atbrTxNetworkId :: AlonzoTxBodyRaw -> StrictMaybe Network
atbrTxNetworkId :: StrictMaybe Network
atbrTxNetworkId
      } =
      Encode ('Closed 'Sparse) AlonzoTxBodyRaw -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Sparse) AlonzoTxBodyRaw -> Encoding)
-> Encode ('Closed 'Sparse) AlonzoTxBodyRaw -> Encoding
forall a b. (a -> b) -> a -> b
$
        (Set TxIn
 -> Set TxIn
 -> StrictSeq (AlonzoTxOut AlonzoEra)
 -> Coin
 -> StrictMaybe SlotNo
 -> StrictSeq (ShelleyTxCert AlonzoEra)
 -> Withdrawals
 -> StrictMaybe (Update AlonzoEra)
 -> StrictMaybe SlotNo
 -> Set (KeyHash 'Witness)
 -> MultiAsset
 -> StrictMaybe ScriptIntegrityHash
 -> StrictMaybe TxAuxDataHash
 -> StrictMaybe Network
 -> AlonzoTxBodyRaw)
-> Encode
     ('Closed 'Sparse)
     (Set TxIn
      -> Set TxIn
      -> StrictSeq (AlonzoTxOut AlonzoEra)
      -> Coin
      -> StrictMaybe SlotNo
      -> StrictSeq (ShelleyTxCert AlonzoEra)
      -> Withdrawals
      -> StrictMaybe (Update AlonzoEra)
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> AlonzoTxBodyRaw)
forall t. t -> Encode ('Closed 'Sparse) t
Keyed
          ( \Set TxIn
i Set TxIn
ifee StrictSeq (AlonzoTxOut AlonzoEra)
o Coin
f StrictMaybe SlotNo
t StrictSeq (ShelleyTxCert AlonzoEra)
c Withdrawals
w StrictMaybe (Update AlonzoEra)
u StrictMaybe SlotNo
b Set (KeyHash 'Witness)
rsh MultiAsset
mi StrictMaybe ScriptIntegrityHash
sh StrictMaybe TxAuxDataHash
ah StrictMaybe Network
ni ->
              Set TxIn
-> Set TxIn
-> StrictSeq (TxOut AlonzoEra)
-> StrictSeq (TxCert AlonzoEra)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update AlonzoEra)
-> Set (KeyHash 'Witness)
-> MultiAsset
-> StrictMaybe ScriptIntegrityHash
-> StrictMaybe TxAuxDataHash
-> StrictMaybe Network
-> AlonzoTxBodyRaw
AlonzoTxBodyRaw Set TxIn
i Set TxIn
ifee StrictSeq (TxOut AlonzoEra)
StrictSeq (AlonzoTxOut AlonzoEra)
o StrictSeq (TxCert AlonzoEra)
StrictSeq (ShelleyTxCert AlonzoEra)
c Withdrawals
w Coin
f (StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval StrictMaybe SlotNo
b StrictMaybe SlotNo
t) StrictMaybe (Update AlonzoEra)
u Set (KeyHash 'Witness)
rsh MultiAsset
mi StrictMaybe ScriptIntegrityHash
sh StrictMaybe TxAuxDataHash
ah StrictMaybe Network
ni
          )
          Encode
  ('Closed 'Sparse)
  (Set TxIn
   -> Set TxIn
   -> StrictSeq (AlonzoTxOut AlonzoEra)
   -> Coin
   -> StrictMaybe SlotNo
   -> StrictSeq (ShelleyTxCert AlonzoEra)
   -> Withdrawals
   -> StrictMaybe (Update AlonzoEra)
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> AlonzoTxBodyRaw)
-> Encode ('Closed 'Sparse) (Set TxIn)
-> Encode
     ('Closed 'Sparse)
     (Set TxIn
      -> StrictSeq (AlonzoTxOut AlonzoEra)
      -> Coin
      -> StrictMaybe SlotNo
      -> StrictSeq (ShelleyTxCert AlonzoEra)
      -> Withdrawals
      -> StrictMaybe (Update AlonzoEra)
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> AlonzoTxBodyRaw)
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
atbrInputs)
          Encode
  ('Closed 'Sparse)
  (Set TxIn
   -> StrictSeq (AlonzoTxOut AlonzoEra)
   -> Coin
   -> StrictMaybe SlotNo
   -> StrictSeq (ShelleyTxCert AlonzoEra)
   -> Withdrawals
   -> StrictMaybe (Update AlonzoEra)
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> AlonzoTxBodyRaw)
-> Encode ('Closed 'Sparse) (Set TxIn)
-> Encode
     ('Closed 'Sparse)
     (StrictSeq (AlonzoTxOut AlonzoEra)
      -> Coin
      -> StrictMaybe SlotNo
      -> StrictSeq (ShelleyTxCert AlonzoEra)
      -> Withdrawals
      -> StrictMaybe (Update AlonzoEra)
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> AlonzoTxBodyRaw)
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
atbrCollateral))
          Encode
  ('Closed 'Sparse)
  (StrictSeq (AlonzoTxOut AlonzoEra)
   -> Coin
   -> StrictMaybe SlotNo
   -> StrictSeq (ShelleyTxCert AlonzoEra)
   -> Withdrawals
   -> StrictMaybe (Update AlonzoEra)
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> AlonzoTxBodyRaw)
-> Encode ('Closed 'Sparse) (StrictSeq (AlonzoTxOut AlonzoEra))
-> Encode
     ('Closed 'Sparse)
     (Coin
      -> StrictMaybe SlotNo
      -> StrictSeq (ShelleyTxCert AlonzoEra)
      -> Withdrawals
      -> StrictMaybe (Update AlonzoEra)
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> AlonzoTxBodyRaw)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> Encode ('Closed 'Dense) (StrictSeq (AlonzoTxOut AlonzoEra))
-> Encode ('Closed 'Sparse) (StrictSeq (AlonzoTxOut AlonzoEra))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
1 (StrictSeq (AlonzoTxOut AlonzoEra)
-> Encode ('Closed 'Dense) (StrictSeq (AlonzoTxOut AlonzoEra))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictSeq (TxOut AlonzoEra)
StrictSeq (AlonzoTxOut AlonzoEra)
atbrOutputs)
          Encode
  ('Closed 'Sparse)
  (Coin
   -> StrictMaybe SlotNo
   -> StrictSeq (ShelleyTxCert AlonzoEra)
   -> Withdrawals
   -> StrictMaybe (Update AlonzoEra)
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> AlonzoTxBodyRaw)
-> Encode ('Closed 'Sparse) Coin
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe SlotNo
      -> StrictSeq (ShelleyTxCert AlonzoEra)
      -> Withdrawals
      -> StrictMaybe (Update AlonzoEra)
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> AlonzoTxBodyRaw)
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
atbrTxFee)
          Encode
  ('Closed 'Sparse)
  (StrictMaybe SlotNo
   -> StrictSeq (ShelleyTxCert AlonzoEra)
   -> Withdrawals
   -> StrictMaybe (Update AlonzoEra)
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> AlonzoTxBodyRaw)
-> Encode ('Closed 'Sparse) (StrictMaybe SlotNo)
-> Encode
     ('Closed 'Sparse)
     (StrictSeq (ShelleyTxCert AlonzoEra)
      -> Withdrawals
      -> StrictMaybe (Update AlonzoEra)
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> AlonzoTxBodyRaw)
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)
  (StrictSeq (ShelleyTxCert AlonzoEra)
   -> Withdrawals
   -> StrictMaybe (Update AlonzoEra)
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> AlonzoTxBodyRaw)
-> Encode ('Closed 'Sparse) (StrictSeq (ShelleyTxCert AlonzoEra))
-> Encode
     ('Closed 'Sparse)
     (Withdrawals
      -> StrictMaybe (Update AlonzoEra)
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> AlonzoTxBodyRaw)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictSeq (ShelleyTxCert AlonzoEra) -> Bool)
-> Encode ('Closed 'Sparse) (StrictSeq (ShelleyTxCert AlonzoEra))
-> Encode ('Closed 'Sparse) (StrictSeq (ShelleyTxCert AlonzoEra))
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit StrictSeq (ShelleyTxCert AlonzoEra) -> Bool
forall a. StrictSeq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Word
-> Encode ('Closed 'Dense) (StrictSeq (ShelleyTxCert AlonzoEra))
-> Encode ('Closed 'Sparse) (StrictSeq (ShelleyTxCert AlonzoEra))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
4 (StrictSeq (ShelleyTxCert AlonzoEra)
-> Encode ('Closed 'Dense) (StrictSeq (ShelleyTxCert AlonzoEra))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictSeq (TxCert AlonzoEra)
StrictSeq (ShelleyTxCert AlonzoEra)
atbrCerts))
          Encode
  ('Closed 'Sparse)
  (Withdrawals
   -> StrictMaybe (Update AlonzoEra)
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> AlonzoTxBodyRaw)
-> Encode ('Closed 'Sparse) Withdrawals
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe (Update AlonzoEra)
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> AlonzoTxBodyRaw)
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
atbrWithdrawals))
          Encode
  ('Closed 'Sparse)
  (StrictMaybe (Update AlonzoEra)
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> AlonzoTxBodyRaw)
-> Encode ('Closed 'Sparse) (StrictMaybe (Update AlonzoEra))
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe SlotNo
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> AlonzoTxBodyRaw)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe (Update AlonzoEra)
-> Encode ('Closed 'Sparse) (StrictMaybe (Update AlonzoEra))
forall a.
EncCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
6 StrictMaybe (Update AlonzoEra)
atbrUpdate
          Encode
  ('Closed 'Sparse)
  (StrictMaybe SlotNo
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> AlonzoTxBodyRaw)
-> Encode ('Closed 'Sparse) (StrictMaybe SlotNo)
-> Encode
     ('Closed 'Sparse)
     (Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> AlonzoTxBodyRaw)
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
   -> AlonzoTxBodyRaw)
-> Encode ('Closed 'Sparse) (Set (KeyHash 'Witness))
-> Encode
     ('Closed 'Sparse)
     (MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> AlonzoTxBodyRaw)
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)
atbrReqSignerHashes))
          Encode
  ('Closed 'Sparse)
  (MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> AlonzoTxBodyRaw)
-> Encode ('Closed 'Sparse) MultiAsset
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> AlonzoTxBodyRaw)
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
atbrMint))
          Encode
  ('Closed 'Sparse)
  (StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> AlonzoTxBodyRaw)
-> Encode ('Closed 'Sparse) (StrictMaybe ScriptIntegrityHash)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe TxAuxDataHash
      -> StrictMaybe Network -> AlonzoTxBodyRaw)
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
atbrScriptIntegrityHash
          Encode
  ('Closed 'Sparse)
  (StrictMaybe TxAuxDataHash
   -> StrictMaybe Network -> AlonzoTxBodyRaw)
-> Encode ('Closed 'Sparse) (StrictMaybe TxAuxDataHash)
-> Encode
     ('Closed 'Sparse) (StrictMaybe Network -> AlonzoTxBodyRaw)
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
atbrAuxDataHash
          Encode ('Closed 'Sparse) (StrictMaybe Network -> AlonzoTxBodyRaw)
-> Encode ('Closed 'Sparse) (StrictMaybe Network)
-> Encode ('Closed 'Sparse) AlonzoTxBodyRaw
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
atbrTxNetworkId

instance DecCBOR AlonzoTxBodyRaw where
  decCBOR :: forall s. Decoder s AlonzoTxBodyRaw
decCBOR =
    Decode ('Closed 'Dense) AlonzoTxBodyRaw
-> Decoder s AlonzoTxBodyRaw
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) AlonzoTxBodyRaw
 -> Decoder s AlonzoTxBodyRaw)
-> Decode ('Closed 'Dense) AlonzoTxBodyRaw
-> Decoder s AlonzoTxBodyRaw
forall a b. (a -> b) -> a -> b
$
      String
-> AlonzoTxBodyRaw
-> (Word -> Field AlonzoTxBodyRaw)
-> [(Word, String)]
-> Decode ('Closed 'Dense) AlonzoTxBodyRaw
forall t.
Typeable t =>
String
-> t
-> (Word -> Field t)
-> [(Word, String)]
-> Decode ('Closed 'Dense) t
SparseKeyed
        String
"AlonzoTxBodyRaw"
        AlonzoTxBodyRaw
emptyAlonzoTxBodyRaw
        Word -> Field AlonzoTxBodyRaw
bodyFields
        [(Word, String)]
requiredFields
    where
      bodyFields :: Word -> Field AlonzoTxBodyRaw
      bodyFields :: Word -> Field AlonzoTxBodyRaw
bodyFields Word
0 = (Set TxIn -> AlonzoTxBodyRaw -> AlonzoTxBodyRaw)
-> Decode ('Closed Any) (Set TxIn) -> Field AlonzoTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Set TxIn
x AlonzoTxBodyRaw
tx -> AlonzoTxBodyRaw
tx {atbrInputs = x}) Decode ('Closed Any) (Set TxIn)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
1 = (StrictSeq (AlonzoTxOut AlonzoEra)
 -> AlonzoTxBodyRaw -> AlonzoTxBodyRaw)
-> Decode ('Closed Any) (StrictSeq (AlonzoTxOut AlonzoEra))
-> Field AlonzoTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\StrictSeq (AlonzoTxOut AlonzoEra)
x AlonzoTxBodyRaw
tx -> AlonzoTxBodyRaw
tx {atbrOutputs = x}) Decode ('Closed Any) (StrictSeq (AlonzoTxOut AlonzoEra))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
2 = (Coin -> AlonzoTxBodyRaw -> AlonzoTxBodyRaw)
-> Decode ('Closed Any) Coin -> Field AlonzoTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Coin
x AlonzoTxBodyRaw
tx -> AlonzoTxBodyRaw
tx {atbrTxFee = x}) Decode ('Closed Any) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
3 =
        (StrictMaybe SlotNo -> AlonzoTxBodyRaw -> AlonzoTxBodyRaw)
-> Decode ('Closed Any) SlotNo -> Field AlonzoTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield
          (\StrictMaybe SlotNo
x AlonzoTxBodyRaw
tx -> AlonzoTxBodyRaw
tx {atbrValidityInterval = (atbrValidityInterval tx) {invalidHereafter = x}})
          Decode ('Closed Any) SlotNo
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
4 = (StrictSeq (ShelleyTxCert AlonzoEra)
 -> AlonzoTxBodyRaw -> AlonzoTxBodyRaw)
-> Decode ('Closed Any) (StrictSeq (ShelleyTxCert AlonzoEra))
-> Field AlonzoTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\StrictSeq (ShelleyTxCert AlonzoEra)
x AlonzoTxBodyRaw
tx -> AlonzoTxBodyRaw
tx {atbrCerts = x}) Decode ('Closed Any) (StrictSeq (ShelleyTxCert AlonzoEra))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
5 = (Withdrawals -> AlonzoTxBodyRaw -> AlonzoTxBodyRaw)
-> Decode ('Closed Any) Withdrawals -> Field AlonzoTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Withdrawals
x AlonzoTxBodyRaw
tx -> AlonzoTxBodyRaw
tx {atbrWithdrawals = x}) Decode ('Closed Any) Withdrawals
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
6 = (StrictMaybe (Update AlonzoEra)
 -> AlonzoTxBodyRaw -> AlonzoTxBodyRaw)
-> Decode ('Closed Any) (Update AlonzoEra) -> Field AlonzoTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield (\StrictMaybe (Update AlonzoEra)
x AlonzoTxBodyRaw
tx -> AlonzoTxBodyRaw
tx {atbrUpdate = x}) Decode ('Closed Any) (Update AlonzoEra)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
7 = (StrictMaybe TxAuxDataHash -> AlonzoTxBodyRaw -> AlonzoTxBodyRaw)
-> Decode ('Closed Any) TxAuxDataHash -> Field AlonzoTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield (\StrictMaybe TxAuxDataHash
x AlonzoTxBodyRaw
tx -> AlonzoTxBodyRaw
tx {atbrAuxDataHash = x}) Decode ('Closed Any) TxAuxDataHash
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
8 =
        (StrictMaybe SlotNo -> AlonzoTxBodyRaw -> AlonzoTxBodyRaw)
-> Decode ('Closed Any) SlotNo -> Field AlonzoTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield
          (\StrictMaybe SlotNo
x AlonzoTxBodyRaw
tx -> AlonzoTxBodyRaw
tx {atbrValidityInterval = (atbrValidityInterval tx) {invalidBefore = x}})
          Decode ('Closed Any) SlotNo
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
9 = (MultiAsset -> AlonzoTxBodyRaw -> AlonzoTxBodyRaw)
-> Decode ('Closed Any) MultiAsset -> Field AlonzoTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\MultiAsset
x AlonzoTxBodyRaw
tx -> AlonzoTxBodyRaw
tx {atbrMint = x}) Decode ('Closed Any) MultiAsset
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
11 = (StrictMaybe ScriptIntegrityHash
 -> AlonzoTxBodyRaw -> AlonzoTxBodyRaw)
-> Decode ('Closed Any) ScriptIntegrityHash
-> Field AlonzoTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield (\StrictMaybe ScriptIntegrityHash
x AlonzoTxBodyRaw
tx -> AlonzoTxBodyRaw
tx {atbrScriptIntegrityHash = x}) Decode ('Closed Any) ScriptIntegrityHash
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
13 = (Set TxIn -> AlonzoTxBodyRaw -> AlonzoTxBodyRaw)
-> Decode ('Closed Any) (Set TxIn) -> Field AlonzoTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Set TxIn
x AlonzoTxBodyRaw
tx -> AlonzoTxBodyRaw
tx {atbrCollateral = x}) Decode ('Closed Any) (Set TxIn)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
14 = (Set (KeyHash 'Witness) -> AlonzoTxBodyRaw -> AlonzoTxBodyRaw)
-> Decode ('Closed Any) (Set (KeyHash 'Witness))
-> Field AlonzoTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Set (KeyHash 'Witness)
x AlonzoTxBodyRaw
tx -> AlonzoTxBodyRaw
tx {atbrReqSignerHashes = x}) Decode ('Closed Any) (Set (KeyHash 'Witness))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
15 = (StrictMaybe Network -> AlonzoTxBodyRaw -> AlonzoTxBodyRaw)
-> Decode ('Closed Any) Network -> Field AlonzoTxBodyRaw
forall x t (d :: Density).
Typeable x =>
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield (\StrictMaybe Network
x AlonzoTxBodyRaw
tx -> AlonzoTxBodyRaw
tx {atbrTxNetworkId = x}) Decode ('Closed Any) Network
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      bodyFields Word
n = Word -> Field AlonzoTxBodyRaw
forall t. Word -> Field t
invalidField Word
n
      requiredFields :: [(Word, String)]
requiredFields =
        [ (Word
0, String
"inputs")
        , (Word
1, String
"outputs")
        , (Word
2, String
"fee")
        ]

emptyAlonzoTxBodyRaw :: AlonzoTxBodyRaw
emptyAlonzoTxBodyRaw :: AlonzoTxBodyRaw
emptyAlonzoTxBodyRaw =
  Set TxIn
-> Set TxIn
-> StrictSeq (TxOut AlonzoEra)
-> StrictSeq (TxCert AlonzoEra)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update AlonzoEra)
-> Set (KeyHash 'Witness)
-> MultiAsset
-> StrictMaybe ScriptIntegrityHash
-> StrictMaybe TxAuxDataHash
-> StrictMaybe Network
-> AlonzoTxBodyRaw
AlonzoTxBodyRaw
    Set TxIn
forall a. Monoid a => a
mempty
    Set TxIn
forall a. Monoid a => a
mempty
    StrictSeq (TxOut AlonzoEra)
StrictSeq (AlonzoTxOut AlonzoEra)
forall a. StrictSeq a
StrictSeq.empty
    StrictSeq (TxCert AlonzoEra)
StrictSeq (ShelleyTxCert AlonzoEra)
forall a. StrictSeq a
StrictSeq.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)
    StrictMaybe (Update AlonzoEra)
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

alonzoRedeemerPointer ::
  forall era.
  MaryEraTxBody era =>
  TxBody era ->
  AlonzoPlutusPurpose AsItem era ->
  StrictMaybe (AlonzoPlutusPurpose AsIx era)
alonzoRedeemerPointer :: forall era.
MaryEraTxBody era =>
TxBody era
-> AlonzoPlutusPurpose AsItem era
-> StrictMaybe (AlonzoPlutusPurpose AsIx era)
alonzoRedeemerPointer TxBody era
txBody = \case
  AlonzoSpending AsItem Word32 TxIn
txIn ->
    AsIx Word32 TxIn -> AlonzoPlutusPurpose AsIx era
forall (f :: * -> * -> *) era.
f Word32 TxIn -> AlonzoPlutusPurpose f era
AlonzoSpending (AsIx Word32 TxIn -> AlonzoPlutusPurpose AsIx era)
-> StrictMaybe (AsIx Word32 TxIn)
-> StrictMaybe (AlonzoPlutusPurpose 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)
  AlonzoMinting AsItem Word32 PolicyID
policyID ->
    AsIx Word32 PolicyID -> AlonzoPlutusPurpose AsIx era
forall (f :: * -> * -> *) era.
f Word32 PolicyID -> AlonzoPlutusPurpose f era
AlonzoMinting (AsIx Word32 PolicyID -> AlonzoPlutusPurpose AsIx era)
-> StrictMaybe (AsIx Word32 PolicyID)
-> StrictMaybe (AlonzoPlutusPurpose 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 :: Set PolicyID)
  AlonzoCertifying AsItem Word32 (TxCert era)
txCert ->
    AsIx Word32 (TxCert era) -> AlonzoPlutusPurpose AsIx era
forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> AlonzoPlutusPurpose f era
AlonzoCertifying (AsIx Word32 (TxCert era) -> AlonzoPlutusPurpose AsIx era)
-> StrictMaybe (AsIx Word32 (TxCert era))
-> StrictMaybe (AlonzoPlutusPurpose 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)
  AlonzoRewarding AsItem Word32 RewardAccount
rewardAccount ->
    AsIx Word32 RewardAccount -> AlonzoPlutusPurpose AsIx era
forall (f :: * -> * -> *) era.
f Word32 RewardAccount -> AlonzoPlutusPurpose f era
AlonzoRewarding (AsIx Word32 RewardAccount -> AlonzoPlutusPurpose AsIx era)
-> StrictMaybe (AsIx Word32 RewardAccount)
-> StrictMaybe (AlonzoPlutusPurpose 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))

alonzoRedeemerPointerInverse ::
  MaryEraTxBody era =>
  TxBody era ->
  AlonzoPlutusPurpose AsIx era ->
  StrictMaybe (AlonzoPlutusPurpose AsIxItem era)
alonzoRedeemerPointerInverse :: forall era.
MaryEraTxBody era =>
TxBody era
-> AlonzoPlutusPurpose AsIx era
-> StrictMaybe (AlonzoPlutusPurpose AsIxItem era)
alonzoRedeemerPointerInverse TxBody era
txBody = \case
  AlonzoSpending AsIx Word32 TxIn
idx ->
    AsIxItem Word32 TxIn -> AlonzoPlutusPurpose AsIxItem era
forall (f :: * -> * -> *) era.
f Word32 TxIn -> AlonzoPlutusPurpose f era
AlonzoSpending (AsIxItem Word32 TxIn -> AlonzoPlutusPurpose AsIxItem era)
-> StrictMaybe (AsIxItem Word32 TxIn)
-> StrictMaybe (AlonzoPlutusPurpose 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)
  AlonzoMinting AsIx Word32 PolicyID
idx ->
    AsIxItem Word32 PolicyID -> AlonzoPlutusPurpose AsIxItem era
forall (f :: * -> * -> *) era.
f Word32 PolicyID -> AlonzoPlutusPurpose f era
AlonzoMinting (AsIxItem Word32 PolicyID -> AlonzoPlutusPurpose AsIxItem era)
-> StrictMaybe (AsIxItem Word32 PolicyID)
-> StrictMaybe (AlonzoPlutusPurpose 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)
  AlonzoCertifying AsIx Word32 (TxCert era)
idx ->
    AsIxItem Word32 (TxCert era) -> AlonzoPlutusPurpose AsIxItem era
forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> AlonzoPlutusPurpose f era
AlonzoCertifying (AsIxItem Word32 (TxCert era) -> AlonzoPlutusPurpose AsIxItem era)
-> StrictMaybe (AsIxItem Word32 (TxCert era))
-> StrictMaybe (AlonzoPlutusPurpose 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)
  AlonzoRewarding AsIx Word32 RewardAccount
idx ->
    AsIxItem Word32 RewardAccount -> AlonzoPlutusPurpose AsIxItem era
forall (f :: * -> * -> *) era.
f Word32 RewardAccount -> AlonzoPlutusPurpose f era
AlonzoRewarding (AsIxItem Word32 RewardAccount -> AlonzoPlutusPurpose AsIxItem era)
-> StrictMaybe (AsIxItem Word32 RewardAccount)
-> StrictMaybe (AlonzoPlutusPurpose 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))

class Indexable elem container where
  indexOf :: AsItem Word32 elem -> container -> StrictMaybe (AsIx Word32 elem)
  fromIndex :: AsIx Word32 elem -> container -> StrictMaybe (AsIxItem Word32 elem)

instance Ord k => Indexable k (Set k) where
  indexOf :: AsItem Word32 k -> Set k -> StrictMaybe (AsIx Word32 k)
indexOf (AsItem k
n) Set k
s = case k -> Set k -> Maybe Int
forall a. Ord a => a -> Set a -> Maybe Int
Set.lookupIndex k
n Set k
s of
    Just Int
x -> AsIx Word32 k -> StrictMaybe (AsIx Word32 k)
forall a. a -> StrictMaybe a
SJust (Word32 -> AsIx Word32 k
forall ix it. ix -> AsIx ix it
AsIx (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word32 Int
x))
    Maybe Int
Nothing -> StrictMaybe (AsIx Word32 k)
forall a. StrictMaybe a
SNothing
  fromIndex :: AsIx Word32 k -> Set k -> StrictMaybe (AsIxItem Word32 k)
fromIndex (AsIx Word32
w32) Set k
s =
    let i :: Int
i = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Int Word32
w32
     in if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Set k -> Int
forall a. Set a -> Int
Set.size Set k
s
          then AsIxItem Word32 k -> StrictMaybe (AsIxItem Word32 k)
forall a. a -> StrictMaybe a
SJust (AsIxItem Word32 k -> StrictMaybe (AsIxItem Word32 k))
-> AsIxItem Word32 k -> StrictMaybe (AsIxItem Word32 k)
forall a b. (a -> b) -> a -> b
$ Word32 -> k -> AsIxItem Word32 k
forall ix it. ix -> it -> AsIxItem ix it
AsIxItem Word32
w32 (Int -> Set k -> k
forall a. Int -> Set a -> a
Set.elemAt Int
i Set k
s)
          else StrictMaybe (AsIxItem Word32 k)
forall a. StrictMaybe a
SNothing

instance Eq k => Indexable k (StrictSeq k) where
  indexOf :: AsItem Word32 k -> StrictSeq k -> StrictMaybe (AsIx Word32 k)
indexOf (AsItem k
n) StrictSeq k
seqx = case (k -> Bool) -> StrictSeq k -> Maybe Int
forall a. (a -> Bool) -> StrictSeq a -> Maybe Int
StrictSeq.findIndexL (k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
n) StrictSeq k
seqx of
    Just Int
m -> AsIx Word32 k -> StrictMaybe (AsIx Word32 k)
forall a. a -> StrictMaybe a
SJust (Word32 -> AsIx Word32 k
forall ix it. ix -> AsIx ix it
AsIx (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word32 Int
m))
    Maybe Int
Nothing -> StrictMaybe (AsIx Word32 k)
forall a. StrictMaybe a
SNothing
  fromIndex :: AsIx Word32 k -> StrictSeq k -> StrictMaybe (AsIxItem Word32 k)
fromIndex (AsIx Word32
w32) StrictSeq k
seqx =
    case Int -> StrictSeq k -> Maybe k
forall a. Int -> StrictSeq a -> Maybe a
StrictSeq.lookup (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Int Word32
w32) StrictSeq k
seqx of
      Maybe k
Nothing -> StrictMaybe (AsIxItem Word32 k)
forall a. StrictMaybe a
SNothing
      Just k
x -> AsIxItem Word32 k -> StrictMaybe (AsIxItem Word32 k)
forall a. a -> StrictMaybe a
SJust (AsIxItem Word32 k -> StrictMaybe (AsIxItem Word32 k))
-> AsIxItem Word32 k -> StrictMaybe (AsIxItem Word32 k)
forall a b. (a -> b) -> a -> b
$ Word32 -> k -> AsIxItem Word32 k
forall ix it. ix -> it -> AsIxItem ix it
AsIxItem Word32
w32 k
x

instance Ord k => Indexable k (Map.Map k v) where
  indexOf :: AsItem Word32 k -> Map k v -> StrictMaybe (AsIx Word32 k)
indexOf (AsItem k
n) Map k v
mp = case k -> Map k v -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe Int
Map.lookupIndex k
n Map k v
mp of
    Just Int
x -> AsIx Word32 k -> StrictMaybe (AsIx Word32 k)
forall a. a -> StrictMaybe a
SJust (Word32 -> AsIx Word32 k
forall ix it. ix -> AsIx ix it
AsIx (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word32 Int
x))
    Maybe Int
Nothing -> StrictMaybe (AsIx Word32 k)
forall a. StrictMaybe a
SNothing
  fromIndex :: AsIx Word32 k -> Map k v -> StrictMaybe (AsIxItem Word32 k)
fromIndex (AsIx Word32
w32) Map k v
mp =
    let i :: Int
i = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Int Word32
w32
     in if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Map k v -> Int
forall k a. Map k a -> Int
Map.size Map k v
mp)
          then AsIxItem Word32 k -> StrictMaybe (AsIxItem Word32 k)
forall a. a -> StrictMaybe a
SJust (AsIxItem Word32 k -> StrictMaybe (AsIxItem Word32 k))
-> ((k, v) -> AsIxItem Word32 k)
-> (k, v)
-> StrictMaybe (AsIxItem Word32 k)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> k -> AsIxItem Word32 k
forall ix it. ix -> it -> AsIxItem ix it
AsIxItem Word32
w32 (k -> AsIxItem Word32 k)
-> ((k, v) -> k) -> (k, v) -> AsIxItem Word32 k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k, v) -> k
forall a b. (a, b) -> a
fst ((k, v) -> StrictMaybe (AsIxItem Word32 k))
-> (k, v) -> StrictMaybe (AsIxItem Word32 k)
forall a b. (a -> b) -> a -> b
$ Int -> Map k v -> (k, v)
forall k a. Int -> Map k a -> (k, a)
Map.elemAt Int
i Map k v
mp
          else StrictMaybe (AsIxItem Word32 k)
forall a. StrictMaybe a
SNothing

instance Ord k => Indexable k (OSet k) where
  indexOf :: AsItem Word32 k -> OSet k -> StrictMaybe (AsIx Word32 k)
indexOf AsItem Word32 k
asItem = AsItem Word32 k -> StrictSeq k -> StrictMaybe (AsIx Word32 k)
forall elem container.
Indexable elem container =>
AsItem Word32 elem -> container -> StrictMaybe (AsIx Word32 elem)
indexOf AsItem Word32 k
asItem (StrictSeq k -> StrictMaybe (AsIx Word32 k))
-> (OSet k -> StrictSeq k) -> OSet k -> StrictMaybe (AsIx Word32 k)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OSet k -> StrictSeq k
forall a. OSet a -> StrictSeq a
OSet.toStrictSeq
  fromIndex :: AsIx Word32 k -> OSet k -> StrictMaybe (AsIxItem Word32 k)
fromIndex AsIx Word32 k
asIndex = AsIx Word32 k -> StrictSeq k -> StrictMaybe (AsIxItem Word32 k)
forall elem container.
Indexable elem container =>
AsIx Word32 elem -> container -> StrictMaybe (AsIxItem Word32 elem)
fromIndex AsIx Word32 k
asIndex (StrictSeq k -> StrictMaybe (AsIxItem Word32 k))
-> (OSet k -> StrictSeq k)
-> OSet k
-> StrictMaybe (AsIxItem Word32 k)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OSet k -> StrictSeq k
forall a. OSet a -> StrictSeq a
OSet.toStrictSeq