{-# 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 TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_HADDOCK not-home #-}

-- | Provides Alonzo TxBody internals
--
-- = Warning
--
-- This module is considered __internal__.
--
-- The contents of this module may change __in any way whatsoever__
-- and __without any warning__ between minor versions of this package.
module Cardano.Ledger.Alonzo.TxBody.Internal (
  AlonzoTxOut (..),
  AlonzoEraTxOut (..),
  -- Constructors are not exported for safety:
  Addr28Extra,
  DataHash32,
  AlonzoTxBody (
    ..,
    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 (AuxiliaryDataHash (..))
import Cardano.Ledger.Alonzo.TxCert ()
import Cardano.Ledger.Alonzo.TxOut
import Cardano.Ledger.BaseTypes (
  Network (..),
  StrictMaybe (..),
 )
import Cardano.Ledger.Binary (
  Annotator,
  DecCBOR (..),
  EncCBOR (..),
  ToCBOR (..),
 )
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Crypto
import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..))
import Cardano.Ledger.Mary (MaryEra)
import Cardano.Ledger.Mary.Core
import Cardano.Ledger.Mary.TxBody (MaryTxBody (..))
import Cardano.Ledger.Mary.Value (
  MaryValue (MaryValue),
  MultiAsset (..),
  PolicyID (..),
  policies,
 )
import Cardano.Ledger.MemoBytes (
  EqRaw,
  Mem,
  MemoBytes,
  MemoHashIndex,
  Memoized (..),
  getMemoRawType,
  getMemoSafeHash,
  lensMemoRawType,
  mkMemoized,
 )
import Cardano.Ledger.SafeHash (HashAnnotated (..), SafeHash, SafeToHash)
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.Class (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.Typeable (Typeable)
import Data.Void (absurd)
import Data.Word (Word32)
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks)

type ScriptIntegrityHash c = SafeHash c EraIndependentScriptIntegrity

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

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

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

  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 era = AlonzoTxBodyRaw
  { forall era. AlonzoTxBodyRaw era -> Set (TxIn (EraCrypto era))
atbrInputs :: !(Set (TxIn (EraCrypto era)))
  , forall era. AlonzoTxBodyRaw era -> Set (TxIn (EraCrypto era))
atbrCollateral :: !(Set (TxIn (EraCrypto era)))
  , forall era. AlonzoTxBodyRaw era -> StrictSeq (TxOut era)
atbrOutputs :: !(StrictSeq (TxOut era))
  , forall era. AlonzoTxBodyRaw era -> StrictSeq (TxCert era)
atbrCerts :: !(StrictSeq (TxCert era))
  , forall era. AlonzoTxBodyRaw era -> Withdrawals (EraCrypto era)
atbrWithdrawals :: !(Withdrawals (EraCrypto era))
  , forall era. AlonzoTxBodyRaw era -> Coin
atbrTxFee :: !Coin
  , forall era. AlonzoTxBodyRaw era -> ValidityInterval
atbrValidityInterval :: !ValidityInterval
  , forall era. AlonzoTxBodyRaw era -> StrictMaybe (Update era)
atbrUpdate :: !(StrictMaybe (Update era))
  , forall era.
AlonzoTxBodyRaw era -> Set (KeyHash 'Witness (EraCrypto era))
atbrReqSignerHashes :: Set (KeyHash 'Witness (EraCrypto era))
  , forall era. AlonzoTxBodyRaw era -> MultiAsset (EraCrypto era)
atbrMint :: !(MultiAsset (EraCrypto era))
  , forall era.
AlonzoTxBodyRaw era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
atbrScriptIntegrityHash :: !(StrictMaybe (ScriptIntegrityHash (EraCrypto era)))
  , forall era.
AlonzoTxBodyRaw era
-> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
atbrAuxDataHash :: !(StrictMaybe (AuxiliaryDataHash (EraCrypto era)))
  , forall era. AlonzoTxBodyRaw era -> StrictMaybe Network
atbrTxNetworkId :: !(StrictMaybe Network)
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (AlonzoTxBodyRaw era) x -> AlonzoTxBodyRaw era
forall era x. AlonzoTxBodyRaw era -> Rep (AlonzoTxBodyRaw era) x
$cto :: forall era x. Rep (AlonzoTxBodyRaw era) x -> AlonzoTxBodyRaw era
$cfrom :: forall era x. AlonzoTxBodyRaw era -> Rep (AlonzoTxBodyRaw era) x
Generic, Typeable)

deriving instance
  (Era era, Eq (TxOut era), Eq (TxCert era), Eq (PParamsUpdate era)) =>
  Eq (AlonzoTxBodyRaw era)

instance
  (Era era, NoThunks (TxOut era), NoThunks (TxCert era), NoThunks (PParamsUpdate era)) =>
  NoThunks (AlonzoTxBodyRaw era)

instance
  (Era era, NFData (TxOut era), NFData (TxCert era), NFData (PParamsUpdate era)) =>
  NFData (AlonzoTxBodyRaw era)

deriving instance
  (Era era, Show (TxOut era), Show (TxCert era), Show (PParamsUpdate era)) =>
  Show (AlonzoTxBodyRaw era)

newtype AlonzoTxBody era = TxBodyConstr (MemoBytes AlonzoTxBodyRaw era)
  deriving (AlonzoTxBody era -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AlonzoTxBody era] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (AlonzoTxBody era) -> Size
forall {era}. Typeable era => Typeable (AlonzoTxBody era)
forall era. Typeable era => AlonzoTxBody era -> Encoding
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
forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AlonzoTxBody era] -> Size
forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (AlonzoTxBody era) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AlonzoTxBody era] -> Size
$cencodedListSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AlonzoTxBody era] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (AlonzoTxBody era) -> Size
$cencodedSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (AlonzoTxBody era) -> Size
toCBOR :: AlonzoTxBody era -> Encoding
$ctoCBOR :: forall era. Typeable era => AlonzoTxBody era -> Encoding
ToCBOR, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (AlonzoTxBody era) x -> AlonzoTxBody era
forall era x. AlonzoTxBody era -> Rep (AlonzoTxBody era) x
$cto :: forall era x. Rep (AlonzoTxBody era) x -> AlonzoTxBody era
$cfrom :: forall era x. AlonzoTxBody era -> Rep (AlonzoTxBody era) x
Generic)
  deriving newtype (AlonzoTxBody era -> Int
AlonzoTxBody era -> ByteString
forall era. AlonzoTxBody era -> Int
forall era. AlonzoTxBody era -> ByteString
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall c index.
    HashAlgorithm (HASH c) =>
    Proxy c -> Proxy index -> t -> SafeHash c index)
