{-# 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 ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}

module Cardano.Ledger.Alonzo.TxBody
  ( TxOut (.., TxOut, TxOutCompact, TxOutCompactDH),
    -- Constructors are not exported for safety:
    Addr28Extra,
    DataHash32,
    TxBody
      ( TxBody,
        inputs,
        collateral,
        outputs,
        txcerts,
        txwdrls,
        txfee,
        txvldt,
        txUpdates,
        reqSignerHashes,
        mint,
        scriptIntegrityHash,
        adHash,
        txnetworkid
      ),
    inputs',
    collateral',
    outputs',
    certs',
    wdrls',
    txfee',
    vldt',
    update',
    reqSignerHashes',
    mint',
    scriptIntegrityHash',
    adHash',
    txnetworkid',
    getAdaOnly,
    decodeDataHash32,
    encodeDataHash32,
    encodeAddress28,
    decodeAddress28,
    viewCompactTxOut,
    viewTxOut,
    AlonzoBody,
    EraIndependentScriptIntegrity,
    ScriptIntegrityHash,
    getAlonzoTxOutEitherAddr,
  )
where

import Cardano.Binary
  ( DecoderError (..),
    FromCBOR (..),
    ToCBOR (..),
    decodeBreakOr,
    decodeListLenOrIndef,
    encodeListLen,
  )
import Cardano.Crypto.Hash
import Cardano.Ledger.Address (Addr (..))
import Cardano.Ledger.Alonzo.Data (AuxiliaryDataHash (..), DataHash)
import Cardano.Ledger.Alonzo.Scripts (Script)
import Cardano.Ledger.BaseTypes
  ( Network (..),
    StrictMaybe (..),
    maybeToStrictMaybe,
  )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.CompactAddress
  ( CompactAddr,
    compactAddr,
    decompactAddr,
    fromCborBackwardsBothAddr,
  )
import Cardano.Ledger.Compactible
import Cardano.Ledger.Core (PParamsDelta)
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Credential (Credential (..), PaymentCredential, StakeReference (..))
import qualified Cardano.Ledger.Crypto as CC
import Cardano.Ledger.Era (Era (Crypto))
import Cardano.Ledger.Hashes
  ( EraIndependentScriptIntegrity,
    EraIndependentTxBody,
  )
import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..))
import Cardano.Ledger.Mary.Value (Value (..), policies, policyID)
import qualified Cardano.Ledger.Mary.Value as Mary
import Cardano.Ledger.SafeHash
  ( HashAnnotated,
    SafeHash,
    SafeToHash,
    extractHash,
    unsafeMakeSafeHash,
  )
import Cardano.Ledger.Shelley.Delegation.Certificates (DCert)
import Cardano.Ledger.Shelley.PParams (Update)
import Cardano.Ledger.Shelley.Scripts (ScriptHash (..))
import Cardano.Ledger.Shelley.TxBody (Wdrl (Wdrl), unWdrl)
import Cardano.Ledger.ShelleyMA.Timelocks (ValidityInterval (..))
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.Ledger.Val
  ( DecodeNonNegative,
    Val (..),
    decodeMint,
    decodeNonNegative,
    encodeMint,
    isZero,
  )
import Control.DeepSeq (NFData (..), rwhnf)
import Control.Monad (guard, (<$!>))
import Data.Bits
import Data.Coders
import Data.Maybe (fromMaybe)
import Data.MemoBytes (Mem, MemoBytes (..), memoBytes)
import Data.Sequence.Strict (StrictSeq)
import qualified Data.Sequence.Strict as StrictSeq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Sharing
import Data.Typeable (Proxy (..), Typeable, (:~:) (Refl))
import Data.Word
import GHC.Generics (Generic)
import GHC.Records (HasField (..))
import GHC.Stack (HasCallStack)
import GHC.TypeLits
import NoThunks.Class (InspectHeapNamed (..), NoThunks)
import Prelude hiding (lookup)