-> SafeToHash t
forall c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> AlonzoTxBody era -> SafeHash c index
forall era c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> AlonzoTxBody era -> SafeHash c index
makeHashWithExplicitProxys :: forall c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> AlonzoTxBody era -> SafeHash c index
$cmakeHashWithExplicitProxys :: forall era c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> AlonzoTxBody era -> SafeHash c index
originalBytesSize :: AlonzoTxBody era -> Int
$coriginalBytesSize :: forall era. AlonzoTxBody era -> Int
originalBytes :: AlonzoTxBody era -> ByteString
$coriginalBytes :: forall era. AlonzoTxBody era -> ByteString
SafeToHash)

instance Memoized AlonzoTxBody where
  type RawType AlonzoTxBody = 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlonzoTxBodyUpgradeError] -> ShowS
$cshowList :: [AlonzoTxBodyUpgradeError] -> ShowS
show :: AlonzoTxBodyUpgradeError -> String
$cshow :: AlonzoTxBodyUpgradeError -> String
showsPrec :: Int -> AlonzoTxBodyUpgradeError -> ShowS
$cshowsPrec :: Int -> AlonzoTxBodyUpgradeError -> ShowS
Show)

instance Crypto c => EraTxBody (AlonzoEra c) where
  {-# SPECIALIZE instance EraTxBody (AlonzoEra StandardCrypto) #-}

  type TxBody (AlonzoEra c) = AlonzoTxBody (AlonzoEra c)
  type TxBodyUpgradeError (AlonzoEra c) = AlonzoTxBodyUpgradeError

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

  inputsTxBodyL :: Lens' (TxBody (AlonzoEra c)) (Set (TxIn (EraCrypto (AlonzoEra c))))
inputsTxBodyL =
    forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. AlonzoTxBodyRaw era -> Set (TxIn (EraCrypto era))
atbrInputs (\RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw Set (TxIn c)
inputs_ -> RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw {atbrInputs :: Set (TxIn (EraCrypto (AlonzoEra c)))
atbrInputs = Set (TxIn c)
inputs_})
  {-# INLINEABLE inputsTxBodyL #-}

  outputsTxBodyL :: Lens' (TxBody (AlonzoEra c)) (StrictSeq (TxOut (AlonzoEra c)))
outputsTxBodyL =
    forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. AlonzoTxBodyRaw era -> StrictSeq (TxOut era)
atbrOutputs (\RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw StrictSeq (AlonzoTxOut (AlonzoEra c))
outputs_ -> RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw {atbrOutputs :: StrictSeq (TxOut (AlonzoEra c))
atbrOutputs = StrictSeq (AlonzoTxOut (AlonzoEra c))
outputs_})
  {-# INLINEABLE outputsTxBodyL #-}

  feeTxBodyL :: Lens' (TxBody (AlonzoEra c)) Coin
feeTxBodyL =
    forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. AlonzoTxBodyRaw era -> Coin
atbrTxFee (\RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw Coin
fee_ -> RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw {atbrTxFee :: Coin
atbrTxFee = Coin
fee_})
  {-# INLINEABLE feeTxBodyL #-}

  auxDataHashTxBodyL :: Lens'
  (TxBody (AlonzoEra c))
  (StrictMaybe (AuxiliaryDataHash (EraCrypto (AlonzoEra c))))
auxDataHashTxBodyL =
    forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType
      forall era.
AlonzoTxBodyRaw era
-> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
atbrAuxDataHash
      (\RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw StrictMaybe (AuxiliaryDataHash c)
auxDataHash -> RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw {atbrAuxDataHash :: StrictMaybe (AuxiliaryDataHash (EraCrypto (AlonzoEra c)))
atbrAuxDataHash = StrictMaybe (AuxiliaryDataHash c)
auxDataHash})
  {-# INLINEABLE auxDataHashTxBodyL #-}

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

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

  withdrawalsTxBodyL :: Lens'
  (TxBody (AlonzoEra c)) (Withdrawals (EraCrypto (AlonzoEra c)))
withdrawalsTxBodyL =
    forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType
      forall era. AlonzoTxBodyRaw era -> Withdrawals (EraCrypto era)
atbrWithdrawals
      (\RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw Withdrawals c
withdrawals_ -> RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw {atbrWithdrawals :: Withdrawals (EraCrypto (AlonzoEra c))
atbrWithdrawals = Withdrawals c
withdrawals_})
  {-# INLINEABLE withdrawalsTxBodyL #-}

  certsTxBodyL :: Lens' (TxBody (AlonzoEra c)) (StrictSeq (TxCert (AlonzoEra c)))
certsTxBodyL =
    forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. AlonzoTxBodyRaw era -> StrictSeq (TxCert era)
atbrCerts (\RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw StrictSeq (ShelleyTxCert (AlonzoEra c))
certs_ -> RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw {atbrCerts :: StrictSeq (TxCert (AlonzoEra c))
atbrCerts = StrictSeq (ShelleyTxCert (AlonzoEra c))
certs_})
  {-# INLINEABLE certsTxBodyL #-}

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

  upgradeTxBody :: EraTxBody (PreviousEra (AlonzoEra c)) =>
TxBody (PreviousEra (AlonzoEra c))
-> Either (TxBodyUpgradeError (AlonzoEra c)) (TxBody (AlonzoEra c))
upgradeTxBody
    MaryTxBody
      { Set (TxIn (EraCrypto (MaryEra c)))
mtbInputs :: forall era.
(EraTxOut era, EraTxCert era) =>
MaryTxBody era -> Set (TxIn (EraCrypto era))
mtbInputs :: Set (TxIn (EraCrypto (MaryEra c)))
mtbInputs
      , StrictSeq (TxOut (MaryEra c))
mtbOutputs :: forall era.
(EraTxOut era, EraTxCert era) =>
MaryTxBody era -> StrictSeq (TxOut era)
mtbOutputs :: StrictSeq (TxOut (MaryEra c))
mtbOutputs
      , StrictSeq (TxCert (MaryEra c))
mtbCerts :: forall era.
(EraTxOut era, EraTxCert era) =>
MaryTxBody era -> StrictSeq (TxCert era)
mtbCerts :: StrictSeq (TxCert (MaryEra c))
mtbCerts
      , Withdrawals (EraCrypto (MaryEra c))
mtbWithdrawals :: forall era.
(EraTxOut era, EraTxCert era) =>
MaryTxBody era -> Withdrawals (EraCrypto era)
mtbWithdrawals :: Withdrawals (EraCrypto (MaryEra c))
mtbWithdrawals
      , Coin
mtbTxFee :: forall era. (EraTxOut era, EraTxCert era) => MaryTxBody era -> Coin
mtbTxFee :: Coin
mtbTxFee
      , ValidityInterval
mtbValidityInterval :: forall era.
(EraTxOut era, EraTxCert era) =>
MaryTxBody era -> ValidityInterval
mtbValidityInterval :: ValidityInterval
mtbValidityInterval
      , StrictMaybe (Update (MaryEra c))
mtbUpdate :: forall era.
(EraTxOut era, EraTxCert era) =>
MaryTxBody era -> StrictMaybe (Update era)
mtbUpdate :: StrictMaybe (Update (MaryEra c))
mtbUpdate
      , StrictMaybe (AuxiliaryDataHash (EraCrypto (MaryEra c)))
mtbAuxDataHash :: forall era.
(EraTxOut era, EraTxCert era) =>
MaryTxBody era -> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
mtbAuxDataHash :: StrictMaybe (AuxiliaryDataHash (EraCrypto (MaryEra c)))
mtbAuxDataHash
      , MultiAsset (EraCrypto (MaryEra c))
mtbMint :: forall era.
(EraTxOut era, EraTxCert era) =>
MaryTxBody era -> MultiAsset (EraCrypto era)
mtbMint :: MultiAsset (EraCrypto (MaryEra c))
mtbMint
      } = do
      StrictSeq (TxCert (AlonzoEra c))
certs <-
        forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
          (forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left forall a. Void -> a
absurd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(EraTxCert era, EraTxCert (PreviousEra era)) =>
TxCert (PreviousEra era)
-> Either (TxCertUpgradeError era) (TxCert era)
upgradeTxCert)
          StrictSeq (TxCert (MaryEra c))
mtbCerts

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

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

instance Crypto c => ShelleyEraTxBody (AlonzoEra c) where
  {-# SPECIALIZE instance ShelleyEraTxBody (AlonzoEra StandardCrypto) #-}

  ttlTxBodyL :: ExactEra ShelleyEra (AlonzoEra c) =>
Lens' (TxBody (AlonzoEra c)) SlotNo
ttlTxBodyL = forall a b. HasCallStack => Lens' a b
notSupportedInThisEraL

  updateTxBodyL :: Lens' (TxBody (AlonzoEra c)) (StrictMaybe (Update (AlonzoEra c)))
updateTxBodyL =
    forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. AlonzoTxBodyRaw era -> StrictMaybe (Update era)
atbrUpdate (\RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw StrictMaybe (Update (AlonzoEra c))
update_ -> RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw {atbrUpdate :: StrictMaybe (Update (AlonzoEra c))
atbrUpdate = StrictMaybe (Update (AlonzoEra c))
update_})
  {-# INLINEABLE updateTxBodyL #-}

instance Crypto c => AllegraEraTxBody (AlonzoEra c) where
  {-# SPECIALIZE instance AllegraEraTxBody (AlonzoEra StandardCrypto) #-}

  vldtTxBodyL :: Lens' (TxBody (AlonzoEra c)) ValidityInterval
vldtTxBodyL =
    forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. AlonzoTxBodyRaw era -> ValidityInterval
atbrValidityInterval (\RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw ValidityInterval
vldt_ -> RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw {atbrValidityInterval :: ValidityInterval
atbrValidityInterval = ValidityInterval
vldt_})
  {-# INLINEABLE vldtTxBodyL #-}

instance Crypto c => MaryEraTxBody (AlonzoEra c) where
  {-# SPECIALIZE instance MaryEraTxBody (AlonzoEra StandardCrypto) #-}

  mintTxBodyL :: Lens' (TxBody (AlonzoEra c)) (MultiAsset (EraCrypto (AlonzoEra c)))
mintTxBodyL =
    forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. AlonzoTxBodyRaw era -> MultiAsset (EraCrypto era)
atbrMint (\RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw MultiAsset c
mint_ -> RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw {atbrMint :: MultiAsset (EraCrypto (AlonzoEra c))
atbrMint = MultiAsset c
mint_})
  {-# INLINEABLE mintTxBodyL #-}

  mintValueTxBodyF :: SimpleGetter (TxBody (AlonzoEra c)) (Value (AlonzoEra c))
mintValueTxBodyF = forall era.
MaryEraTxBody era =>
Lens' (TxBody era) (MultiAsset (EraCrypto era))
mintTxBodyL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. (s -> a) -> SimpleGetter s a
to (forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue forall a. Monoid a => a
mempty)
  {-# INLINEABLE mintValueTxBodyF #-}

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

instance Crypto c => AlonzoEraTxBody (AlonzoEra c) where
  {-# SPECIALIZE instance AlonzoEraTxBody (AlonzoEra StandardCrypto) #-}

  collateralInputsTxBodyL :: Lens' (TxBody (AlonzoEra c)) (Set (TxIn (EraCrypto (AlonzoEra c))))
collateralInputsTxBodyL =
    forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. AlonzoTxBodyRaw era -> Set (TxIn (EraCrypto era))
atbrCollateral (\RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw Set (TxIn c)
collateral_ -> RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw {atbrCollateral :: Set (TxIn (EraCrypto (AlonzoEra c)))
atbrCollateral = Set (TxIn c)
collateral_})
  {-# INLINEABLE collateralInputsTxBodyL #-}

  reqSignerHashesTxBodyL :: Lens'
  (TxBody (AlonzoEra c))
  (Set (KeyHash 'Witness (EraCrypto (AlonzoEra c))))
reqSignerHashesTxBodyL =
    forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType
      forall era.
AlonzoTxBodyRaw era -> Set (KeyHash 'Witness (EraCrypto era))
atbrReqSignerHashes
      (\RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw Set (KeyHash 'Witness c)
reqSignerHashes_ -> RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw {atbrReqSignerHashes :: Set (KeyHash 'Witness (EraCrypto (AlonzoEra c)))
atbrReqSignerHashes = Set (KeyHash 'Witness c)
reqSignerHashes_})
  {-# INLINEABLE reqSignerHashesTxBodyL #-}

  scriptIntegrityHashTxBodyL :: Lens'
  (TxBody (AlonzoEra c))
  (StrictMaybe (ScriptIntegrityHash (EraCrypto (AlonzoEra c))))
scriptIntegrityHashTxBodyL =
    forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType
      forall era.
AlonzoTxBodyRaw era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
atbrScriptIntegrityHash
      (\RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw StrictMaybe (ScriptIntegrityHash c)
scriptIntegrityHash_ -> RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw {atbrScriptIntegrityHash :: StrictMaybe (ScriptIntegrityHash (EraCrypto (AlonzoEra c)))
atbrScriptIntegrityHash = StrictMaybe (ScriptIntegrityHash c)
scriptIntegrityHash_})
  {-# INLINEABLE scriptIntegrityHashTxBodyL #-}

  networkIdTxBodyL :: Lens' (TxBody (AlonzoEra c)) (StrictMaybe Network)
networkIdTxBodyL =
    forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. AlonzoTxBodyRaw era -> StrictMaybe Network
atbrTxNetworkId (\RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw StrictMaybe Network
networkId -> RawType AlonzoTxBody (AlonzoEra c)
txBodyRaw {atbrTxNetworkId :: StrictMaybe Network
atbrTxNetworkId = StrictMaybe Network
networkId})
  {-# INLINEABLE networkIdTxBodyL #-}

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

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

deriving newtype instance
  (Era era, Eq (TxOut era), Eq (TxCert era), Eq (PParamsUpdate era)) =>
  Eq (AlonzoTxBody era)

deriving instance
  (Era era, NoThunks (TxOut era), NoThunks (TxCert era), NoThunks (PParamsUpdate era)) =>
  NoThunks (AlonzoTxBody era)

deriving instance
  (Era era, NFData (TxOut era), NFData (TxCert era), NFData (PParamsUpdate era)) =>
  NFData (AlonzoTxBody era)

deriving instance
  (Era era, Show (TxOut era), Show (TxCert era), Show (PParamsUpdate era)) =>
  Show (AlonzoTxBody era)

deriving via
  (Mem AlonzoTxBodyRaw era)
  instance
    (Era era, DecCBOR (TxOut era), DecCBOR (TxCert era), DecCBOR (PParamsUpdate era)) =>
    DecCBOR (Annotator (AlonzoTxBody era))

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

{-# COMPLETE AlonzoTxBody #-}

type instance MemoHashIndex AlonzoTxBodyRaw = EraIndependentTxBody

instance c ~ EraCrypto era => HashAnnotated (AlonzoTxBody era) EraIndependentTxBody c where
  hashAnnotated :: HashAlgorithm (HASH c) =>
AlonzoTxBody era -> SafeHash c EraIndependentTxBody
hashAnnotated = forall (t :: * -> *) era.
Memoized t =>
t era -> SafeHash (EraCrypto era) (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' :: AlonzoTxBody era -> Set (TxIn (EraCrypto era))
collateral' :: AlonzoTxBody era -> Set (TxIn (EraCrypto era))
outputs' :: AlonzoTxBody era -> StrictSeq (TxOut era)
certs' :: AlonzoTxBody era -> StrictSeq (TxCert era)
txfee' :: AlonzoTxBody era -> Coin
withdrawals' :: AlonzoTxBody era -> Withdrawals (EraCrypto era)
vldt' :: AlonzoTxBody era -> ValidityInterval
update' :: AlonzoTxBody era -> StrictMaybe (Update era)
reqSignerHashes' :: AlonzoTxBody era -> Set (KeyHash 'Witness (EraCrypto era))
adHash' :: AlonzoTxBody era -> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
mint' :: AlonzoTxBody era -> MultiAsset (EraCrypto era)
scriptIntegrityHash' :: AlonzoTxBody era -> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
txnetworkid' :: AlonzoTxBody era -> StrictMaybe Network
inputs' :: forall era. AlonzoTxBody era -> Set (TxIn (EraCrypto era))
inputs' = forall era. AlonzoTxBodyRaw era -> Set (TxIn (EraCrypto era))
atbrInputs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) era. Memoized t => t era -> RawType t era
getMemoRawType

collateral' :: forall era. AlonzoTxBody era -> Set (TxIn (EraCrypto era))
collateral' = forall era. AlonzoTxBodyRaw era -> Set (TxIn (EraCrypto era))
atbrCollateral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) era. Memoized t => t era -> RawType t era
getMemoRawType

outputs' :: forall era. AlonzoTxBody era -> StrictSeq (TxOut era)
outputs' = forall era. AlonzoTxBodyRaw era -> StrictSeq (TxOut era)
atbrOutputs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) era. Memoized t => t era -> RawType t era
getMemoRawType

certs' :: forall era. AlonzoTxBody era -> StrictSeq (TxCert era)
certs' = forall era. AlonzoTxBodyRaw era -> StrictSeq (TxCert era)
atbrCerts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) era. Memoized t => t era -> RawType t era
getMemoRawType

withdrawals' :: forall era. AlonzoTxBody era -> Withdrawals (EraCrypto era)
withdrawals' = forall era. AlonzoTxBodyRaw era -> Withdrawals (EraCrypto era)
atbrWithdrawals forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) era. Memoized t => t era -> RawType t era
getMemoRawType

txfee' :: forall era. AlonzoTxBody era -> Coin
txfee' = forall era. AlonzoTxBodyRaw era -> Coin
atbrTxFee forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) era. Memoized t => t era -> RawType t era
getMemoRawType

vldt' :: forall era. AlonzoTxBody era -> ValidityInterval
vldt' = forall era. AlonzoTxBodyRaw era -> ValidityInterval
atbrValidityInterval forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) era. Memoized t => t era -> RawType t era
getMemoRawType

update' :: forall era. AlonzoTxBody era -> StrictMaybe (Update era)
update' = forall era. AlonzoTxBodyRaw era -> StrictMaybe (Update era)
atbrUpdate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) era. Memoized t => t era -> RawType t era
getMemoRawType

reqSignerHashes' :: forall era.
AlonzoTxBody era -> Set (KeyHash 'Witness (EraCrypto era))
reqSignerHashes' = forall era.
AlonzoTxBodyRaw era -> Set (KeyHash 'Witness (EraCrypto era))
atbrReqSignerHashes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) era. Memoized t => t era -> RawType t era
getMemoRawType

adHash' :: forall era.
AlonzoTxBody era -> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
adHash' = forall era.
AlonzoTxBodyRaw era
-> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
atbrAuxDataHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) era. Memoized t => t era -> RawType t era
getMemoRawType

mint' :: forall era. AlonzoTxBody era -> MultiAsset (EraCrypto era)
mint' = forall era. AlonzoTxBodyRaw era -> MultiAsset (EraCrypto era)
atbrMint forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) era. Memoized t => t era -> RawType t era
getMemoRawType

scriptIntegrityHash' :: forall era.
AlonzoTxBody era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
scriptIntegrityHash' = forall era.
AlonzoTxBodyRaw era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
atbrScriptIntegrityHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) era. Memoized t => t era -> RawType t era
getMemoRawType

txnetworkid' :: forall era. AlonzoTxBody era -> StrictMaybe Network
txnetworkid' = forall era. AlonzoTxBodyRaw era -> StrictMaybe Network
atbrTxNetworkId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) era. Memoized t => t era -> RawType t era
getMemoRawType

instance
  (Era era, Eq (PParamsUpdate era), Eq (TxOut era), Eq (TxCert era)) =>
  EqRaw (AlonzoTxBody era)

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

-- | Encodes memoized bytes created upon construction.
instance Era era => EncCBOR (AlonzoTxBody era)

instance
  (Era era, EncCBOR (TxOut era), EncCBOR (TxCert era), EncCBOR (PParamsUpdate era)) =>
  EncCBOR (AlonzoTxBodyRaw era)
  where
  encCBOR :: AlonzoTxBodyRaw era -> Encoding
encCBOR
    AlonzoTxBodyRaw
      { Set (TxIn (EraCrypto era))
atbrInputs :: Set (TxIn (EraCrypto era))
atbrInputs :: forall era. AlonzoTxBodyRaw era -> Set (TxIn (EraCrypto era))
atbrInputs
      , Set (TxIn (EraCrypto era))
atbrCollateral :: Set (TxIn (EraCrypto era))
atbrCollateral :: forall era. AlonzoTxBodyRaw era -> Set (TxIn (EraCrypto era))
atbrCollateral
      , StrictSeq (TxOut era)
atbrOutputs :: StrictSeq (TxOut era)
atbrOutputs :: forall era. AlonzoTxBodyRaw era -> StrictSeq (TxOut era)
atbrOutputs
      , StrictSeq (TxCert era)
atbrCerts :: StrictSeq (TxCert era)
atbrCerts :: forall era. AlonzoTxBodyRaw era -> StrictSeq (TxCert era)
atbrCerts
      , Withdrawals (EraCrypto era)
atbrWithdrawals :: Withdrawals (EraCrypto era)
atbrWithdrawals :: forall era. AlonzoTxBodyRaw era -> Withdrawals (EraCrypto era)
atbrWithdrawals
      , Coin
atbrTxFee :: Coin
atbrTxFee :: forall era. AlonzoTxBodyRaw era -> Coin
atbrTxFee
      , atbrValidityInterval :: forall era. AlonzoTxBodyRaw era -> ValidityInterval
atbrValidityInterval = ValidityInterval StrictMaybe SlotNo
bot StrictMaybe SlotNo
top
      , StrictMaybe (Update era)
atbrUpdate :: StrictMaybe (Update era)
atbrUpdate :: forall era. AlonzoTxBodyRaw era -> StrictMaybe (Update era)
atbrUpdate
      , Set (KeyHash 'Witness (EraCrypto era))
atbrReqSignerHashes :: Set (KeyHash 'Witness (EraCrypto era))
atbrReqSignerHashes :: forall era.
AlonzoTxBodyRaw era -> Set (KeyHash 'Witness (EraCrypto era))
atbrReqSignerHashes
      , MultiAsset (EraCrypto era)
atbrMint :: MultiAsset (EraCrypto era)
atbrMint :: forall era. AlonzoTxBodyRaw era -> MultiAsset (EraCrypto era)
atbrMint
      , StrictMaybe (ScriptIntegrityHash (EraCrypto era))
atbrScriptIntegrityHash :: StrictMaybe (ScriptIntegrityHash (EraCrypto era))
atbrScriptIntegrityHash :: forall era.
AlonzoTxBodyRaw era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
atbrScriptIntegrityHash
      , StrictMaybe (AuxiliaryDataHash (EraCrypto era))
atbrAuxDataHash :: StrictMaybe (AuxiliaryDataHash (EraCrypto era))
atbrAuxDataHash :: forall era.
AlonzoTxBodyRaw era
-> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
atbrAuxDataHash
      , StrictMaybe Network
atbrTxNetworkId :: StrictMaybe Network
atbrTxNetworkId :: forall era. AlonzoTxBodyRaw era -> StrictMaybe Network
atbrTxNetworkId
      } =
      forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$
        forall t. t -> Encode ('Closed 'Sparse) t
Keyed
          ( \Set (TxIn (EraCrypto era))
i Set (TxIn (EraCrypto era))
ifee StrictSeq (TxOut era)
o Coin
f StrictMaybe SlotNo
t StrictSeq (TxCert era)
c Withdrawals (EraCrypto era)
w StrictMaybe (Update era)
u StrictMaybe SlotNo
b Set (KeyHash 'Witness (EraCrypto era))
rsh MultiAsset (EraCrypto era)
mi StrictMaybe (ScriptIntegrityHash (EraCrypto era))
sh StrictMaybe (AuxiliaryDataHash (EraCrypto era))
ah StrictMaybe Network
ni ->
              forall era.
Set (TxIn (EraCrypto era))
-> Set (TxIn (EraCrypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals (EraCrypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> Set (KeyHash 'Witness (EraCrypto era))
-> MultiAsset (EraCrypto era)
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
-> StrictMaybe Network
-> AlonzoTxBodyRaw era
AlonzoTxBodyRaw Set (TxIn (EraCrypto era))
i Set (TxIn (EraCrypto era))
ifee StrictSeq (TxOut era)
o StrictSeq (TxCert era)
c Withdrawals (EraCrypto era)
w Coin
f (StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval StrictMaybe SlotNo
b StrictMaybe SlotNo
t) StrictMaybe (Update era)
u Set (KeyHash 'Witness (EraCrypto era))
rsh MultiAsset (EraCrypto era)
mi StrictMaybe (ScriptIntegrityHash (EraCrypto era))
sh StrictMaybe (AuxiliaryDataHash (EraCrypto era))
ah StrictMaybe Network
ni
          )
          forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
0 (forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set (TxIn (EraCrypto era))
atbrInputs)
          forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
13 (forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set (TxIn (EraCrypto era))
atbrCollateral))
          forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
1 (forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictSeq (TxOut era)
atbrOutputs)
          forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
2 (forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
atbrTxFee)
          forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall a.
EncCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
3 StrictMaybe SlotNo
top
          forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
4 (forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictSeq (TxCert era)
atbrCerts))
          forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Withdrawals c -> Map (RewardAcnt c) Coin
unWithdrawals) (forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
5 (forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Withdrawals (EraCrypto era)
atbrWithdrawals))
          forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall a.
EncCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
6 StrictMaybe (Update era)
atbrUpdate
          forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall a.
EncCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
8 StrictMaybe SlotNo
bot
          forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
14 (forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set (KeyHash 'Witness (EraCrypto era))
atbrReqSignerHashes))
          forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit (forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty) (forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
9 (forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To MultiAsset (EraCrypto era)
atbrMint))
          forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall a.
EncCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
11 StrictMaybe (ScriptIntegrityHash (EraCrypto era))
atbrScriptIntegrityHash
          forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall a.
EncCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
7 StrictMaybe (AuxiliaryDataHash (EraCrypto era))
atbrAuxDataHash
          forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall a.
EncCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
15 StrictMaybe Network
atbrTxNetworkId

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

emptyAlonzoTxBodyRaw :: AlonzoTxBodyRaw era
emptyAlonzoTxBodyRaw :: forall era. AlonzoTxBodyRaw era
emptyAlonzoTxBodyRaw =
  forall era.
Set (TxIn (EraCrypto era))
-> Set (TxIn (EraCrypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals (EraCrypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> Set (KeyHash 'Witness (EraCrypto era))
-> MultiAsset (EraCrypto era)
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
-> StrictMaybe Network
-> AlonzoTxBodyRaw era
AlonzoTxBodyRaw
    forall a. Monoid a => a
mempty
    forall a. Monoid a => a
mempty
    forall a. StrictSeq a
StrictSeq.empty
    forall a. StrictSeq a
StrictSeq.empty
    (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall a. Monoid a => a
mempty)
    forall a. Monoid a => a
mempty
    (StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval forall a. StrictMaybe a
SNothing forall a. StrictMaybe a
SNothing)
    forall a. StrictMaybe a
SNothing
    forall a. Monoid a => a
mempty
    forall a. Monoid a => a
mempty
    forall a. StrictMaybe a
SNothing
    forall a. StrictMaybe a
SNothing
    forall a. StrictMaybe a
SNothing

instance
  (Era era, DecCBOR (TxOut era), DecCBOR (TxCert era), DecCBOR (PParamsUpdate era)) =>
  DecCBOR (Annotator (AlonzoTxBodyRaw era))
  where
  decCBOR :: forall s. Decoder s (Annotator (AlonzoTxBodyRaw era))
decCBOR = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR

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 (EraCrypto era))
txIn ->
    forall (f :: * -> * -> *) era.
f Word32 (TxIn (EraCrypto era)) -> AlonzoPlutusPurpose f era
AlonzoSpending forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall elem container.
Indexable elem container =>
AsItem Word32 elem -> container -> StrictMaybe (AsIx Word32 elem)
indexOf AsItem Word32 (TxIn (EraCrypto era))
txIn (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
inputsTxBodyL)
  AlonzoMinting AsItem Word32 (PolicyID (EraCrypto era))
policyID ->
    forall (f :: * -> * -> *) era.
f Word32 (PolicyID (EraCrypto era)) -> AlonzoPlutusPurpose f era
AlonzoMinting forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall elem container.
Indexable elem container =>
AsItem Word32 elem -> container -> StrictMaybe (AsIx Word32 elem)
indexOf AsItem Word32 (PolicyID (EraCrypto era))
policyID (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
MaryEraTxBody era =>
SimpleGetter (TxBody era) (Set (PolicyID (EraCrypto era)))
mintedTxBodyF :: Set (PolicyID (EraCrypto era)))
  AlonzoCertifying AsItem Word32 (TxCert era)
txCert ->
    forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> AlonzoPlutusPurpose f era
AlonzoCertifying forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall elem container.
Indexable elem container =>
AsItem Word32 elem -> container -> StrictMaybe (AsIx Word32 elem)
indexOf AsItem Word32 (TxCert era)
txCert (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL)
  AlonzoRewarding AsItem Word32 (RewardAccount (EraCrypto era))
rewardAccount ->
    forall (f :: * -> * -> *) era.
f Word32 (RewardAccount (EraCrypto era))
-> AlonzoPlutusPurpose f era
AlonzoRewarding forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall elem container.
Indexable elem container =>
AsItem Word32 elem -> container -> StrictMaybe (AsIx Word32 elem)
indexOf AsItem Word32 (RewardAccount (EraCrypto era))
rewardAccount (forall c. Withdrawals c -> Map (RewardAcnt c) Coin
unWithdrawals (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (Withdrawals (EraCrypto era))
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 (EraCrypto era))
idx ->
    forall (f :: * -> * -> *) era.
f Word32 (TxIn (EraCrypto era)) -> AlonzoPlutusPurpose f era
AlonzoSpending forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall elem container.
Indexable elem container =>
AsIx Word32 elem -> container -> StrictMaybe (AsIxItem Word32 elem)
fromIndex AsIx Word32 (TxIn (EraCrypto era))
idx (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
inputsTxBodyL)
  AlonzoMinting AsIx Word32 (PolicyID (EraCrypto era))
idx ->
    forall (f :: * -> * -> *) era.
f Word32 (PolicyID (EraCrypto era)) -> AlonzoPlutusPurpose f era
AlonzoMinting forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall elem container.
Indexable elem container =>
AsIx Word32 elem -> container -> StrictMaybe (AsIxItem Word32 elem)
fromIndex AsIx Word32 (PolicyID (EraCrypto era))
idx (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
MaryEraTxBody era =>
SimpleGetter (TxBody era) (Set (PolicyID (EraCrypto era)))
mintedTxBodyF)
  AlonzoCertifying AsIx Word32 (TxCert era)
idx ->
    forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> AlonzoPlutusPurpose f era
AlonzoCertifying forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall elem container.
Indexable elem container =>
AsIx Word32 elem -> container -> StrictMaybe (AsIxItem Word32 elem)
fromIndex AsIx Word32 (TxCert era)
idx (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL)
  AlonzoRewarding AsIx Word32 (RewardAccount (EraCrypto era))
idx ->
    forall (f :: * -> * -> *) era.
f Word32 (RewardAccount (EraCrypto era))
-> AlonzoPlutusPurpose f era
AlonzoRewarding forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall elem container.
Indexable elem container =>
AsIx Word32 elem -> container -> StrictMaybe (AsIxItem Word32 elem)
fromIndex AsIx Word32 (RewardAccount (EraCrypto era))
idx (forall c. Withdrawals c -> Map (RewardAcnt c) Coin
unWithdrawals (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (Withdrawals (EraCrypto era))
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 forall a. Ord a => a -> Set a -> Maybe Int
Set.lookupIndex k
n Set k
s of
    Just Int
x -> forall a. a -> StrictMaybe a
SJust (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 -> 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 forall a. Ord a => a -> a -> Bool
< forall a. Set a -> Int
Set.size Set k
s
          then forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ forall ix it. ix -> it -> AsIxItem ix it
AsIxItem Word32
w32 (forall a. Int -> Set a -> a
Set.elemAt Int
i Set k
s)
          else 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 forall a. (a -> Bool) -> StrictSeq a -> Maybe Int
StrictSeq.findIndexL (forall a. Eq a => a -> a -> Bool
== k
n) StrictSeq k
seqx of
    Just Int
m -> forall a. a -> StrictMaybe a
SJust (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 -> forall a. StrictMaybe a
SNothing
  fromIndex :: AsIx Word32 k -> StrictSeq k -> StrictMaybe (AsIxItem Word32 k)
fromIndex (AsIx Word32
w32) StrictSeq k
seqx =
    case 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 -> forall a. StrictMaybe a
SNothing
      Just k
x -> forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ 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 forall k a. Ord k => k -> Map k a -> Maybe Int
Map.lookupIndex k
n Map k v
mp of
    Just Int
x -> forall a. a -> StrictMaybe a
SJust (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 -> 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 forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall k a. Map k a -> Int
Map.size Map k v
mp)
          then forall a. a -> StrictMaybe a
SJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ix it. ix -> it -> AsIxItem ix it
AsIxItem Word32
w32 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall k a. Int -> Map k a -> (k, a)
Map.elemAt Int
i Map k v
mp
          else 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 = forall elem container.
Indexable elem container =>
AsItem Word32 elem -> container -> StrictMaybe (AsIx Word32 elem)
indexOf AsItem Word32 k
asItem forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. OSet a -> StrictSeq a
OSet.toStrictSeq
  fromIndex :: AsIx Word32 k -> OSet k -> StrictMaybe (AsIxItem Word32 k)
fromIndex AsIx Word32 k
asIndex = forall elem container.
Indexable elem container =>
AsIx Word32 elem -> container -> StrictMaybe (AsIxItem Word32 elem)
fromIndex AsIx Word32 k
asIndex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. OSet a -> StrictSeq a
OSet.toStrictSeq