data Addr28Extra
  = Addr28Extra
      {-# UNPACK #-} !Word64 -- Payment Addr
      {-# UNPACK #-} !Word64 -- Payment Addr
      {-# UNPACK #-} !Word64 -- Payment Addr
      {-# UNPACK #-} !Word64 -- Payment Addr (32bits) + ... +  0/1 for Testnet/Mainnet + 0/1 Script/Pubkey
  deriving (Addr28Extra -> Addr28Extra -> Bool
(Addr28Extra -> Addr28Extra -> Bool)
-> (Addr28Extra -> Addr28Extra -> Bool) -> Eq Addr28Extra
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Addr28Extra -> Addr28Extra -> Bool
$c/= :: Addr28Extra -> Addr28Extra -> Bool
== :: Addr28Extra -> Addr28Extra -> Bool
$c== :: Addr28Extra -> Addr28Extra -> Bool
Eq)

data DataHash32
  = DataHash32
      {-# UNPACK #-} !Word64 -- DataHash
      {-# UNPACK #-} !Word64 -- DataHash
      {-# UNPACK #-} !Word64 -- DataHash
      {-# UNPACK #-} !Word64 -- DataHash
  deriving (DataHash32 -> DataHash32 -> Bool
(DataHash32 -> DataHash32 -> Bool)
-> (DataHash32 -> DataHash32 -> Bool) -> Eq DataHash32
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataHash32 -> DataHash32 -> Bool
$c/= :: DataHash32 -> DataHash32 -> Bool
== :: DataHash32 -> DataHash32 -> Bool
$c== :: DataHash32 -> DataHash32 -> Bool
Eq)

data TxOut era
  = TxOutCompact'
      {-# UNPACK #-} !(CompactAddr (Crypto era))
      !(CompactForm (Core.Value era))
  | TxOutCompactDH'
      {-# UNPACK #-} !(CompactAddr (Crypto era))
      !(CompactForm (Core.Value era))
      !(DataHash (Crypto era))
  | TxOut_AddrHash28_AdaOnly
      !(Credential 'Staking (Crypto era))
      {-# UNPACK #-} !Addr28Extra
      {-# UNPACK #-} !(CompactForm Coin) -- Ada value
  | TxOut_AddrHash28_AdaOnly_DataHash32
      !(Credential 'Staking (Crypto era))
      {-# UNPACK #-} !Addr28Extra
      {-# UNPACK #-} !(CompactForm Coin) -- Ada value
      {-# UNPACK #-} !DataHash32

deriving stock instance
  ( Eq (Core.Value era),
    Compactible (Core.Value era)
  ) =>
  Eq (TxOut era)

-- | Already in NF
instance NFData (TxOut era) where
  rnf :: TxOut era -> ()
rnf = TxOut era -> ()
forall a. a -> ()
rwhnf

getAdaOnly ::
  forall era.
  Val (Core.Value era) =>
  Proxy era ->
  Core.Value era ->
  Maybe (CompactForm Coin)
getAdaOnly :: Proxy era -> Value era -> Maybe (CompactForm Coin)
getAdaOnly Proxy era
_ Value era
v = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Value era -> Bool
forall t. Val t => t -> Bool
isAdaOnly Value era
v
  Coin -> Maybe (CompactForm Coin)
forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact (Coin -> Maybe (CompactForm Coin))
-> Coin -> Maybe (CompactForm Coin)
forall a b. (a -> b) -> a -> b
$ Value era -> Coin
forall t. Val t => t -> Coin
coin Value era
v

decodeAddress28 ::
  forall crypto.
  HashAlgorithm (CC.ADDRHASH crypto) =>
  Credential 'Staking crypto ->
  Addr28Extra ->
  Maybe (Addr crypto)
decodeAddress28 :: Credential 'Staking crypto -> Addr28Extra -> Maybe (Addr crypto)
decodeAddress28 Credential 'Staking crypto
stakeRef (Addr28Extra Word64
a Word64
b Word64
c Word64
d) = do
  SizeHash (ADDRHASH crypto) :~: 28
Refl <- Proxy (SizeHash (ADDRHASH crypto))
-> Proxy 28 -> Maybe (SizeHash (ADDRHASH crypto) :~: 28)
forall (a :: Nat) (b :: Nat).
(KnownNat a, KnownNat b) =>
Proxy a -> Proxy b -> Maybe (a :~: b)
sameNat (Proxy (SizeHash (ADDRHASH crypto))
forall k (t :: k). Proxy t
Proxy @(SizeHash (CC.ADDRHASH crypto))) (Proxy 28
forall k (t :: k). Proxy t
Proxy @28)
  let network :: Network
network = if Word64
d Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
1 then Network
Mainnet else Network
Testnet
      paymentCred :: Credential 'Payment crypto
paymentCred =
        if Word64
d Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
0
          then KeyHash 'Payment crypto -> Credential 'Payment crypto
forall (kr :: KeyRole) crypto.
KeyHash kr crypto -> Credential kr crypto
KeyHashObj (Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
-> KeyHash 'Payment crypto
forall (discriminator :: KeyRole) crypto.
Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
-> KeyHash discriminator crypto
KeyHash Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
forall a. Hash (ADDRHASH crypto) a
addrHash)
          else ScriptHash crypto -> Credential 'Payment crypto
forall (kr :: KeyRole) crypto.
ScriptHash crypto -> Credential kr crypto
ScriptHashObj (Hash (ADDRHASH crypto) EraIndependentScript -> ScriptHash crypto
forall crypto.
Hash (ADDRHASH crypto) EraIndependentScript -> ScriptHash crypto
ScriptHash Hash (ADDRHASH crypto) EraIndependentScript
forall a. Hash (ADDRHASH crypto) a
addrHash)
      addrHash :: Hash (CC.ADDRHASH crypto) a
      addrHash :: Hash (ADDRHASH crypto) a
addrHash =
        PackedBytes (SizeHash (ADDRHASH crypto))
-> Hash (ADDRHASH crypto) a
forall h a. PackedBytes (SizeHash h) -> Hash h a
hashFromPackedBytes (PackedBytes (SizeHash (ADDRHASH crypto))
 -> Hash (ADDRHASH crypto) a)
-> PackedBytes (SizeHash (ADDRHASH crypto))
-> Hash (ADDRHASH crypto) a
forall a b. (a -> b) -> a -> b
$
          Word64 -> Word64 -> Word64 -> Word32 -> PackedBytes 28
PackedBytes28 Word64
a Word64
b Word64
c (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
d Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32))
  Addr crypto -> Maybe (Addr crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Addr crypto -> Maybe (Addr crypto))
-> Addr crypto -> Maybe (Addr crypto)
forall a b. (a -> b) -> a -> b
$! Network
-> Credential 'Payment crypto
-> StakeReference crypto
-> Addr crypto
forall crypto.
Network
-> PaymentCredential crypto -> StakeReference crypto -> Addr crypto
Addr Network
network Credential 'Payment crypto
paymentCred (Credential 'Staking crypto -> StakeReference crypto
forall crypto. StakeCredential crypto -> StakeReference crypto
StakeRefBase Credential 'Staking crypto
stakeRef)

encodeAddress28 ::
  forall crypto.
  HashAlgorithm (CC.ADDRHASH crypto) =>
  Network ->
  PaymentCredential crypto ->
  Maybe (SizeHash (CC.ADDRHASH crypto) :~: 28, Addr28Extra)
encodeAddress28 :: Network
-> PaymentCredential crypto
-> Maybe (SizeHash (ADDRHASH crypto) :~: 28, Addr28Extra)
encodeAddress28 Network
network PaymentCredential crypto
paymentCred = do
  let networkBit, payCredTypeBit :: Word64
      networkBit :: Word64
networkBit =
        case Network
network of
          Network
Mainnet -> Word64
0 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`setBit` Int
1
          Network
Testnet -> Word64
0
      payCredTypeBit :: Word64
payCredTypeBit =
        case PaymentCredential crypto
paymentCred of
          KeyHashObj {} -> Word64
0 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`setBit` Int
0
          ScriptHashObj {} -> Word64
0
      encodeAddr ::
        Hash (CC.ADDRHASH crypto) a ->
        Maybe (SizeHash (CC.ADDRHASH crypto) :~: 28, Addr28Extra)
      encodeAddr :: Hash (ADDRHASH crypto) a
-> Maybe (SizeHash (ADDRHASH crypto) :~: 28, Addr28Extra)
encodeAddr Hash (ADDRHASH crypto) a
h = do
        refl :: SizeHash (ADDRHASH crypto) :~: 28
refl@SizeHash (ADDRHASH crypto) :~: 28
Refl <- Proxy (SizeHash (ADDRHASH crypto))
-> Proxy 28 -> Maybe (SizeHash (ADDRHASH crypto) :~: 28)
forall (a :: Nat) (b :: Nat).
(KnownNat a, KnownNat b) =>
Proxy a -> Proxy b -> Maybe (a :~: b)
sameNat (Proxy (SizeHash (ADDRHASH crypto))
forall k (t :: k). Proxy t
Proxy @(SizeHash (CC.ADDRHASH crypto))) (Proxy 28
forall k (t :: k). Proxy t
Proxy @28)
        case Hash (ADDRHASH crypto) a
-> PackedBytes (SizeHash (ADDRHASH crypto))
forall h a. Hash h a -> PackedBytes (SizeHash h)
hashToPackedBytes Hash (ADDRHASH crypto) a
h of
          PackedBytes28 Word64
a Word64
b Word64
c Word32
d ->
            let d' :: Word64
d' = (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
d Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
networkBit Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
payCredTypeBit
             in (SizeHash (ADDRHASH crypto) :~: 28, Addr28Extra)
-> Maybe (SizeHash (ADDRHASH crypto) :~: 28, Addr28Extra)
forall a. a -> Maybe a
Just (SizeHash (ADDRHASH crypto) :~: 28
refl, Word64 -> Word64 -> Word64 -> Word64 -> Addr28Extra
Addr28Extra Word64
a Word64
b Word64
c Word64
d')
          PackedBytes (SizeHash (ADDRHASH crypto))
_ -> Maybe (SizeHash (ADDRHASH crypto) :~: 28, Addr28Extra)
forall a. Maybe a
Nothing
  case PaymentCredential crypto
paymentCred of
    KeyHashObj (KeyHash Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
addrHash) -> Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
-> Maybe (SizeHash (ADDRHASH crypto) :~: 28, Addr28Extra)
forall a.
Hash (ADDRHASH crypto) a
-> Maybe (SizeHash (ADDRHASH crypto) :~: 28, Addr28Extra)
encodeAddr Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
addrHash
    ScriptHashObj (ScriptHash Hash (ADDRHASH crypto) EraIndependentScript
addrHash) -> Hash (ADDRHASH crypto) EraIndependentScript
-> Maybe (SizeHash (ADDRHASH crypto) :~: 28, Addr28Extra)
forall a.
Hash (ADDRHASH crypto) a
-> Maybe (SizeHash (ADDRHASH crypto) :~: 28, Addr28Extra)
encodeAddr Hash (ADDRHASH crypto) EraIndependentScript
addrHash

decodeDataHash32 ::
  forall crypto.
  HashAlgorithm (CC.HASH crypto) =>
  DataHash32 ->
  Maybe (DataHash crypto)
decodeDataHash32 :: DataHash32 -> Maybe (DataHash crypto)
decodeDataHash32 (DataHash32 Word64
a Word64
b Word64
c Word64
d) = do
  SizeHash (HASH crypto) :~: 32
Refl <- Proxy (SizeHash (HASH crypto))
-> Proxy 32 -> Maybe (SizeHash (HASH crypto) :~: 32)
forall (a :: Nat) (b :: Nat).
(KnownNat a, KnownNat b) =>
Proxy a -> Proxy b -> Maybe (a :~: b)
sameNat (Proxy (SizeHash (HASH crypto))
forall k (t :: k). Proxy t
Proxy @(SizeHash (CC.HASH crypto))) (Proxy 32
forall k (t :: k). Proxy t
Proxy @32)
  DataHash crypto -> Maybe (DataHash crypto)
forall a. a -> Maybe a
Just (DataHash crypto -> Maybe (DataHash crypto))
-> DataHash crypto -> Maybe (DataHash crypto)
forall a b. (a -> b) -> a -> b
$! Hash (HASH crypto) EraIndependentData -> DataHash crypto
forall crypto index.
Hash (HASH crypto) index -> SafeHash crypto index
unsafeMakeSafeHash (Hash (HASH crypto) EraIndependentData -> DataHash crypto)
-> Hash (HASH crypto) EraIndependentData -> DataHash crypto
forall a b. (a -> b) -> a -> b
$ PackedBytes (SizeHash (HASH crypto))
-> Hash (HASH crypto) EraIndependentData
forall h a. PackedBytes (SizeHash h) -> Hash h a
hashFromPackedBytes (PackedBytes (SizeHash (HASH crypto))
 -> Hash (HASH crypto) EraIndependentData)
-> PackedBytes (SizeHash (HASH crypto))
-> Hash (HASH crypto) EraIndependentData
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64 -> Word64 -> PackedBytes 32
PackedBytes32 Word64
a Word64
b Word64
c Word64
d

encodeDataHash32 ::
  forall crypto.
  (HashAlgorithm (CC.HASH crypto)) =>
  DataHash crypto ->
  Maybe (SizeHash (CC.HASH crypto) :~: 32, DataHash32)
encodeDataHash32 :: DataHash crypto
-> Maybe (SizeHash (HASH crypto) :~: 32, DataHash32)
encodeDataHash32 DataHash crypto
dataHash = do
  refl :: SizeHash (HASH crypto) :~: 32
refl@SizeHash (HASH crypto) :~: 32
Refl <- Proxy (SizeHash (HASH crypto))
-> Proxy 32 -> Maybe (SizeHash (HASH crypto) :~: 32)
forall (a :: Nat) (b :: Nat).
(KnownNat a, KnownNat b) =>
Proxy a -> Proxy b -> Maybe (a :~: b)
sameNat (Proxy (SizeHash (HASH crypto))
forall k (t :: k). Proxy t
Proxy @(SizeHash (CC.HASH crypto))) (Proxy 32
forall k (t :: k). Proxy t
Proxy @32)
  case Hash (HASH crypto) EraIndependentData
-> PackedBytes (SizeHash (HASH crypto))
forall h a. Hash h a -> PackedBytes (SizeHash h)
hashToPackedBytes (DataHash crypto -> Hash (HASH crypto) EraIndependentData
forall crypto i. SafeHash crypto i -> Hash (HASH crypto) i
extractHash DataHash crypto
dataHash) of
    PackedBytes32 Word64
a Word64
b Word64
c Word64
d -> (SizeHash (HASH crypto) :~: 32, DataHash32)
-> Maybe (SizeHash (HASH crypto) :~: 32, DataHash32)
forall a. a -> Maybe a
Just (SizeHash (HASH crypto) :~: 32
refl, Word64 -> Word64 -> Word64 -> Word64 -> DataHash32
DataHash32 Word64
a Word64
b Word64
c Word64
d)
    PackedBytes (SizeHash (HASH crypto))
_ -> Maybe (SizeHash (HASH crypto) :~: 32, DataHash32)
forall a. Maybe a
Nothing

viewCompactTxOut ::
  forall era.
  Era era =>
  TxOut era ->
  (CompactAddr (Crypto era), CompactForm (Core.Value era), StrictMaybe (DataHash (Crypto era)))
viewCompactTxOut :: TxOut era
-> (CompactAddr (Crypto era), CompactForm (Value era),
    StrictMaybe (DataHash (Crypto era)))
viewCompactTxOut TxOut era
txOut = case TxOut era
txOut of
  TxOutCompact' CompactAddr (Crypto era)
addr CompactForm (Value era)
val -> (CompactAddr (Crypto era)
addr, CompactForm (Value era)
val, StrictMaybe (DataHash (Crypto era))
forall a. StrictMaybe a
SNothing)
  TxOutCompactDH' CompactAddr (Crypto era)
addr CompactForm (Value era)
val DataHash (Crypto era)
dh -> (CompactAddr (Crypto era)
addr, CompactForm (Value era)
val, DataHash (Crypto era) -> StrictMaybe (DataHash (Crypto era))
forall a. a -> StrictMaybe a
SJust DataHash (Crypto era)
dh)
  TxOut_AddrHash28_AdaOnly Credential 'Staking (Crypto era)
stakeRef Addr28Extra
addr28Extra CompactForm Coin
adaVal
    | Just Addr (Crypto era)
addr <- Credential 'Staking (Crypto era)
-> Addr28Extra -> Maybe (Addr (Crypto era))
forall crypto.
HashAlgorithm (ADDRHASH crypto) =>
Credential 'Staking crypto -> Addr28Extra -> Maybe (Addr crypto)
decodeAddress28 Credential 'Staking (Crypto era)
stakeRef Addr28Extra
addr28Extra ->
        (Addr (Crypto era) -> CompactAddr (Crypto era)
forall crypto. Addr crypto -> CompactAddr crypto
compactAddr Addr (Crypto era)
addr, CompactForm Coin -> CompactForm (Value era)
forall t. Val t => CompactForm Coin -> CompactForm t
injectCompact CompactForm Coin
adaVal, StrictMaybe (DataHash (Crypto era))
forall a. StrictMaybe a
SNothing)
    | Bool
otherwise -> [Char]
-> (CompactAddr (Crypto era), CompactForm (Value era),
    StrictMaybe (DataHash (Crypto era)))
forall a. HasCallStack => [Char] -> a
error [Char]
addressErrorMsg
  TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking (Crypto era)
stakeRef Addr28Extra
addr28Extra CompactForm Coin
adaVal DataHash32
dataHash32
    | Just Addr (Crypto era)
addr <- Credential 'Staking (Crypto era)
-> Addr28Extra -> Maybe (Addr (Crypto era))
forall crypto.
HashAlgorithm (ADDRHASH crypto) =>
Credential 'Staking crypto -> Addr28Extra -> Maybe (Addr crypto)
decodeAddress28 Credential 'Staking (Crypto era)
stakeRef Addr28Extra
addr28Extra,
      Just DataHash (Crypto era)
dh <- DataHash32 -> Maybe (DataHash (Crypto era))
forall crypto.
HashAlgorithm (HASH crypto) =>
DataHash32 -> Maybe (DataHash crypto)
decodeDataHash32 DataHash32
dataHash32 ->
        (Addr (Crypto era) -> CompactAddr (Crypto era)
forall crypto. Addr crypto -> CompactAddr crypto
compactAddr Addr (Crypto era)
addr, CompactForm Coin -> CompactForm (Value era)
forall t. Val t => CompactForm Coin -> CompactForm t
injectCompact CompactForm Coin
adaVal, DataHash (Crypto era) -> StrictMaybe (DataHash (Crypto era))
forall a. a -> StrictMaybe a
SJust DataHash (Crypto era)
dh)
    | Bool
otherwise -> [Char]
-> (CompactAddr (Crypto era), CompactForm (Value era),
    StrictMaybe (DataHash (Crypto era)))
forall a. HasCallStack => [Char] -> a
error [Char]
addressErrorMsg

viewTxOut ::
  forall era.
  Era era =>
  TxOut era ->
  (Addr (Crypto era), Core.Value era, StrictMaybe (DataHash (Crypto era)))
viewTxOut :: TxOut era
-> (Addr (Crypto era), Value era,
    StrictMaybe (DataHash (Crypto era)))
viewTxOut (TxOutCompact' CompactAddr (Crypto era)
bs CompactForm (Value era)
c) = (Addr (Crypto era)
addr, Value era
val, StrictMaybe (DataHash (Crypto era))
forall a. StrictMaybe a
SNothing)
  where
    addr :: Addr (Crypto era)
addr = CompactAddr (Crypto era) -> Addr (Crypto era)
forall crypto. Crypto crypto => CompactAddr crypto -> Addr crypto
decompactAddr CompactAddr (Crypto era)
bs
    val :: Value era
val = CompactForm (Value era) -> Value era
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm (Value era)
c
viewTxOut (TxOutCompactDH' CompactAddr (Crypto era)
bs CompactForm (Value era)
c DataHash (Crypto era)
dh) = (Addr (Crypto era)
addr, Value era
val, DataHash (Crypto era) -> StrictMaybe (DataHash (Crypto era))
forall a. a -> StrictMaybe a
SJust DataHash (Crypto era)
dh)
  where
    addr :: Addr (Crypto era)
addr = CompactAddr (Crypto era) -> Addr (Crypto era)
forall crypto. Crypto crypto => CompactAddr crypto -> Addr crypto
decompactAddr CompactAddr (Crypto era)
bs
    val :: Value era
val = CompactForm (Value era) -> Value era
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm (Value era)
c
viewTxOut (TxOut_AddrHash28_AdaOnly Credential 'Staking (Crypto era)
stakeRef Addr28Extra
addr28Extra CompactForm Coin
adaVal)
  | Just Addr (Crypto era)
addr <- Credential 'Staking (Crypto era)
-> Addr28Extra -> Maybe (Addr (Crypto era))
forall crypto.
HashAlgorithm (ADDRHASH crypto) =>
Credential 'Staking crypto -> Addr28Extra -> Maybe (Addr crypto)
decodeAddress28 Credential 'Staking (Crypto era)
stakeRef Addr28Extra
addr28Extra =
      (Addr (Crypto era)
addr, Coin -> Value era
forall t. Val t => Coin -> t
inject (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
adaVal), StrictMaybe (DataHash (Crypto era))
forall a. StrictMaybe a
SNothing)
viewTxOut (TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking (Crypto era)
stakeRef Addr28Extra
addr28Extra CompactForm Coin
adaVal DataHash32
dataHash32)
  | Just Addr (Crypto era)
addr <- Credential 'Staking (Crypto era)
-> Addr28Extra -> Maybe (Addr (Crypto era))
forall crypto.
HashAlgorithm (ADDRHASH crypto) =>
Credential 'Staking crypto -> Addr28Extra -> Maybe (Addr crypto)
decodeAddress28 Credential 'Staking (Crypto era)
stakeRef Addr28Extra
addr28Extra,
    Just DataHash (Crypto era)
dh <- DataHash32 -> Maybe (DataHash (Crypto era))
forall crypto.
HashAlgorithm (HASH crypto) =>
DataHash32 -> Maybe (DataHash crypto)
decodeDataHash32 DataHash32
dataHash32 =
      (Addr (Crypto era)
addr, Coin -> Value era
forall t. Val t => Coin -> t
inject (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
adaVal), DataHash (Crypto era) -> StrictMaybe (DataHash (Crypto era))
forall a. a -> StrictMaybe a
SJust DataHash (Crypto era)
dh)
viewTxOut TxOut_AddrHash28_AdaOnly {} = [Char]
-> (Addr (Crypto era), Value era,
    StrictMaybe (DataHash (Crypto era)))
forall a. HasCallStack => [Char] -> a
error [Char]
addressErrorMsg
viewTxOut TxOut_AddrHash28_AdaOnly_DataHash32 {} = [Char]
-> (Addr (Crypto era), Value era,
    StrictMaybe (DataHash (Crypto era)))
forall a. HasCallStack => [Char] -> a
error [Char]
addressErrorMsg

instance
  ( Era era,
    Show (Core.Value era),
    Show (CompactForm (Core.Value era))
  ) =>
  Show (TxOut era)
  where
  show :: TxOut era -> [Char]
show = (Addr (Crypto era), Value era, StrictMaybe (DataHash (Crypto era)))
-> [Char]
forall a. Show a => a -> [Char]
show ((Addr (Crypto era), Value era,
  StrictMaybe (DataHash (Crypto era)))
 -> [Char])
-> (TxOut era
    -> (Addr (Crypto era), Value era,
        StrictMaybe (DataHash (Crypto era))))
-> TxOut era
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut era
-> (Addr (Crypto era), Value era,
    StrictMaybe (DataHash (Crypto era)))
forall era.
Era era =>
TxOut era
-> (Addr (Crypto era), Value era,
    StrictMaybe (DataHash (Crypto era)))
viewTxOut

deriving via InspectHeapNamed "TxOut" (TxOut era) instance NoThunks (TxOut era)

pattern TxOut ::
  forall era.
  ( Era era,
    Compactible (Core.Value era),
    Val (Core.Value era),
    HasCallStack
  ) =>
  Addr (Crypto era) ->
  Core.Value era ->
  StrictMaybe (DataHash (Crypto era)) ->
  TxOut era
pattern $bTxOut :: Addr (Crypto era)
-> Value era -> StrictMaybe (DataHash (Crypto era)) -> TxOut era
$mTxOut :: forall r era.
(Era era, Compactible (Value era), Val (Value era),
 HasCallStack) =>
TxOut era
-> (Addr (Crypto era)
    -> Value era -> StrictMaybe (DataHash (Crypto era)) -> r)
-> (Void# -> r)
-> r
TxOut addr vl dh <-
  (viewTxOut -> (addr, vl, dh))
  where
    TxOut (Addr Network
network PaymentCredential (Crypto era)
paymentCred StakeReference (Crypto era)
stakeRef) Value era
vl StrictMaybe (DataHash (Crypto era))
SNothing
      | StakeRefBase StakeCredential (Crypto era)
stakeCred <- StakeReference (Crypto era)
stakeRef,
        Just CompactForm Coin
adaCompact <- Proxy era -> Value era -> Maybe (CompactForm Coin)
forall era.
Val (Value era) =>
Proxy era -> Value era -> Maybe (CompactForm Coin)
getAdaOnly (Proxy era
forall k (t :: k). Proxy t
Proxy @era) Value era
vl,
        Just (SizeHash (ADDRHASH (Crypto era)) :~: 28
Refl, Addr28Extra
addr28Extra) <- Network
-> PaymentCredential (Crypto era)
-> Maybe (SizeHash (ADDRHASH (Crypto era)) :~: 28, Addr28Extra)
forall crypto.
HashAlgorithm (ADDRHASH crypto) =>
Network
-> PaymentCredential crypto
-> Maybe (SizeHash (ADDRHASH crypto) :~: 28, Addr28Extra)
encodeAddress28 Network
network PaymentCredential (Crypto era)
paymentCred =
          StakeCredential (Crypto era)
-> Addr28Extra -> CompactForm Coin -> TxOut era
forall era.
Credential 'Staking (Crypto era)
-> Addr28Extra -> CompactForm Coin -> TxOut era
TxOut_AddrHash28_AdaOnly StakeCredential (Crypto era)
stakeCred Addr28Extra
addr28Extra CompactForm Coin
adaCompact
    TxOut (Addr Network
network PaymentCredential (Crypto era)
paymentCred StakeReference (Crypto era)
stakeRef) Value era
vl (SJust DataHash (Crypto era)
dh)
      | StakeRefBase StakeCredential (Crypto era)
stakeCred <- StakeReference (Crypto era)
stakeRef,
        Just CompactForm Coin
adaCompact <- Proxy era -> Value era -> Maybe (CompactForm Coin)
forall era.
Val (Value era) =>
Proxy era -> Value era -> Maybe (CompactForm Coin)
getAdaOnly (Proxy era
forall k (t :: k). Proxy t
Proxy @era) Value era
vl,
        Just (SizeHash (ADDRHASH (Crypto era)) :~: 28
Refl, Addr28Extra
addr28Extra) <- Network
-> PaymentCredential (Crypto era)
-> Maybe (SizeHash (ADDRHASH (Crypto era)) :~: 28, Addr28Extra)
forall crypto.
HashAlgorithm (ADDRHASH crypto) =>
Network
-> PaymentCredential crypto
-> Maybe (SizeHash (ADDRHASH crypto) :~: 28, Addr28Extra)
encodeAddress28 Network
network PaymentCredential (Crypto era)
paymentCred,
        Just (SizeHash (HASH (Crypto era)) :~: 32
Refl, DataHash32
dataHash32) <- DataHash (Crypto era)
-> Maybe (SizeHash (HASH (Crypto era)) :~: 32, DataHash32)
forall crypto.
HashAlgorithm (HASH crypto) =>
DataHash crypto
-> Maybe (SizeHash (HASH crypto) :~: 32, DataHash32)
encodeDataHash32 DataHash (Crypto era)
dh =
          StakeCredential (Crypto era)
-> Addr28Extra -> CompactForm Coin -> DataHash32 -> TxOut era
forall era.
Credential 'Staking (Crypto era)
-> Addr28Extra -> CompactForm Coin -> DataHash32 -> TxOut era
TxOut_AddrHash28_AdaOnly_DataHash32 StakeCredential (Crypto era)
stakeCred Addr28Extra
addr28Extra CompactForm Coin
adaCompact DataHash32
dataHash32
    TxOut Addr (Crypto era)
addr Value era
vl StrictMaybe (DataHash (Crypto era))
mdh =
      let v :: CompactForm (Value era)
v = CompactForm (Value era)
-> Maybe (CompactForm (Value era)) -> CompactForm (Value era)
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> CompactForm (Value era)
forall a. HasCallStack => [Char] -> a
error [Char]
"Illegal value in txout") (Maybe (CompactForm (Value era)) -> CompactForm (Value era))
-> Maybe (CompactForm (Value era)) -> CompactForm (Value era)
forall a b. (a -> b) -> a -> b
$ Value era -> Maybe (CompactForm (Value era))
forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact Value era
vl
          a :: CompactAddr (Crypto era)
a = Addr (Crypto era) -> CompactAddr (Crypto era)
forall crypto. Addr crypto -> CompactAddr crypto
compactAddr Addr (Crypto era)
addr
       in case StrictMaybe (DataHash (Crypto era))
mdh of
            StrictMaybe (DataHash (Crypto era))
SNothing -> CompactAddr (Crypto era) -> CompactForm (Value era) -> TxOut era
forall era.
CompactAddr (Crypto era) -> CompactForm (Value era) -> TxOut era
TxOutCompact' CompactAddr (Crypto era)
a CompactForm (Value era)
v
            SJust DataHash (Crypto era)
dh -> CompactAddr (Crypto era)
-> CompactForm (Value era) -> DataHash (Crypto era) -> TxOut era
forall era.
CompactAddr (Crypto era)
-> CompactForm (Value era) -> DataHash (Crypto era) -> TxOut era
TxOutCompactDH' CompactAddr (Crypto era)
a CompactForm (Value era)
v DataHash (Crypto era)
dh

{-# COMPLETE TxOut #-}

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

type ScriptIntegrityHash crypto = SafeHash crypto EraIndependentScriptIntegrity

data TxBodyRaw era = TxBodyRaw
  { TxBodyRaw era -> Set (TxIn (Crypto era))
_inputs :: !(Set (TxIn (Crypto era))),
    TxBodyRaw era -> Set (TxIn (Crypto era))
_collateral :: !(Set (TxIn (Crypto era))),
    TxBodyRaw era -> StrictSeq (TxOut era)
_outputs :: !(StrictSeq (TxOut era)),
    TxBodyRaw era -> StrictSeq (DCert (Crypto era))
_certs :: !(StrictSeq (DCert (Crypto era))),
    TxBodyRaw era -> Wdrl (Crypto era)
_wdrls :: !(Wdrl (Crypto era)),
    TxBodyRaw era -> Coin
_txfee :: !Coin,
    TxBodyRaw era -> ValidityInterval
_vldt :: !ValidityInterval,
    TxBodyRaw era -> StrictMaybe (Update era)
_update :: !(StrictMaybe (Update era)),
    TxBodyRaw era -> Set (KeyHash 'Witness (Crypto era))
_reqSignerHashes :: Set (KeyHash 'Witness (Crypto era)),
    TxBodyRaw era -> Value (Crypto era)
_mint :: !(Value (Crypto era)),
    -- The spec makes it clear that the mint field is a
    -- Cardano.Ledger.Mary.Value.Value, not a Core.Value.
    -- Operations on the TxBody in the AlonzoEra depend upon this.
    TxBodyRaw era -> StrictMaybe (ScriptIntegrityHash (Crypto era))
_scriptIntegrityHash :: !(StrictMaybe (ScriptIntegrityHash (Crypto era))),
    TxBodyRaw era -> StrictMaybe (AuxiliaryDataHash (Crypto era))
_adHash :: !(StrictMaybe (AuxiliaryDataHash (Crypto era))),
    TxBodyRaw era -> StrictMaybe Network
_txnetworkid :: !(StrictMaybe Network)
  }
  deriving ((forall x. TxBodyRaw era -> Rep (TxBodyRaw era) x)
-> (forall x. Rep (TxBodyRaw era) x -> TxBodyRaw era)
-> Generic (TxBodyRaw era)
forall x. Rep (TxBodyRaw era) x -> TxBodyRaw era
forall x. TxBodyRaw era -> Rep (TxBodyRaw era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (TxBodyRaw era) x -> TxBodyRaw era
forall era x. TxBodyRaw era -> Rep (TxBodyRaw era) x
$cto :: forall era x. Rep (TxBodyRaw era) x -> TxBodyRaw era
$cfrom :: forall era x. TxBodyRaw era -> Rep (TxBodyRaw era) x
Generic, Typeable)

deriving instance
  ( Eq (Core.Value era),
    CC.Crypto (Crypto era),
    Compactible (Core.Value era),
    Eq (PParamsDelta era)
  ) =>
  Eq (TxBodyRaw era)

instance
  (Typeable era, NoThunks (Core.Value era), NoThunks (PParamsDelta era)) =>
  NoThunks (TxBodyRaw era)

instance
  (CC.Crypto (Crypto era), Typeable era, NFData (Core.Value era), NFData (PParamsDelta era)) =>
  NFData (TxBodyRaw era)

deriving instance
  ( Era era,
    Show (Core.Value era),
    Show (PParamsDelta era)
  ) =>
  Show (TxBodyRaw era)

newtype TxBody era = TxBodyConstr (MemoBytes (TxBodyRaw era))
  deriving (Typeable (TxBody era)
Typeable (TxBody era)
-> (TxBody era -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (TxBody era) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [TxBody era] -> Size)
-> ToCBOR (TxBody era)
TxBody era -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TxBody era] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (TxBody era) -> Size
forall era. Typeable era => Typeable (TxBody era)
forall era. Typeable era => TxBody 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 [TxBody era] -> Size
forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (TxBody era) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TxBody era] -> Size
$cencodedListSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TxBody era] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (TxBody era) -> Size
$cencodedSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (TxBody era) -> Size
toCBOR :: TxBody era -> Encoding
$ctoCBOR :: forall era. Typeable era => TxBody era -> Encoding
$cp1ToCBOR :: forall era. Typeable era => Typeable (TxBody era)
ToCBOR)
  deriving newtype (Proxy c -> Proxy index -> TxBody era -> SafeHash c index
TxBody era -> ByteString
(TxBody era -> ByteString)
-> (forall c index.
    HasAlgorithm c =>
    Proxy c -> Proxy index -> TxBody era -> SafeHash c index)
-> SafeToHash (TxBody era)
forall era. TxBody era -> ByteString
forall t.
(t -> ByteString)
-> (forall c index.
    HasAlgorithm c =>
    Proxy c -> Proxy index -> t -> SafeHash c index)
-> SafeToHash t
forall c index.
HasAlgorithm c =>
Proxy c -> Proxy index -> TxBody era -> SafeHash c index
forall era c index.
HasAlgorithm c =>
Proxy c -> Proxy index -> TxBody era -> SafeHash c index
makeHashWithExplicitProxys :: Proxy c -> Proxy index -> TxBody era -> SafeHash c index
$cmakeHashWithExplicitProxys :: forall era c index.
HasAlgorithm c =>
Proxy c -> Proxy index -> TxBody era -> SafeHash c index
originalBytes :: TxBody era -> ByteString
$coriginalBytes :: forall era. TxBody era -> ByteString
SafeToHash)

deriving newtype instance CC.Crypto (Crypto era) => Eq (TxBody era)

deriving instance
  ( Typeable era,
    NoThunks (Core.Value era),
    NoThunks (PParamsDelta era)
  ) =>
  NoThunks (TxBody era)

deriving instance
  (CC.Crypto (Crypto era), Typeable era, NFData (Core.Value era), NFData (PParamsDelta era)) =>
  NFData (TxBody era)

deriving instance
  ( Era era,
    Compactible (Core.Value era),
    Show (Core.Value era),
    Show (PParamsDelta era)
  ) =>
  Show (TxBody era)

deriving via
  (Mem (TxBodyRaw era))
  instance
    ( Era era,
      Typeable (Core.Script era),
      Typeable (Core.AuxiliaryData era),
      Compactible (Core.Value era),
      Show (Core.Value era),
      DecodeNonNegative (Core.Value era),
      FromCBOR (Annotator (Core.Script era)),
      Core.SerialisableData (PParamsDelta era)
    ) =>
    FromCBOR (Annotator (TxBody era))

-- The Set of constraints necessary to use the TxBody pattern
type AlonzoBody era =
  ( Era era,
    Compactible (Core.Value era),
    ToCBOR (Core.Script era),
    Core.SerialisableData (PParamsDelta era)
  )

pattern TxBody ::
  AlonzoBody era =>
  Set (TxIn (Crypto era)) ->
  Set (TxIn (Crypto era)) ->
  StrictSeq (TxOut era) ->
  StrictSeq (DCert (Crypto era)) ->
  Wdrl (Crypto era) ->
  Coin ->
  ValidityInterval ->
  StrictMaybe (Update era) ->
  Set (KeyHash 'Witness (Crypto era)) ->
  Value (Crypto era) ->
  StrictMaybe (ScriptIntegrityHash (Crypto era)) ->
  StrictMaybe (AuxiliaryDataHash (Crypto era)) ->
  StrictMaybe Network ->
  TxBody era
pattern $bTxBody :: Set (TxIn (Crypto era))
-> Set (TxIn (Crypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (DCert (Crypto era))
-> Wdrl (Crypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> Set (KeyHash 'Witness (Crypto era))
-> Value (Crypto era)
-> StrictMaybe (ScriptIntegrityHash (Crypto era))
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> StrictMaybe Network
-> TxBody era
$mTxBody :: forall r era.
AlonzoBody era =>
TxBody era
-> (Set (TxIn (Crypto era))
    -> Set (TxIn (Crypto era))
    -> StrictSeq (TxOut era)
    -> StrictSeq (DCert (Crypto era))
    -> Wdrl (Crypto era)
    -> Coin
    -> ValidityInterval
    -> StrictMaybe (Update era)
    -> Set (KeyHash 'Witness (Crypto era))
    -> Value (Crypto era)
    -> StrictMaybe (ScriptIntegrityHash (Crypto era))
    -> StrictMaybe (AuxiliaryDataHash (Crypto era))
    -> StrictMaybe Network
    -> r)
-> (Void# -> r)
-> r
TxBody
  { TxBody era -> AlonzoBody era => Set (TxIn (Crypto era))
inputs,
    TxBody era -> AlonzoBody era => Set (TxIn (Crypto era))
collateral,
    TxBody era -> AlonzoBody era => StrictSeq (TxOut era)
outputs,
    TxBody era -> AlonzoBody era => StrictSeq (DCert (Crypto era))
txcerts,
    TxBody era -> AlonzoBody era => Wdrl (Crypto era)
txwdrls,
    TxBody era -> AlonzoBody era => Coin
txfee,
    TxBody era -> AlonzoBody era => ValidityInterval
txvldt,
    TxBody era -> AlonzoBody era => StrictMaybe (Update era)
txUpdates,
    TxBody era -> AlonzoBody era => Set (KeyHash 'Witness (Crypto era))
reqSignerHashes,
    TxBody era -> AlonzoBody era => Value (Crypto era)
mint,
    TxBody era
-> AlonzoBody era => StrictMaybe (ScriptIntegrityHash (Crypto era))
scriptIntegrityHash,
    TxBody era
-> AlonzoBody era => StrictMaybe (AuxiliaryDataHash (Crypto era))
adHash,
    TxBody era -> AlonzoBody era => StrictMaybe Network
txnetworkid
  } <-
  TxBodyConstr
    ( Memo
        TxBodyRaw
          { _inputs = inputs,
            _collateral = collateral,
            _outputs = outputs,
            _certs = txcerts,
            _wdrls = txwdrls,
            _txfee = txfee,
            _vldt = txvldt,
            _update = txUpdates,
            _reqSignerHashes = reqSignerHashes,
            _mint = mint,
            _scriptIntegrityHash = scriptIntegrityHash,
            _adHash = adHash,
            _txnetworkid = txnetworkid
          }
        _
      )
  where
    TxBody
      Set (TxIn (Crypto era))
inputsX
      Set (TxIn (Crypto era))
collateralX
      StrictSeq (TxOut era)
outputsX
      StrictSeq (DCert (Crypto era))
certsX
      Wdrl (Crypto era)
wdrlsX
      Coin
txfeeX
      ValidityInterval
vldtX
      StrictMaybe (Update era)
updateX
      Set (KeyHash 'Witness (Crypto era))
reqSignerHashesX
      Value (Crypto era)
mintX
      StrictMaybe (ScriptIntegrityHash (Crypto era))
scriptIntegrityHashX
      StrictMaybe (AuxiliaryDataHash (Crypto era))
adHashX
      StrictMaybe Network
txnetworkidX =
        MemoBytes (TxBodyRaw era) -> TxBody era
forall era. MemoBytes (TxBodyRaw era) -> TxBody era
TxBodyConstr (MemoBytes (TxBodyRaw era) -> TxBody era)
-> MemoBytes (TxBodyRaw era) -> TxBody era
forall a b. (a -> b) -> a -> b
$
          Encode ('Closed 'Sparse) (TxBodyRaw era)
-> MemoBytes (TxBodyRaw era)
forall (w :: Wrapped) t. Encode w t -> MemoBytes t
memoBytes
            ( TxBodyRaw era -> Encode ('Closed 'Sparse) (TxBodyRaw era)
forall era.
(Era era, ToCBOR (PParamsDelta era)) =>
TxBodyRaw era -> Encode ('Closed 'Sparse) (TxBodyRaw era)
encodeTxBodyRaw (TxBodyRaw era -> Encode ('Closed 'Sparse) (TxBodyRaw era))
-> TxBodyRaw era -> Encode ('Closed 'Sparse) (TxBodyRaw era)
forall a b. (a -> b) -> a -> b
$
                Set (TxIn (Crypto era))
-> Set (TxIn (Crypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (DCert (Crypto era))
-> Wdrl (Crypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> Set (KeyHash 'Witness (Crypto era))
-> Value (Crypto era)
-> StrictMaybe (ScriptIntegrityHash (Crypto era))
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> StrictMaybe Network
-> TxBodyRaw era
forall era.
Set (TxIn (Crypto era))
-> Set (TxIn (Crypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (DCert (Crypto era))
-> Wdrl (Crypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> Set (KeyHash 'Witness (Crypto era))
-> Value (Crypto era)
-> StrictMaybe (ScriptIntegrityHash (Crypto era))
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> StrictMaybe Network
-> TxBodyRaw era
TxBodyRaw
                  Set (TxIn (Crypto era))
inputsX
                  Set (TxIn (Crypto era))
collateralX
                  StrictSeq (TxOut era)
outputsX
                  StrictSeq (DCert (Crypto era))
certsX
                  Wdrl (Crypto era)
wdrlsX
                  Coin
txfeeX
                  ValidityInterval
vldtX
                  StrictMaybe (Update era)
updateX
                  Set (KeyHash 'Witness (Crypto era))
reqSignerHashesX
                  Value (Crypto era)
mintX
                  StrictMaybe (ScriptIntegrityHash (Crypto era))
scriptIntegrityHashX
                  StrictMaybe (AuxiliaryDataHash (Crypto era))
adHashX
                  StrictMaybe Network
txnetworkidX
            )

{-# COMPLETE TxBody #-}

instance (c ~ Crypto era) => HashAnnotated (TxBody era) EraIndependentTxBody c

-- ==============================================================================
-- 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 era -> Set (TxIn (Crypto era))
collateral' :: TxBody era -> Set (TxIn (Crypto era))
outputs' :: TxBody era -> StrictSeq (TxOut era)
certs' :: TxBody era -> StrictSeq (DCert (Crypto era))
txfee' :: TxBody era -> Coin
wdrls' :: TxBody era -> Wdrl (Crypto era)
vldt' :: TxBody era -> ValidityInterval
update' :: TxBody era -> StrictMaybe (Update era)
reqSignerHashes' :: TxBody era -> Set (KeyHash 'Witness (Crypto era))
adHash' :: TxBody era -> StrictMaybe (AuxiliaryDataHash (Crypto era))
mint' :: TxBody era -> Value (Crypto era)
scriptIntegrityHash' :: TxBody era -> StrictMaybe (ScriptIntegrityHash (Crypto era))
inputs' :: TxBody era -> Set (TxIn (Crypto era))
inputs' (TxBodyConstr (Memo TxBodyRaw era
raw ShortByteString
_)) = TxBodyRaw era -> Set (TxIn (Crypto era))
forall era. TxBodyRaw era -> Set (TxIn (Crypto era))
_inputs TxBodyRaw era
raw

txnetworkid' :: TxBody era -> StrictMaybe Network

collateral' :: TxBody era -> Set (TxIn (Crypto era))
collateral' (TxBodyConstr (Memo TxBodyRaw era
raw ShortByteString
_)) = TxBodyRaw era -> Set (TxIn (Crypto era))
forall era. TxBodyRaw era -> Set (TxIn (Crypto era))
_collateral TxBodyRaw era
raw

outputs' :: TxBody era -> StrictSeq (TxOut era)
outputs' (TxBodyConstr (Memo TxBodyRaw era
raw ShortByteString
_)) = TxBodyRaw era -> StrictSeq (TxOut era)
forall era. TxBodyRaw era -> StrictSeq (TxOut era)
_outputs TxBodyRaw era
raw

certs' :: TxBody era -> StrictSeq (DCert (Crypto era))
certs' (TxBodyConstr (Memo TxBodyRaw era
raw ShortByteString
_)) = TxBodyRaw era -> StrictSeq (DCert (Crypto era))
forall era. TxBodyRaw era -> StrictSeq (DCert (Crypto era))
_certs TxBodyRaw era
raw

wdrls' :: TxBody era -> Wdrl (Crypto era)
wdrls' (TxBodyConstr (Memo TxBodyRaw era
raw ShortByteString
_)) = TxBodyRaw era -> Wdrl (Crypto era)
forall era. TxBodyRaw era -> Wdrl (Crypto era)
_wdrls TxBodyRaw era
raw

txfee' :: TxBody era -> Coin
txfee' (TxBodyConstr (Memo TxBodyRaw era
raw ShortByteString
_)) = TxBodyRaw era -> Coin
forall era. TxBodyRaw era -> Coin
_txfee TxBodyRaw era
raw

vldt' :: TxBody era -> ValidityInterval
vldt' (TxBodyConstr (Memo TxBodyRaw era
raw ShortByteString
_)) = TxBodyRaw era -> ValidityInterval
forall era. TxBodyRaw era -> ValidityInterval
_vldt TxBodyRaw era
raw

update' :: TxBody era -> StrictMaybe (Update era)
update' (TxBodyConstr (Memo TxBodyRaw era
raw ShortByteString
_)) = TxBodyRaw era -> StrictMaybe (Update era)
forall era. TxBodyRaw era -> StrictMaybe (Update era)
_update TxBodyRaw era
raw

reqSignerHashes' :: TxBody era -> Set (KeyHash 'Witness (Crypto era))
reqSignerHashes' (TxBodyConstr (Memo TxBodyRaw era
raw ShortByteString
_)) = TxBodyRaw era -> Set (KeyHash 'Witness (Crypto era))
forall era. TxBodyRaw era -> Set (KeyHash 'Witness (Crypto era))
_reqSignerHashes TxBodyRaw era
raw

adHash' :: TxBody era -> StrictMaybe (AuxiliaryDataHash (Crypto era))
adHash' (TxBodyConstr (Memo TxBodyRaw era
raw ShortByteString
_)) = TxBodyRaw era -> StrictMaybe (AuxiliaryDataHash (Crypto era))
forall era.
TxBodyRaw era -> StrictMaybe (AuxiliaryDataHash (Crypto era))
_adHash TxBodyRaw era
raw

mint' :: TxBody era -> Value (Crypto era)
mint' (TxBodyConstr (Memo TxBodyRaw era
raw ShortByteString
_)) = TxBodyRaw era -> Value (Crypto era)
forall era. TxBodyRaw era -> Value (Crypto era)
_mint TxBodyRaw era
raw

scriptIntegrityHash' :: TxBody era -> StrictMaybe (ScriptIntegrityHash (Crypto era))
scriptIntegrityHash' (TxBodyConstr (Memo TxBodyRaw era
raw ShortByteString
_)) = TxBodyRaw era -> StrictMaybe (ScriptIntegrityHash (Crypto era))
forall era.
TxBodyRaw era -> StrictMaybe (ScriptIntegrityHash (Crypto era))
_scriptIntegrityHash TxBodyRaw era
raw

txnetworkid' :: TxBody era -> StrictMaybe Network
txnetworkid' (TxBodyConstr (Memo TxBodyRaw era
raw ShortByteString
_)) = TxBodyRaw era -> StrictMaybe Network
forall era. TxBodyRaw era -> StrictMaybe Network
_txnetworkid TxBodyRaw era
raw

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

instance
  ( Era era,
    Compactible (Core.Value era)
  ) =>
  ToCBOR (TxOut era)
  where
  toCBOR :: TxOut era -> Encoding
toCBOR (TxOutCompact CompactAddr (Crypto era)
addr CompactForm (Value era)
cv) =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CompactAddr (Crypto era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR CompactAddr (Crypto era)
addr
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CompactForm (Value era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR CompactForm (Value era)
cv
  toCBOR (TxOutCompactDH CompactAddr (Crypto era)
addr CompactForm (Value era)
cv DataHash (Crypto era)
dh) =
    Word -> Encoding
encodeListLen Word
3
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CompactAddr (Crypto era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR CompactAddr (Crypto era)
addr
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CompactForm (Value era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR CompactForm (Value era)
cv
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> DataHash (Crypto era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR DataHash (Crypto era)
dh

instance
  ( Era era,
    DecodeNonNegative (Core.Value era),
    Show (Core.Value era),
    Compactible (Core.Value era)
  ) =>
  FromCBOR (TxOut era)
  where
  fromCBOR :: Decoder s (TxOut era)
fromCBOR = Decoder s (TxOut era)
forall a s. FromSharedCBOR a => Decoder s a
fromNotSharedCBOR
  {-# INLINE fromCBOR #-}

instance
  ( Era era,
    DecodeNonNegative (Core.Value era),
    Show (Core.Value era),
    Compactible (Core.Value era)
  ) =>
  FromSharedCBOR (TxOut era)
  where
  type Share (TxOut era) = Interns (Credential 'Staking (Crypto era))
  fromSharedCBOR :: Share (TxOut era) -> Decoder s (TxOut era)
fromSharedCBOR Share (TxOut era)
credsInterns = do
    Maybe Int
lenOrIndef <- Decoder s (Maybe Int)
forall s. Decoder s (Maybe Int)
decodeListLenOrIndef
    let internTxOut :: TxOut era -> TxOut era
internTxOut = \case
          TxOut_AddrHash28_AdaOnly Credential 'Staking (Crypto era)
cred Addr28Extra
addr28Extra CompactForm Coin
ada ->
            Credential 'Staking (Crypto era)
-> Addr28Extra -> CompactForm Coin -> TxOut era
forall era.
Credential 'Staking (Crypto era)
-> Addr28Extra -> CompactForm Coin -> TxOut era
TxOut_AddrHash28_AdaOnly (Interns (Credential 'Staking (Crypto era))
-> Credential 'Staking (Crypto era)
-> Credential 'Staking (Crypto era)
forall k. Interns k -> k -> k
interns Interns (Credential 'Staking (Crypto era))
Share (TxOut era)
credsInterns Credential 'Staking (Crypto era)
cred) Addr28Extra
addr28Extra CompactForm Coin
ada
          TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking (Crypto era)
cred Addr28Extra
addr28Extra CompactForm Coin
ada DataHash32
dataHash32 ->
            Credential 'Staking (Crypto era)
-> Addr28Extra -> CompactForm Coin -> DataHash32 -> TxOut era
forall era.
Credential 'Staking (Crypto era)
-> Addr28Extra -> CompactForm Coin -> DataHash32 -> TxOut era
TxOut_AddrHash28_AdaOnly_DataHash32 (Interns (Credential 'Staking (Crypto era))
-> Credential 'Staking (Crypto era)
-> Credential 'Staking (Crypto era)
forall k. Interns k -> k -> k
interns Interns (Credential 'Staking (Crypto era))
Share (TxOut era)
credsInterns Credential 'Staking (Crypto era)
cred) Addr28Extra
addr28Extra CompactForm Coin
ada DataHash32
dataHash32
          TxOut era
txOut -> TxOut era
txOut
    TxOut era -> TxOut era
internTxOut (TxOut era -> TxOut era)
-> Decoder s (TxOut era) -> Decoder s (TxOut era)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> case Maybe Int
lenOrIndef of
      Maybe Int
Nothing -> do
        (Addr (Crypto era)
a, CompactAddr (Crypto era)
ca) <- Decoder s (Addr (Crypto era), CompactAddr (Crypto era))
forall crypto s.
Crypto crypto =>
Decoder s (Addr crypto, CompactAddr crypto)
fromCborBackwardsBothAddr
        CompactForm (Value era)
cv <- Decoder s (CompactForm (Value era))
forall v s. DecodeNonNegative v => Decoder s v
decodeNonNegative
        Decoder s Bool
forall s. Decoder s Bool
decodeBreakOr Decoder s Bool
-> (Bool -> Decoder s (TxOut era)) -> Decoder s (TxOut era)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Bool
True -> TxOut era -> Decoder s (TxOut era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut era -> Decoder s (TxOut era))
-> TxOut era -> Decoder s (TxOut era)
forall a b. (a -> b) -> a -> b
$ Addr (Crypto era)
-> CompactAddr (Crypto era)
-> CompactForm (Value era)
-> StrictMaybe (DataHash (Crypto era))
-> TxOut era
forall era.
(Era era, HasCallStack) =>
Addr (Crypto era)
-> CompactAddr (Crypto era)
-> CompactForm (Value era)
-> StrictMaybe (DataHash (Crypto era))
-> TxOut era
mkTxOutCompact Addr (Crypto era)
a CompactAddr (Crypto era)
ca CompactForm (Value era)
cv StrictMaybe (DataHash (Crypto era))
forall a. StrictMaybe a
SNothing
          Bool
False -> do
            DataHash (Crypto era)
dh <- Decoder s (DataHash (Crypto era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
            Decoder s Bool
forall s. Decoder s Bool
decodeBreakOr Decoder s Bool
-> (Bool -> Decoder s (TxOut era)) -> Decoder s (TxOut era)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Bool
True -> TxOut era -> Decoder s (TxOut era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut era -> Decoder s (TxOut era))
-> TxOut era -> Decoder s (TxOut era)
forall a b. (a -> b) -> a -> b
$ Addr (Crypto era)
-> CompactAddr (Crypto era)
-> CompactForm (Value era)
-> StrictMaybe (DataHash (Crypto era))
-> TxOut era
forall era.
(Era era, HasCallStack) =>
Addr (Crypto era)
-> CompactAddr (Crypto era)
-> CompactForm (Value era)
-> StrictMaybe (DataHash (Crypto era))
-> TxOut era
mkTxOutCompact Addr (Crypto era)
a CompactAddr (Crypto era)
ca CompactForm (Value era)
cv (DataHash (Crypto era) -> StrictMaybe (DataHash (Crypto era))
forall a. a -> StrictMaybe a
SJust DataHash (Crypto era)
dh)
              Bool
False -> DecoderError -> Decoder s (TxOut era)
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s (TxOut era))
-> DecoderError -> Decoder s (TxOut era)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
"txout" Text
"Excess terms in txout"
      Just Int
2 -> do
        (Addr (Crypto era)
a, CompactAddr (Crypto era)
ca) <- Decoder s (Addr (Crypto era), CompactAddr (Crypto era))
forall crypto s.
Crypto crypto =>
Decoder s (Addr crypto, CompactAddr crypto)
fromCborBackwardsBothAddr
        CompactForm (Value era)
cv <- Decoder s (CompactForm (Value era))
forall v s. DecodeNonNegative v => Decoder s v
decodeNonNegative
        TxOut era -> Decoder s (TxOut era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut era -> Decoder s (TxOut era))
-> TxOut era -> Decoder s (TxOut era)
forall a b. (a -> b) -> a -> b
$ Addr (Crypto era)
-> CompactAddr (Crypto era)
-> CompactForm (Value era)
-> StrictMaybe (DataHash (Crypto era))
-> TxOut era
forall era.
(Era era, HasCallStack) =>
Addr (Crypto era)
-> CompactAddr (Crypto era)
-> CompactForm (Value era)
-> StrictMaybe (DataHash (Crypto era))
-> TxOut era
mkTxOutCompact Addr (Crypto era)
a CompactAddr (Crypto era)
ca CompactForm (Value era)
cv StrictMaybe (DataHash (Crypto era))
forall a. StrictMaybe a
SNothing
      Just Int
3 -> do
        (Addr (Crypto era)
a, CompactAddr (Crypto era)
ca) <- Decoder s (Addr (Crypto era), CompactAddr (Crypto era))
forall crypto s.
Crypto crypto =>
Decoder s (Addr crypto, CompactAddr crypto)
fromCborBackwardsBothAddr
        CompactForm (Value era)
cv <- Decoder s (CompactForm (Value era))
forall v s. DecodeNonNegative v => Decoder s v
decodeNonNegative
        Addr (Crypto era)
-> CompactAddr (Crypto era)
-> CompactForm (Value era)
-> StrictMaybe (DataHash (Crypto era))
-> TxOut era
forall era.
(Era era, HasCallStack) =>
Addr (Crypto era)
-> CompactAddr (Crypto era)
-> CompactForm (Value era)
-> StrictMaybe (DataHash (Crypto era))
-> TxOut era
mkTxOutCompact Addr (Crypto era)
a CompactAddr (Crypto era)
ca CompactForm (Value era)
cv (StrictMaybe (DataHash (Crypto era)) -> TxOut era)
-> (DataHash (Crypto era) -> StrictMaybe (DataHash (Crypto era)))
-> DataHash (Crypto era)
-> TxOut era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataHash (Crypto era) -> StrictMaybe (DataHash (Crypto era))
forall a. a -> StrictMaybe a
SJust (DataHash (Crypto era) -> TxOut era)
-> Decoder s (DataHash (Crypto era)) -> Decoder s (TxOut era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (DataHash (Crypto era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Just Int
_ -> DecoderError -> Decoder s (TxOut era)
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s (TxOut era))
-> DecoderError -> Decoder s (TxOut era)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
"txout" Text
"wrong number of terms in txout"
  {-# INLINE fromSharedCBOR #-}

pattern TxOutCompact ::
  ( Era era,
    Val (Core.Value era),
    HasCallStack
  ) =>
  CompactAddr (Crypto era) ->
  CompactForm (Core.Value era) ->
  TxOut era
pattern $bTxOutCompact :: CompactAddr (Crypto era) -> CompactForm (Value era) -> TxOut era
$mTxOutCompact :: forall r era.
(Era era, Val (Value era), HasCallStack) =>
TxOut era
-> (CompactAddr (Crypto era) -> CompactForm (Value era) -> r)
-> (Void# -> r)
-> r
TxOutCompact addr vl <-
  (viewCompactTxOut -> (addr, vl, SNothing))
  where
    TxOutCompact CompactAddr (Crypto era)
cAddr CompactForm (Value era)
cVal = Addr (Crypto era)
-> CompactAddr (Crypto era)
-> CompactForm (Value era)
-> StrictMaybe (DataHash (Crypto era))
-> TxOut era
forall era.
(Era era, HasCallStack) =>
Addr (Crypto era)
-> CompactAddr (Crypto era)
-> CompactForm (Value era)
-> StrictMaybe (DataHash (Crypto era))
-> TxOut era
mkTxOutCompact (CompactAddr (Crypto era) -> Addr (Crypto era)
forall crypto. Crypto crypto => CompactAddr crypto -> Addr crypto
decompactAddr CompactAddr (Crypto era)
cAddr) CompactAddr (Crypto era)
cAddr CompactForm (Value era)
cVal StrictMaybe (DataHash (Crypto era))
forall a. StrictMaybe a
SNothing

pattern TxOutCompactDH ::
  forall era.
  ( Era era,
    HasCallStack
  ) =>
  CompactAddr (Crypto era) ->
  CompactForm (Core.Value era) ->
  DataHash (Crypto era) ->
  TxOut era
pattern $bTxOutCompactDH :: CompactAddr (Crypto era)
-> CompactForm (Value era) -> DataHash (Crypto era) -> TxOut era
$mTxOutCompactDH :: forall r era.
(Era era, HasCallStack) =>
TxOut era
-> (CompactAddr (Crypto era)
    -> CompactForm (Value era) -> DataHash (Crypto era) -> r)
-> (Void# -> r)
-> r
TxOutCompactDH addr vl dh <-
  (viewCompactTxOut -> (addr, vl, SJust dh))
  where
    TxOutCompactDH CompactAddr (Crypto era)
cAddr CompactForm (Value era)
cVal DataHash (Crypto era)
dh = Addr (Crypto era)
-> CompactAddr (Crypto era)
-> CompactForm (Value era)
-> StrictMaybe (DataHash (Crypto era))
-> TxOut era
forall era.
(Era era, HasCallStack) =>
Addr (Crypto era)
-> CompactAddr (Crypto era)
-> CompactForm (Value era)
-> StrictMaybe (DataHash (Crypto era))
-> TxOut era
mkTxOutCompact (CompactAddr (Crypto era) -> Addr (Crypto era)
forall crypto. Crypto crypto => CompactAddr crypto -> Addr crypto
decompactAddr CompactAddr (Crypto era)
cAddr) CompactAddr (Crypto era)
cAddr CompactForm (Value era)
cVal (DataHash (Crypto era) -> StrictMaybe (DataHash (Crypto era))
forall a. a -> StrictMaybe a
SJust DataHash (Crypto era)
dh)

{-# COMPLETE TxOutCompact, TxOutCompactDH #-}

mkTxOutCompact ::
  forall era.
  (Era era, HasCallStack) =>
  Addr (Crypto era) ->
  CompactAddr (Crypto era) ->
  CompactForm (Core.Value era) ->
  StrictMaybe (DataHash (Crypto era)) ->
  TxOut era
mkTxOutCompact :: Addr (Crypto era)
-> CompactAddr (Crypto era)
-> CompactForm (Value era)
-> StrictMaybe (DataHash (Crypto era))
-> TxOut era
mkTxOutCompact Addr (Crypto era)
addr CompactAddr (Crypto era)
cAddr CompactForm (Value era)
cVal StrictMaybe (DataHash (Crypto era))
mdh
  | CompactForm (Value era) -> Bool
forall t. Val t => CompactForm t -> Bool
isAdaOnlyCompact CompactForm (Value era)
cVal = Addr (Crypto era)
-> Value era -> StrictMaybe (DataHash (Crypto era)) -> TxOut era
forall era.
(Era era, Compactible (Value era), Val (Value era),
 HasCallStack) =>
Addr (Crypto era)
-> Value era -> StrictMaybe (DataHash (Crypto era)) -> TxOut era
TxOut Addr (Crypto era)
addr (CompactForm (Value era) -> Value era
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm (Value era)
cVal) StrictMaybe (DataHash (Crypto era))
mdh
  | SJust DataHash (Crypto era)
dh <- StrictMaybe (DataHash (Crypto era))
mdh = CompactAddr (Crypto era)
-> CompactForm (Value era) -> DataHash (Crypto era) -> TxOut era
forall era.
CompactAddr (Crypto era)
-> CompactForm (Value era) -> DataHash (Crypto era) -> TxOut era
TxOutCompactDH' CompactAddr (Crypto era)
cAddr CompactForm (Value era)
cVal DataHash (Crypto era)
dh
  | Bool
otherwise = CompactAddr (Crypto era) -> CompactForm (Value era) -> TxOut era
forall era.
CompactAddr (Crypto era) -> CompactForm (Value era) -> TxOut era
TxOutCompact' CompactAddr (Crypto era)
cAddr CompactForm (Value era)
cVal

encodeTxBodyRaw ::
  ( Era era,
    ToCBOR (PParamsDelta era)
  ) =>
  TxBodyRaw era ->
  Encode ('Closed 'Sparse) (TxBodyRaw era)
encodeTxBodyRaw :: TxBodyRaw era -> Encode ('Closed 'Sparse) (TxBodyRaw era)
encodeTxBodyRaw
  TxBodyRaw
    { Set (TxIn (Crypto era))
_inputs :: Set (TxIn (Crypto era))
_inputs :: forall era. TxBodyRaw era -> Set (TxIn (Crypto era))
_inputs,
      Set (TxIn (Crypto era))
_collateral :: Set (TxIn (Crypto era))
_collateral :: forall era. TxBodyRaw era -> Set (TxIn (Crypto era))
_collateral,
      StrictSeq (TxOut era)
_outputs :: StrictSeq (TxOut era)
_outputs :: forall era. TxBodyRaw era -> StrictSeq (TxOut era)
_outputs,
      StrictSeq (DCert (Crypto era))
_certs :: StrictSeq (DCert (Crypto era))
_certs :: forall era. TxBodyRaw era -> StrictSeq (DCert (Crypto era))
_certs,
      Wdrl (Crypto era)
_wdrls :: Wdrl (Crypto era)
_wdrls :: forall era. TxBodyRaw era -> Wdrl (Crypto era)
_wdrls,
      Coin
_txfee :: Coin
_txfee :: forall era. TxBodyRaw era -> Coin
_txfee,
      _vldt :: forall era. TxBodyRaw era -> ValidityInterval
_vldt = ValidityInterval StrictMaybe SlotNo
bot StrictMaybe SlotNo
top,
      StrictMaybe (Update era)
_update :: StrictMaybe (Update era)
_update :: forall era. TxBodyRaw era -> StrictMaybe (Update era)
_update,
      Set (KeyHash 'Witness (Crypto era))
_reqSignerHashes :: Set (KeyHash 'Witness (Crypto era))
_reqSignerHashes :: forall era. TxBodyRaw era -> Set (KeyHash 'Witness (Crypto era))
_reqSignerHashes,
      Value (Crypto era)
_mint :: Value (Crypto era)
_mint :: forall era. TxBodyRaw era -> Value (Crypto era)
_mint,
      StrictMaybe (ScriptIntegrityHash (Crypto era))
_scriptIntegrityHash :: StrictMaybe (ScriptIntegrityHash (Crypto era))
_scriptIntegrityHash :: forall era.
TxBodyRaw era -> StrictMaybe (ScriptIntegrityHash (Crypto era))
_scriptIntegrityHash,
      StrictMaybe (AuxiliaryDataHash (Crypto era))
_adHash :: StrictMaybe (AuxiliaryDataHash (Crypto era))
_adHash :: forall era.
TxBodyRaw era -> StrictMaybe (AuxiliaryDataHash (Crypto era))
_adHash,
      StrictMaybe Network
_txnetworkid :: StrictMaybe Network
_txnetworkid :: forall era. TxBodyRaw era -> StrictMaybe Network
_txnetworkid
    } =
    (Set (TxIn (Crypto era))
 -> Set (TxIn (Crypto era))
 -> StrictSeq (TxOut era)
 -> Coin
 -> StrictMaybe SlotNo
 -> StrictSeq (DCert (Crypto era))
 -> Wdrl (Crypto era)
 -> StrictMaybe (Update era)
 -> StrictMaybe SlotNo
 -> Set (KeyHash 'Witness (Crypto era))
 -> Value (Crypto era)
 -> StrictMaybe (ScriptIntegrityHash (Crypto era))
 -> StrictMaybe (AuxiliaryDataHash (Crypto era))
 -> StrictMaybe Network
 -> TxBodyRaw era)
-> Encode
     ('Closed 'Sparse)
     (Set (TxIn (Crypto era))
      -> Set (TxIn (Crypto era))
      -> StrictSeq (TxOut era)
      -> Coin
      -> StrictMaybe SlotNo
      -> StrictSeq (DCert (Crypto era))
      -> Wdrl (Crypto era)
      -> StrictMaybe (Update era)
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness (Crypto era))
      -> Value (Crypto era)
      -> StrictMaybe (ScriptIntegrityHash (Crypto era))
      -> StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> StrictMaybe Network
      -> TxBodyRaw era)
forall t. t -> Encode ('Closed 'Sparse) t
Keyed
      ( \Set (TxIn (Crypto era))
i Set (TxIn (Crypto era))
ifee StrictSeq (TxOut era)
o Coin
f StrictMaybe SlotNo
t StrictSeq (DCert (Crypto era))
c Wdrl (Crypto era)
w StrictMaybe (Update era)
u StrictMaybe SlotNo
b Set (KeyHash 'Witness (Crypto era))
rsh Value (Crypto era)
mi StrictMaybe (ScriptIntegrityHash (Crypto era))
sh StrictMaybe (AuxiliaryDataHash (Crypto era))
ah StrictMaybe Network
ni ->
          Set (TxIn (Crypto era))
-> Set (TxIn (Crypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (DCert (Crypto era))
-> Wdrl (Crypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> Set (KeyHash 'Witness (Crypto era))
-> Value (Crypto era)
-> StrictMaybe (ScriptIntegrityHash (Crypto era))
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> StrictMaybe Network
-> TxBodyRaw era
forall era.
Set (TxIn (Crypto era))
-> Set (TxIn (Crypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (DCert (Crypto era))
-> Wdrl (Crypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> Set (KeyHash 'Witness (Crypto era))
-> Value (Crypto era)
-> StrictMaybe (ScriptIntegrityHash (Crypto era))
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> StrictMaybe Network
-> TxBodyRaw era
TxBodyRaw Set (TxIn (Crypto era))
i Set (TxIn (Crypto era))
ifee StrictSeq (TxOut era)
o StrictSeq (DCert (Crypto era))
c Wdrl (Crypto era)
w Coin
f (StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval StrictMaybe SlotNo
b StrictMaybe SlotNo
t) StrictMaybe (Update era)
u Set (KeyHash 'Witness (Crypto era))
rsh Value (Crypto era)
mi StrictMaybe (ScriptIntegrityHash (Crypto era))
sh StrictMaybe (AuxiliaryDataHash (Crypto era))
ah StrictMaybe Network
ni
      )
      Encode
  ('Closed 'Sparse)
  (Set (TxIn (Crypto era))
   -> Set (TxIn (Crypto era))
   -> StrictSeq (TxOut era)
   -> Coin
   -> StrictMaybe SlotNo
   -> StrictSeq (DCert (Crypto era))
   -> Wdrl (Crypto era)
   -> StrictMaybe (Update era)
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness (Crypto era))
   -> Value (Crypto era)
   -> StrictMaybe (ScriptIntegrityHash (Crypto era))
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> StrictMaybe Network
   -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) (Set (TxIn (Crypto era)))
-> Encode
     ('Closed 'Sparse)
     (Set (TxIn (Crypto era))
      -> StrictSeq (TxOut era)
      -> Coin
      -> StrictMaybe SlotNo
      -> StrictSeq (DCert (Crypto era))
      -> Wdrl (Crypto era)
      -> StrictMaybe (Update era)
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness (Crypto era))
      -> Value (Crypto era)
      -> StrictMaybe (ScriptIntegrityHash (Crypto era))
      -> StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> StrictMaybe Network
      -> TxBodyRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> Encode ('Closed 'Dense) (Set (TxIn (Crypto era)))
-> Encode ('Closed 'Sparse) (Set (TxIn (Crypto era)))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
0 ((Set (TxIn (Crypto era)) -> Encoding)
-> Set (TxIn (Crypto era))
-> Encode ('Closed 'Dense) (Set (TxIn (Crypto era)))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E Set (TxIn (Crypto era)) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable Set (TxIn (Crypto era))
_inputs)
      Encode
  ('Closed 'Sparse)
  (Set (TxIn (Crypto era))
   -> StrictSeq (TxOut era)
   -> Coin
   -> StrictMaybe SlotNo
   -> StrictSeq (DCert (Crypto era))
   -> Wdrl (Crypto era)
   -> StrictMaybe (Update era)
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness (Crypto era))
   -> Value (Crypto era)
   -> StrictMaybe (ScriptIntegrityHash (Crypto era))
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> StrictMaybe Network
   -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) (Set (TxIn (Crypto era)))
-> Encode
     ('Closed 'Sparse)
     (StrictSeq (TxOut era)
      -> Coin
      -> StrictMaybe SlotNo
      -> StrictSeq (DCert (Crypto era))
      -> Wdrl (Crypto era)
      -> StrictMaybe (Update era)
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness (Crypto era))
      -> Value (Crypto era)
      -> StrictMaybe (ScriptIntegrityHash (Crypto era))
      -> StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> StrictMaybe Network
      -> TxBodyRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Set (TxIn (Crypto era)) -> Bool)
-> Encode ('Closed 'Sparse) (Set (TxIn (Crypto era)))
-> Encode ('Closed 'Sparse) (Set (TxIn (Crypto era)))
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit Set (TxIn (Crypto era)) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Word
-> Encode ('Closed 'Dense) (Set (TxIn (Crypto era)))
-> Encode ('Closed 'Sparse) (Set (TxIn (Crypto era)))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
13 ((Set (TxIn (Crypto era)) -> Encoding)
-> Set (TxIn (Crypto era))
-> Encode ('Closed 'Dense) (Set (TxIn (Crypto era)))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E Set (TxIn (Crypto era)) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable Set (TxIn (Crypto era))
_collateral))
      Encode
  ('Closed 'Sparse)
  (StrictSeq (TxOut era)
   -> Coin
   -> StrictMaybe SlotNo
   -> StrictSeq (DCert (Crypto era))
   -> Wdrl (Crypto era)
   -> StrictMaybe (Update era)
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness (Crypto era))
   -> Value (Crypto era)
   -> StrictMaybe (ScriptIntegrityHash (Crypto era))
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> StrictMaybe Network
   -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) (StrictSeq (TxOut era))
-> Encode
     ('Closed 'Sparse)
     (Coin
      -> StrictMaybe SlotNo
      -> StrictSeq (DCert (Crypto era))
      -> Wdrl (Crypto era)
      -> StrictMaybe (Update era)
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness (Crypto era))
      -> Value (Crypto era)
      -> StrictMaybe (ScriptIntegrityHash (Crypto era))
      -> StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> StrictMaybe Network
      -> TxBodyRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> Encode ('Closed 'Dense) (StrictSeq (TxOut era))
-> Encode ('Closed 'Sparse) (StrictSeq (TxOut era))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
1 ((StrictSeq (TxOut era) -> Encoding)
-> StrictSeq (TxOut era)
-> Encode ('Closed 'Dense) (StrictSeq (TxOut era))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E StrictSeq (TxOut era) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable StrictSeq (TxOut era)
_outputs)
      Encode
  ('Closed 'Sparse)
  (Coin
   -> StrictMaybe SlotNo
   -> StrictSeq (DCert (Crypto era))
   -> Wdrl (Crypto era)
   -> StrictMaybe (Update era)
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness (Crypto era))
   -> Value (Crypto era)
   -> StrictMaybe (ScriptIntegrityHash (Crypto era))
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> StrictMaybe Network
   -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) Coin
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe SlotNo
      -> StrictSeq (DCert (Crypto era))
      -> Wdrl (Crypto era)
      -> StrictMaybe (Update era)
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness (Crypto era))
      -> Value (Crypto era)
      -> StrictMaybe (ScriptIntegrityHash (Crypto era))
      -> StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> StrictMaybe Network
      -> TxBodyRaw era)
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. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
_txfee)
      Encode
  ('Closed 'Sparse)
  (StrictMaybe SlotNo
   -> StrictSeq (DCert (Crypto era))
   -> Wdrl (Crypto era)
   -> StrictMaybe (Update era)
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness (Crypto era))
   -> Value (Crypto era)
   -> StrictMaybe (ScriptIntegrityHash (Crypto era))
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> StrictMaybe Network
   -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) (StrictMaybe SlotNo)
-> Encode
     ('Closed 'Sparse)
     (StrictSeq (DCert (Crypto era))
      -> Wdrl (Crypto era)
      -> StrictMaybe (Update era)
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness (Crypto era))
      -> Value (Crypto era)
      -> StrictMaybe (ScriptIntegrityHash (Crypto era))
      -> StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> StrictMaybe Network
      -> TxBodyRaw era)
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.
ToCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
3 StrictMaybe SlotNo
top
      Encode
  ('Closed 'Sparse)
  (StrictSeq (DCert (Crypto era))
   -> Wdrl (Crypto era)
   -> StrictMaybe (Update era)
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness (Crypto era))
   -> Value (Crypto era)
   -> StrictMaybe (ScriptIntegrityHash (Crypto era))
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> StrictMaybe Network
   -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) (StrictSeq (DCert (Crypto era)))
-> Encode
     ('Closed 'Sparse)
     (Wdrl (Crypto era)
      -> StrictMaybe (Update era)
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness (Crypto era))
      -> Value (Crypto era)
      -> StrictMaybe (ScriptIntegrityHash (Crypto era))
      -> StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> StrictMaybe Network
      -> TxBodyRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictSeq (DCert (Crypto era)) -> Bool)
-> Encode ('Closed 'Sparse) (StrictSeq (DCert (Crypto era)))
-> Encode ('Closed 'Sparse) (StrictSeq (DCert (Crypto era)))
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit StrictSeq (DCert (Crypto era)) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Word
-> Encode ('Closed 'Dense) (StrictSeq (DCert (Crypto era)))
-> Encode ('Closed 'Sparse) (StrictSeq (DCert (Crypto era)))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
4 ((StrictSeq (DCert (Crypto era)) -> Encoding)
-> StrictSeq (DCert (Crypto era))
-> Encode ('Closed 'Dense) (StrictSeq (DCert (Crypto era)))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E StrictSeq (DCert (Crypto era)) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable StrictSeq (DCert (Crypto era))
_certs))
      Encode
  ('Closed 'Sparse)
  (Wdrl (Crypto era)
   -> StrictMaybe (Update era)
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness (Crypto era))
   -> Value (Crypto era)
   -> StrictMaybe (ScriptIntegrityHash (Crypto era))
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> StrictMaybe Network
   -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) (Wdrl (Crypto era))
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe (Update era)
      -> StrictMaybe SlotNo
      -> Set (KeyHash 'Witness (Crypto era))
      -> Value (Crypto era)
      -> StrictMaybe (ScriptIntegrityHash (Crypto era))
      -> StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> StrictMaybe Network
      -> TxBodyRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Wdrl (Crypto era) -> Bool)
-> Encode ('Closed 'Sparse) (Wdrl (Crypto era))
-> Encode ('Closed 'Sparse) (Wdrl (Crypto era))
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit (Map (RewardAcnt (Crypto era)) Coin -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map (RewardAcnt (Crypto era)) Coin -> Bool)
-> (Wdrl (Crypto era) -> Map (RewardAcnt (Crypto era)) Coin)
-> Wdrl (Crypto era)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wdrl (Crypto era) -> Map (RewardAcnt (Crypto era)) Coin
forall crypto. Wdrl crypto -> Map (RewardAcnt crypto) Coin
unWdrl) (Word
-> Encode ('Closed 'Dense) (Wdrl (Crypto era))
-> Encode ('Closed 'Sparse) (Wdrl (Crypto era))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
5 (Wdrl (Crypto era) -> Encode ('Closed 'Dense) (Wdrl (Crypto era))
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Wdrl (Crypto era)
_wdrls))
      Encode
  ('Closed 'Sparse)
  (StrictMaybe (Update era)
   -> StrictMaybe SlotNo
   -> Set (KeyHash 'Witness (Crypto era))
   -> Value (Crypto era)
   -> StrictMaybe (ScriptIntegrityHash (Crypto era))
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> StrictMaybe Network
   -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) (StrictMaybe (Update era))
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe SlotNo
      -> Set (KeyHash 'Witness (Crypto era))
      -> Value (Crypto era)
      -> StrictMaybe (ScriptIntegrityHash (Crypto era))
      -> StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> StrictMaybe Network
      -> TxBodyRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe (Update era)
-> Encode ('Closed 'Sparse) (StrictMaybe (Update era))
forall a.
ToCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
6 StrictMaybe (Update era)
_update
      Encode
  ('Closed 'Sparse)
  (StrictMaybe SlotNo
   -> Set (KeyHash 'Witness (Crypto era))
   -> Value (Crypto era)
   -> StrictMaybe (ScriptIntegrityHash (Crypto era))
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> StrictMaybe Network
   -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) (StrictMaybe SlotNo)
-> Encode
     ('Closed 'Sparse)
     (Set (KeyHash 'Witness (Crypto era))
      -> Value (Crypto era)
      -> StrictMaybe (ScriptIntegrityHash (Crypto era))
      -> StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> StrictMaybe Network
      -> TxBodyRaw era)
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.
ToCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
8 StrictMaybe SlotNo
bot
      Encode
  ('Closed 'Sparse)
  (Set (KeyHash 'Witness (Crypto era))
   -> Value (Crypto era)
   -> StrictMaybe (ScriptIntegrityHash (Crypto era))
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> StrictMaybe Network
   -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) (Set (KeyHash 'Witness (Crypto era)))
-> Encode
     ('Closed 'Sparse)
     (Value (Crypto era)
      -> StrictMaybe (ScriptIntegrityHash (Crypto era))
      -> StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> StrictMaybe Network
      -> TxBodyRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Set (KeyHash 'Witness (Crypto era)) -> Bool)
-> Encode ('Closed 'Sparse) (Set (KeyHash 'Witness (Crypto era)))
-> Encode ('Closed 'Sparse) (Set (KeyHash 'Witness (Crypto era)))
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit Set (KeyHash 'Witness (Crypto era)) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Word
-> Encode ('Closed 'Dense) (Set (KeyHash 'Witness (Crypto era)))
-> Encode ('Closed 'Sparse) (Set (KeyHash 'Witness (Crypto era)))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
14 ((Set (KeyHash 'Witness (Crypto era)) -> Encoding)
-> Set (KeyHash 'Witness (Crypto era))
-> Encode ('Closed 'Dense) (Set (KeyHash 'Witness (Crypto era)))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E Set (KeyHash 'Witness (Crypto era)) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable Set (KeyHash 'Witness (Crypto era))
_reqSignerHashes))
      Encode
  ('Closed 'Sparse)
  (Value (Crypto era)
   -> StrictMaybe (ScriptIntegrityHash (Crypto era))
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> StrictMaybe Network
   -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) (Value (Crypto era))
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe (ScriptIntegrityHash (Crypto era))
      -> StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> StrictMaybe Network
      -> TxBodyRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Value (Crypto era) -> Bool)
-> Encode ('Closed 'Sparse) (Value (Crypto era))
-> Encode ('Closed 'Sparse) (Value (Crypto era))
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit Value (Crypto era) -> Bool
forall t. Val t => t -> Bool
isZero (Word
-> Encode ('Closed 'Dense) (Value (Crypto era))
-> Encode ('Closed 'Sparse) (Value (Crypto era))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
9 ((Value (Crypto era) -> Encoding)
-> Value (Crypto era)
-> Encode ('Closed 'Dense) (Value (Crypto era))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E Value (Crypto era) -> Encoding
forall v. EncodeMint v => v -> Encoding
encodeMint Value (Crypto era)
_mint))
      Encode
  ('Closed 'Sparse)
  (StrictMaybe (ScriptIntegrityHash (Crypto era))
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> StrictMaybe Network
   -> TxBodyRaw era)
-> Encode
     ('Closed 'Sparse) (StrictMaybe (ScriptIntegrityHash (Crypto era)))
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> StrictMaybe Network -> TxBodyRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe (ScriptIntegrityHash (Crypto era))
-> Encode
     ('Closed 'Sparse) (StrictMaybe (ScriptIntegrityHash (Crypto era)))
forall a.
ToCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
11 StrictMaybe (ScriptIntegrityHash (Crypto era))
_scriptIntegrityHash
      Encode
  ('Closed 'Sparse)
  (StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> StrictMaybe Network -> TxBodyRaw era)
-> Encode
     ('Closed 'Sparse) (StrictMaybe (AuxiliaryDataHash (Crypto era)))
-> Encode ('Closed 'Sparse) (StrictMaybe Network -> TxBodyRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> Encode
     ('Closed 'Sparse) (StrictMaybe (AuxiliaryDataHash (Crypto era)))
forall a.
ToCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
7 StrictMaybe (AuxiliaryDataHash (Crypto era))
_adHash
      Encode ('Closed 'Sparse) (StrictMaybe Network -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) (StrictMaybe Network)
-> Encode ('Closed 'Sparse) (TxBodyRaw era)
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.
ToCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
15 StrictMaybe Network
_txnetworkid

instance
  forall era.
  ( Era era,
    Typeable (Core.Script era),
    Typeable (Core.AuxiliaryData era),
    Compactible (Core.Value era),
    Show (Core.Value era),
    DecodeNonNegative (Core.Value era),
    FromCBOR (Annotator (Core.Script era)),
    FromCBOR (PParamsDelta era),
    ToCBOR (PParamsDelta era)
  ) =>
  FromCBOR (TxBodyRaw era)
  where
  fromCBOR :: Decoder s (TxBodyRaw era)
fromCBOR =
    Decode ('Closed 'Dense) (TxBodyRaw era)
-> Decoder s (TxBodyRaw era)
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (TxBodyRaw era)
 -> Decoder s (TxBodyRaw era))
-> Decode ('Closed 'Dense) (TxBodyRaw era)
-> Decoder s (TxBodyRaw era)
forall a b. (a -> b) -> a -> b
$
      [Char]
-> TxBodyRaw era
-> (Word -> Field (TxBodyRaw era))
-> [(Word, [Char])]
-> Decode ('Closed 'Dense) (TxBodyRaw era)
forall t.
Typeable t =>
[Char]
-> t
-> (Word -> Field t)
-> [(Word, [Char])]
-> Decode ('Closed 'Dense) t
SparseKeyed
        [Char]
"TxBodyRaw"
        TxBodyRaw era
initial
        Word -> Field (TxBodyRaw era)
bodyFields
        [(Word, [Char])]
requiredFields
    where
      initial :: TxBodyRaw era
      initial :: TxBodyRaw era
initial =
        Set (TxIn (Crypto era))
-> Set (TxIn (Crypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (DCert (Crypto era))
-> Wdrl (Crypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> Set (KeyHash 'Witness (Crypto era))
-> Value (Crypto era)
-> StrictMaybe (ScriptIntegrityHash (Crypto era))
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> StrictMaybe Network
-> TxBodyRaw era
forall era.
Set (TxIn (Crypto era))
-> Set (TxIn (Crypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (DCert (Crypto era))
-> Wdrl (Crypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> Set (KeyHash 'Witness (Crypto era))
-> Value (Crypto era)
-> StrictMaybe (ScriptIntegrityHash (Crypto era))
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> StrictMaybe Network
-> TxBodyRaw era
TxBodyRaw
          Set (TxIn (Crypto era))
forall a. Monoid a => a
mempty
          Set (TxIn (Crypto era))
forall a. Monoid a => a
mempty
          StrictSeq (TxOut era)
forall a. StrictSeq a
StrictSeq.empty
          StrictSeq (DCert (Crypto era))
forall a. StrictSeq a
StrictSeq.empty
          (Map (RewardAcnt (Crypto era)) Coin -> Wdrl (Crypto era)
forall crypto. Map (RewardAcnt crypto) Coin -> Wdrl crypto
Wdrl Map (RewardAcnt (Crypto era)) 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 era)
forall a. StrictMaybe a
SNothing
          Set (KeyHash 'Witness (Crypto era))
forall a. Monoid a => a
mempty
          Value (Crypto era)
forall a. Monoid a => a
mempty
          StrictMaybe (ScriptIntegrityHash (Crypto era))
forall a. StrictMaybe a
SNothing
          StrictMaybe (AuxiliaryDataHash (Crypto era))
forall a. StrictMaybe a
SNothing
          StrictMaybe Network
forall a. StrictMaybe a
SNothing
      bodyFields :: (Word -> Field (TxBodyRaw era))
      bodyFields :: Word -> Field (TxBodyRaw era)
bodyFields Word
0 =
        (Set (TxIn (Crypto era)) -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed 'Dense) (Set (TxIn (Crypto era)))
-> Field (TxBodyRaw era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field
          (\Set (TxIn (Crypto era))
x TxBodyRaw era
tx -> TxBodyRaw era
tx {_inputs :: Set (TxIn (Crypto era))
_inputs = Set (TxIn (Crypto era))
x})
          ((forall s. Decoder s (Set (TxIn (Crypto era))))
-> Decode ('Closed 'Dense) (Set (TxIn (Crypto era)))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s (TxIn (Crypto era))
-> Decoder s (Set (TxIn (Crypto era)))
forall a s. Ord a => Decoder s a -> Decoder s (Set a)
decodeSet Decoder s (TxIn (Crypto era))
forall a s. FromCBOR a => Decoder s a
fromCBOR))
      bodyFields Word
13 =
        (Set (TxIn (Crypto era)) -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed 'Dense) (Set (TxIn (Crypto era)))
-> Field (TxBodyRaw era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field
          (\Set (TxIn (Crypto era))
x TxBodyRaw era
tx -> TxBodyRaw era
tx {_collateral :: Set (TxIn (Crypto era))
_collateral = Set (TxIn (Crypto era))
x})
          ((forall s. Decoder s (Set (TxIn (Crypto era))))
-> Decode ('Closed 'Dense) (Set (TxIn (Crypto era)))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s (TxIn (Crypto era))
-> Decoder s (Set (TxIn (Crypto era)))
forall a s. Ord a => Decoder s a -> Decoder s (Set a)
decodeSet Decoder s (TxIn (Crypto era))
forall a s. FromCBOR a => Decoder s a
fromCBOR))
      bodyFields Word
1 =
        (StrictSeq (TxOut era) -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed 'Dense) (StrictSeq (TxOut era))
-> Field (TxBodyRaw era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field
          (\StrictSeq (TxOut era)
x TxBodyRaw era
tx -> TxBodyRaw era
tx {_outputs :: StrictSeq (TxOut era)
_outputs = StrictSeq (TxOut era)
x})
          ((forall s. Decoder s (StrictSeq (TxOut era)))
-> Decode ('Closed 'Dense) (StrictSeq (TxOut era))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s (TxOut era) -> Decoder s (StrictSeq (TxOut era))
forall s a. Decoder s a -> Decoder s (StrictSeq a)
decodeStrictSeq Decoder s (TxOut era)
forall a s. FromCBOR a => Decoder s a
fromCBOR))
      bodyFields Word
2 = (Coin -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed Any) Coin -> Field (TxBodyRaw era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Coin
x TxBodyRaw era
tx -> TxBodyRaw era
tx {_txfee :: Coin
_txfee = Coin
x}) Decode ('Closed Any) Coin
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      bodyFields Word
3 =
        (StrictMaybe SlotNo -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed Any) SlotNo -> Field (TxBodyRaw era)
forall x t (d :: Density).
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield
          (\StrictMaybe SlotNo
x TxBodyRaw era
tx -> TxBodyRaw era
tx {_vldt :: ValidityInterval
_vldt = (TxBodyRaw era -> ValidityInterval
forall era. TxBodyRaw era -> ValidityInterval
_vldt TxBodyRaw era
tx) {invalidHereafter :: StrictMaybe SlotNo
invalidHereafter = StrictMaybe SlotNo
x}})
          Decode ('Closed Any) SlotNo
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      bodyFields Word
4 =
        (StrictSeq (DCert (Crypto era)) -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed 'Dense) (StrictSeq (DCert (Crypto era)))
-> Field (TxBodyRaw era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field
          (\StrictSeq (DCert (Crypto era))
x TxBodyRaw era
tx -> TxBodyRaw era
tx {_certs :: StrictSeq (DCert (Crypto era))
_certs = StrictSeq (DCert (Crypto era))
x})
          ((forall s. Decoder s (StrictSeq (DCert (Crypto era))))
-> Decode ('Closed 'Dense) (StrictSeq (DCert (Crypto era)))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s (DCert (Crypto era))
-> Decoder s (StrictSeq (DCert (Crypto era)))
forall s a. Decoder s a -> Decoder s (StrictSeq a)
decodeStrictSeq Decoder s (DCert (Crypto era))
forall a s. FromCBOR a => Decoder s a
fromCBOR))
      bodyFields Word
5 = (Wdrl (Crypto era) -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed Any) (Wdrl (Crypto era))
-> Field (TxBodyRaw era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Wdrl (Crypto era)
x TxBodyRaw era
tx -> TxBodyRaw era
tx {_wdrls :: Wdrl (Crypto era)
_wdrls = Wdrl (Crypto era)
x}) Decode ('Closed Any) (Wdrl (Crypto era))
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      bodyFields Word
6 = (StrictMaybe (Update era) -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed Any) (Update era) -> Field (TxBodyRaw era)
forall x t (d :: Density).
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield (\StrictMaybe (Update era)
x TxBodyRaw era
tx -> TxBodyRaw era
tx {_update :: StrictMaybe (Update era)
_update = StrictMaybe (Update era)
x}) Decode ('Closed Any) (Update era)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      bodyFields Word
7 = (StrictMaybe (AuxiliaryDataHash (Crypto era))
 -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed Any) (AuxiliaryDataHash (Crypto era))
-> Field (TxBodyRaw era)
forall x t (d :: Density).
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield (\StrictMaybe (AuxiliaryDataHash (Crypto era))
x TxBodyRaw era
tx -> TxBodyRaw era
tx {_adHash :: StrictMaybe (AuxiliaryDataHash (Crypto era))
_adHash = StrictMaybe (AuxiliaryDataHash (Crypto era))
x}) Decode ('Closed Any) (AuxiliaryDataHash (Crypto era))
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      bodyFields Word
8 =
        (StrictMaybe SlotNo -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed Any) SlotNo -> Field (TxBodyRaw era)
forall x t (d :: Density).
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield
          (\StrictMaybe SlotNo
x TxBodyRaw era
tx -> TxBodyRaw era
tx {_vldt :: ValidityInterval
_vldt = (TxBodyRaw era -> ValidityInterval
forall era. TxBodyRaw era -> ValidityInterval
_vldt TxBodyRaw era
tx) {invalidBefore :: StrictMaybe SlotNo
invalidBefore = StrictMaybe SlotNo
x}})
          Decode ('Closed Any) SlotNo
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      bodyFields Word
9 = (Value (Crypto era) -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed 'Dense) (Value (Crypto era))
-> Field (TxBodyRaw era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Value (Crypto era)
x TxBodyRaw era
tx -> TxBodyRaw era
tx {_mint :: Value (Crypto era)
_mint = Value (Crypto era)
x}) ((forall s. Decoder s (Value (Crypto era)))
-> Decode ('Closed 'Dense) (Value (Crypto era))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall s. Decoder s (Value (Crypto era))
forall v s. DecodeMint v => Decoder s v
decodeMint)
      bodyFields Word
11 = (StrictMaybe (ScriptIntegrityHash (Crypto era))
 -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed Any) (ScriptIntegrityHash (Crypto era))
-> Field (TxBodyRaw era)
forall x t (d :: Density).
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield (\StrictMaybe (ScriptIntegrityHash (Crypto era))
x TxBodyRaw era
tx -> TxBodyRaw era
tx {_scriptIntegrityHash :: StrictMaybe (ScriptIntegrityHash (Crypto era))
_scriptIntegrityHash = StrictMaybe (ScriptIntegrityHash (Crypto era))
x}) Decode ('Closed Any) (ScriptIntegrityHash (Crypto era))
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      bodyFields Word
14 = (Set (KeyHash 'Witness (Crypto era))
 -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed 'Dense) (Set (KeyHash 'Witness (Crypto era)))
-> Field (TxBodyRaw era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Set (KeyHash 'Witness (Crypto era))
x TxBodyRaw era
tx -> TxBodyRaw era
tx {_reqSignerHashes :: Set (KeyHash 'Witness (Crypto era))
_reqSignerHashes = Set (KeyHash 'Witness (Crypto era))
x}) ((forall s. Decoder s (Set (KeyHash 'Witness (Crypto era))))
-> Decode ('Closed 'Dense) (Set (KeyHash 'Witness (Crypto era)))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s (KeyHash 'Witness (Crypto era))
-> Decoder s (Set (KeyHash 'Witness (Crypto era)))
forall a s. Ord a => Decoder s a -> Decoder s (Set a)
decodeSet Decoder s (KeyHash 'Witness (Crypto era))
forall a s. FromCBOR a => Decoder s a
fromCBOR))
      bodyFields Word
15 = (StrictMaybe Network -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed Any) Network -> Field (TxBodyRaw era)
forall x t (d :: Density).
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield (\StrictMaybe Network
x TxBodyRaw era
tx -> TxBodyRaw era
tx {_txnetworkid :: StrictMaybe Network
_txnetworkid = StrictMaybe Network
x}) Decode ('Closed Any) Network
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      bodyFields Word
n = (Any -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed Any) Any -> Field (TxBodyRaw era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Any
_ TxBodyRaw era
t -> TxBodyRaw era
t) (Word -> Decode ('Closed Any) Any
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n)
      requiredFields :: [(Word, [Char])]
requiredFields =
        [ (Word
0, [Char]
"inputs"),
          (Word
1, [Char]
"outputs"),
          (Word
2, [Char]
"fee")
        ]

instance
  ( Era era,
    Typeable (Core.Script era),
    Typeable (Core.AuxiliaryData era),
    Compactible (Core.Value era),
    Show (Core.Value era),
    DecodeNonNegative (Core.Value era),
    FromCBOR (Annotator (Core.Script era)),
    FromCBOR (PParamsDelta era),
    ToCBOR (PParamsDelta era)
  ) =>
  FromCBOR (Annotator (TxBodyRaw era))
  where
  fromCBOR :: Decoder s (Annotator (TxBodyRaw era))
fromCBOR = TxBodyRaw era -> Annotator (TxBodyRaw era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxBodyRaw era -> Annotator (TxBodyRaw era))
-> Decoder s (TxBodyRaw era)
-> Decoder s (Annotator (TxBodyRaw era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (TxBodyRaw era)
forall a s. FromCBOR a => Decoder s a
fromCBOR

-- ====================================================
-- HasField instances to be consistent with earlier Eras

instance (Crypto era ~ c) => HasField "inputs" (TxBody era) (Set (TxIn c)) where
  getField :: TxBody era -> Set (TxIn c)
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> Set (TxIn (Crypto era))
forall era. TxBodyRaw era -> Set (TxIn (Crypto era))
_inputs TxBodyRaw era
m

instance HasField "outputs" (TxBody era) (StrictSeq (TxOut era)) where
  getField :: TxBody era -> StrictSeq (TxOut era)
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> StrictSeq (TxOut era)
forall era. TxBodyRaw era -> StrictSeq (TxOut era)
_outputs TxBodyRaw era
m

instance Crypto era ~ crypto => HasField "certs" (TxBody era) (StrictSeq (DCert crypto)) where
  getField :: TxBody era -> StrictSeq (DCert crypto)
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> StrictSeq (DCert (Crypto era))
forall era. TxBodyRaw era -> StrictSeq (DCert (Crypto era))
_certs TxBodyRaw era
m

instance Crypto era ~ crypto => HasField "wdrls" (TxBody era) (Wdrl crypto) where
  getField :: TxBody era -> Wdrl crypto
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> Wdrl (Crypto era)
forall era. TxBodyRaw era -> Wdrl (Crypto era)
_wdrls TxBodyRaw era
m

instance HasField "txfee" (TxBody era) Coin where
  getField :: TxBody era -> Coin
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> Coin
forall era. TxBodyRaw era -> Coin
_txfee TxBodyRaw era
m

instance HasField "update" (TxBody era) (StrictMaybe (Update era)) where
  getField :: TxBody era -> StrictMaybe (Update era)
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> StrictMaybe (Update era)
forall era. TxBodyRaw era -> StrictMaybe (Update era)
_update TxBodyRaw era
m

instance Crypto era ~ crypto => HasField "referenceInputs" (TxBody era) (Set (TxIn crypto)) where
  getField :: TxBody era -> Set (TxIn crypto)
getField TxBody era
_ = Set (TxIn crypto)
forall a. Set a
Set.empty

instance
  (Crypto era ~ c) =>
  HasField "reqSignerHashes" (TxBody era) (Set (KeyHash 'Witness c))
  where
  getField :: TxBody era -> Set (KeyHash 'Witness c)
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> Set (KeyHash 'Witness (Crypto era))
forall era. TxBodyRaw era -> Set (KeyHash 'Witness (Crypto era))
_reqSignerHashes TxBodyRaw era
m

instance (Crypto era ~ c) => HasField "mint" (TxBody era) (Mary.Value c) where
  getField :: TxBody era -> Value c
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> Value (Crypto era)
forall era. TxBodyRaw era -> Value (Crypto era)
_mint TxBodyRaw era
m

instance (Crypto era ~ c) => HasField "collateral" (TxBody era) (Set (TxIn c)) where
  getField :: TxBody era -> Set (TxIn c)
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> Set (TxIn (Crypto era))
forall era. TxBodyRaw era -> Set (TxIn (Crypto era))
_collateral TxBodyRaw era
m

instance (Crypto era ~ c) => HasField "minted" (TxBody era) (Set (ScriptHash c)) where
  getField :: TxBody era -> Set (ScriptHash c)
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = (PolicyID c -> ScriptHash c)
-> Set (PolicyID c) -> Set (ScriptHash c)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map PolicyID c -> ScriptHash c
forall crypto. PolicyID crypto -> ScriptHash crypto
policyID (Value c -> Set (PolicyID c)
forall crypto. Value crypto -> Set (PolicyID crypto)
policies (TxBodyRaw era -> Value (Crypto era)
forall era. TxBodyRaw era -> Value (Crypto era)
_mint TxBodyRaw era
m))

instance HasField "vldt" (TxBody era) ValidityInterval where
  getField :: TxBody era -> ValidityInterval
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> ValidityInterval
forall era. TxBodyRaw era -> ValidityInterval
_vldt TxBodyRaw era
m

instance
  c ~ Crypto era =>
  HasField "adHash" (TxBody era) (StrictMaybe (AuxiliaryDataHash c))
  where
  getField :: TxBody era -> StrictMaybe (AuxiliaryDataHash c)
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> StrictMaybe (AuxiliaryDataHash (Crypto era))
forall era.
TxBodyRaw era -> StrictMaybe (AuxiliaryDataHash (Crypto era))
_adHash TxBodyRaw era
m

instance
  c ~ Crypto era =>
  HasField "scriptIntegrityHash" (TxBody era) (StrictMaybe (ScriptIntegrityHash c))
  where
  getField :: TxBody era -> StrictMaybe (ScriptIntegrityHash c)
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> StrictMaybe (ScriptIntegrityHash (Crypto era))
forall era.
TxBodyRaw era -> StrictMaybe (ScriptIntegrityHash (Crypto era))
_scriptIntegrityHash TxBodyRaw era
m

instance HasField "txnetworkid" (TxBody era) (StrictMaybe Network) where
  getField :: TxBody era -> StrictMaybe Network
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> StrictMaybe Network
forall era. TxBodyRaw era -> StrictMaybe Network
_txnetworkid TxBodyRaw era
m

instance (Era era, Core.Value era ~ val, Compactible val) => HasField "value" (TxOut era) val where
  getField :: TxOut era -> val
getField = \case
    TxOutCompact' CompactAddr (Crypto era)
_ CompactForm (Value era)
cv -> CompactForm val -> val
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm val
CompactForm (Value era)
cv
    TxOutCompactDH' CompactAddr (Crypto era)
_ CompactForm (Value era)
cv DataHash (Crypto era)
_ -> CompactForm val -> val
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm val
CompactForm (Value era)
cv
    TxOut_AddrHash28_AdaOnly Credential 'Staking (Crypto era)
_ Addr28Extra
_ CompactForm Coin
cc -> Coin -> val
forall t. Val t => Coin -> t
inject (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
cc)
    TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking (Crypto era)
_ Addr28Extra
_ CompactForm Coin
cc DataHash32
_ -> Coin -> val
forall t. Val t => Coin -> t
inject (CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm Coin
cc)

instance (Era era, c ~ Crypto era) => HasField "datahash" (TxOut era) (StrictMaybe (DataHash c)) where
  getField :: TxOut era -> StrictMaybe (DataHash c)
getField = \case
    TxOutCompactDH' CompactAddr (Crypto era)
_ CompactForm (Value era)
_ DataHash (Crypto era)
dh -> DataHash c -> StrictMaybe (DataHash c)
forall a. a -> StrictMaybe a
SJust DataHash c
DataHash (Crypto era)
dh
    TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking (Crypto era)
_ Addr28Extra
_ CompactForm Coin
_ DataHash32
dh ->
      Maybe (DataHash c) -> StrictMaybe (DataHash c)
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (Maybe (DataHash c) -> StrictMaybe (DataHash c))
-> Maybe (DataHash c) -> StrictMaybe (DataHash c)
forall a b. (a -> b) -> a -> b
$ do
        SizeHash (HASH c) :~: 32
Refl <- Proxy (SizeHash (HASH c))
-> Proxy 32 -> Maybe (SizeHash (HASH c) :~: 32)
forall (a :: Nat) (b :: Nat).
(KnownNat a, KnownNat b) =>
Proxy a -> Proxy b -> Maybe (a :~: b)
sameNat (Proxy (SizeHash (HASH c))
forall k (t :: k). Proxy t
Proxy @(SizeHash (CC.HASH c))) (Proxy 32
forall k (t :: k). Proxy t
Proxy @32)
        DataHash32 -> Maybe (DataHash c)
forall crypto.
HashAlgorithm (HASH crypto) =>
DataHash32 -> Maybe (DataHash crypto)
decodeDataHash32 @c DataHash32
dh
    TxOut era
_ -> StrictMaybe (DataHash c)
forall a. StrictMaybe a
SNothing

getAlonzoTxOutEitherAddr ::
  HashAlgorithm (CC.ADDRHASH (Crypto era)) =>
  TxOut era ->
  Either (Addr (Crypto era)) (CompactAddr (Crypto era))
getAlonzoTxOutEitherAddr :: TxOut era -> Either (Addr (Crypto era)) (CompactAddr (Crypto era))
getAlonzoTxOutEitherAddr = \case
  TxOutCompact' CompactAddr (Crypto era)
cAddr CompactForm (Value era)
_ -> CompactAddr (Crypto era)
-> Either (Addr (Crypto era)) (CompactAddr (Crypto era))
forall a b. b -> Either a b
Right CompactAddr (Crypto era)
cAddr
  TxOutCompactDH' CompactAddr (Crypto era)
cAddr CompactForm (Value era)
_ DataHash (Crypto era)
_ -> CompactAddr (Crypto era)
-> Either (Addr (Crypto era)) (CompactAddr (Crypto era))
forall a b. b -> Either a b
Right CompactAddr (Crypto era)
cAddr
  TxOut_AddrHash28_AdaOnly Credential 'Staking (Crypto era)
stakeRef Addr28Extra
addr28Extra CompactForm Coin
_
    | Just Addr (Crypto era)
addr <- Credential 'Staking (Crypto era)
-> Addr28Extra -> Maybe (Addr (Crypto era))
forall crypto.
HashAlgorithm (ADDRHASH crypto) =>
Credential 'Staking crypto -> Addr28Extra -> Maybe (Addr crypto)
decodeAddress28 Credential 'Staking (Crypto era)
stakeRef Addr28Extra
addr28Extra -> Addr (Crypto era)
-> Either (Addr (Crypto era)) (CompactAddr (Crypto era))
forall a b. a -> Either a b
Left Addr (Crypto era)
addr
    | Bool
otherwise -> [Char] -> Either (Addr (Crypto era)) (CompactAddr (Crypto era))
forall a. HasCallStack => [Char] -> a
error [Char]
addressErrorMsg
  TxOut_AddrHash28_AdaOnly_DataHash32 Credential 'Staking (Crypto era)
stakeRef Addr28Extra
addr28Extra CompactForm Coin
_ DataHash32
_
    | Just Addr (Crypto era)
addr <- Credential 'Staking (Crypto era)
-> Addr28Extra -> Maybe (Addr (Crypto era))
forall crypto.
HashAlgorithm (ADDRHASH crypto) =>
Credential 'Staking crypto -> Addr28Extra -> Maybe (Addr crypto)
decodeAddress28 Credential 'Staking (Crypto era)
stakeRef Addr28Extra
addr28Extra -> Addr (Crypto era)
-> Either (Addr (Crypto era)) (CompactAddr (Crypto era))
forall a b. a -> Either a b
Left Addr (Crypto era)
addr
    | Bool
otherwise -> [Char] -> Either (Addr (Crypto era)) (CompactAddr (Crypto era))
forall a. HasCallStack => [Char] -> a
error [Char]
addressErrorMsg

addressErrorMsg :: String
addressErrorMsg :: [Char]
addressErrorMsg = [Char]
"Impossible: Compacted an address of non-standard size"
{-# NOINLINE addressErrorMsg #-}

instance HasField "referenceScript" (TxOut era) (StrictMaybe (Script era)) where
  getField :: TxOut era -> StrictMaybe (Script era)
getField TxOut era
_ = StrictMaybe (Script era)
forall a. StrictMaybe a
SNothing