{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Ledger.ShelleyMA.TxBody
  ( TxBody
      ( TxBody,
        TxBodyConstr,
        TxBody',
        adHash',
        certs',
        inputs',
        mint',
        outputs',
        txfee',
        update',
        vldt',
        wdrls'
      ),
    TxBodyRaw (..),
    FamsFrom,
    FamsTo,
    txSparse,
    bodyFields,
    StrictMaybe (..),
    fromSJust,
    ValidityInterval (..),
    initial,
  )
where

import Cardano.Binary (Annotator, FromCBOR (..), ToCBOR (..))
import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash)
import Cardano.Ledger.BaseTypes (StrictMaybe (SJust, SNothing))
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Core (PParamsDelta, Script, Value)
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Era (Crypto, Era)
import Cardano.Ledger.Hashes (EraIndependentTxBody)
import Cardano.Ledger.SafeHash (HashAnnotated, SafeToHash)
import Cardano.Ledger.Serialization (encodeFoldable)
import Cardano.Ledger.Shelley.Constraints (TransValue)
import Cardano.Ledger.Shelley.PParams (Update)
import Cardano.Ledger.Shelley.TxBody
  ( DCert (..),
    TxOut (..),
    Wdrl (..),
  )
import Cardano.Ledger.ShelleyMA.Timelocks (ValidityInterval (..))
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.Ledger.Val
  ( DecodeMint (..),
    DecodeNonNegative,
    EncodeMint (..),
    Val (..),
  )
import Control.DeepSeq (NFData (..))
import Data.Coders
  ( Decode (..),
    Density (..),
    Encode (..),
    Field,
    Wrapped (..),
    decode,
    decodeSet,
    decodeStrictSeq,
    encodeKeyedStrictMaybe,
    field,
    invalidField,
    ofield,
    (!>),
  )
import qualified Data.Map.Strict as Map
import Data.MemoBytes (Mem, MemoBytes (..), memoBytes)
import Data.Sequence.Strict (StrictSeq, fromList)
import Data.Set (Set, empty)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import GHC.Records
import NoThunks.Class (NoThunks (..))

-- =====================================================
-- TxBody has three Era dependent type families
-- (Value era), (AuxiliaryData era), and (Script era) (hidden in DCert) in
-- order to make CBOR instances of things we are going to
-- have to assume some properties about these.

type FamsFrom era =
  ( Era era,
    Typeable era,
    Typeable (Script era),
    Typeable (Core.AuxiliaryData era),
    Show (Value era),
    DecodeNonNegative (Value era),
    DecodeMint (Value era),
    FromCBOR (Core.PParams era),
    FromCBOR (PParamsDelta era),
    FromCBOR (Value era),
    FromCBOR (Annotator (Script era)) -- Arises becaause DCert memoizes its bytes
  )

type FamsTo era =
  ( Era era,
    ToCBOR (Value era),
    EncodeMint (Value era),
    ToCBOR (Script era),
    ToCBOR (Core.PParams era),
    ToCBOR (PParamsDelta era),
    Typeable (Core.AuxiliaryData era)
  )

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

data TxBodyRaw era = TxBodyRaw
  { TxBodyRaw era -> Set (TxIn (Crypto era))
inputs :: !(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, -- imported from Timelocks
    TxBodyRaw era -> StrictMaybe (Update era)
update :: !(StrictMaybe (Update era)),
    TxBodyRaw era -> StrictMaybe (AuxiliaryDataHash (Crypto era))
adHash :: !(StrictMaybe (AuxiliaryDataHash (Crypto era))),
    TxBodyRaw era -> Value era
mint :: !(Value era)
  }
  deriving (Typeable)

-- For each instance we try and use the weakest constraint possible
-- The surprising (Compactible (Value era))) constraint comes from the fact that TxOut
-- stores a (Value era) in a compactible form.

deriving instance
  (NFData (Value era), Era era, NFData (PParamsDelta era)) =>
  NFData (TxBodyRaw era)

deriving instance
  (TransValue Eq era, Eq (PParamsDelta era)) =>
  Eq (TxBodyRaw era)

deriving instance
  (TransValue Show era, Show (PParamsDelta era)) =>
  Show (TxBodyRaw era)

deriving instance Generic (TxBodyRaw era)

deriving instance
  (NoThunks (Value era), NoThunks (PParamsDelta era)) =>
  NoThunks (TxBodyRaw era)

instance (FamsFrom 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
      ( String
-> TxBodyRaw era
-> (Word -> Field (TxBodyRaw era))
-> [(Word, String)]
-> Decode ('Closed 'Dense) (TxBodyRaw era)
forall t.
Typeable t =>
String
-> t
-> (Word -> Field t)
-> [(Word, String)]
-> Decode ('Closed 'Dense) t
SparseKeyed
          String
"TxBodyRaw"
          TxBodyRaw era
forall era. Val (Value era) => TxBodyRaw era
initial
          Word -> Field (TxBodyRaw era)
forall era. FamsFrom era => Word -> Field (TxBodyRaw era)
bodyFields
          [(Word
0, String
"inputs"), (Word
1, String
"outputs"), (Word
2, String
"txfee")]
      )

instance
  (FamsFrom 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

fromSJust :: StrictMaybe a -> a
fromSJust :: StrictMaybe a -> a
fromSJust (SJust a
x) = a
x
fromSJust StrictMaybe a
SNothing = String -> a
forall a. HasCallStack => String -> a
error String
"SNothing in fromSJust"

-- Sparse encodings of TxBodyRaw, the key values are fixed by backwarad compatibility
-- concerns as we want the Shelley era TxBody to deserialise as a Shelley-ma TxBody.
-- txXparse and bodyFields should be Duals, visual inspection helps ensure this.

txSparse ::
  (FamsTo era) =>
  TxBodyRaw era ->
  Encode ('Closed 'Sparse) (TxBodyRaw era)
txSparse :: TxBodyRaw era -> Encode ('Closed 'Sparse) (TxBodyRaw era)
txSparse (TxBodyRaw Set (TxIn (Crypto era))
inp StrictSeq (TxOut era)
out StrictSeq (DCert (Crypto era))
cert Wdrl (Crypto era)
wdrl Coin
fee (ValidityInterval StrictMaybe SlotNo
bot StrictMaybe SlotNo
top) StrictMaybe (Update era)
up StrictMaybe (AuxiliaryDataHash (Crypto era))
hash Value era
frge) =
  (Set (TxIn (Crypto era))
 -> StrictSeq (TxOut era)
 -> Coin
 -> StrictMaybe SlotNo
 -> StrictSeq (DCert (Crypto era))
 -> Wdrl (Crypto era)
 -> StrictMaybe (Update era)
 -> StrictMaybe (AuxiliaryDataHash (Crypto era))
 -> StrictMaybe SlotNo
 -> Value era
 -> TxBodyRaw 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 (AuxiliaryDataHash (Crypto era))
      -> StrictMaybe SlotNo
      -> Value era
      -> TxBodyRaw era)
forall t. t -> Encode ('Closed 'Sparse) t
Keyed (\Set (TxIn (Crypto era))
i StrictSeq (TxOut era)
o Coin
f StrictMaybe SlotNo
topx StrictSeq (DCert (Crypto era))
c Wdrl (Crypto era)
w StrictMaybe (Update era)
u StrictMaybe (AuxiliaryDataHash (Crypto era))
h StrictMaybe SlotNo
botx Value era
forg -> Set (TxIn (Crypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (DCert (Crypto era))
-> Wdrl (Crypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> Value era
-> TxBodyRaw era
forall era.
Set (TxIn (Crypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (DCert (Crypto era))
-> Wdrl (Crypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> Value era
-> TxBodyRaw era
TxBodyRaw Set (TxIn (Crypto era))
i StrictSeq (TxOut era)
o StrictSeq (DCert (Crypto era))
c Wdrl (Crypto era)
w Coin
f (StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval StrictMaybe SlotNo
botx StrictMaybe SlotNo
topx) StrictMaybe (Update era)
u StrictMaybe (AuxiliaryDataHash (Crypto era))
h Value era
forg)
    Encode
  ('Closed 'Sparse)
  (Set (TxIn (Crypto era))
   -> StrictSeq (TxOut era)
   -> Coin
   -> StrictMaybe SlotNo
   -> StrictSeq (DCert (Crypto era))
   -> Wdrl (Crypto era)
   -> StrictMaybe (Update era)
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> StrictMaybe SlotNo
   -> Value era
   -> 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 (AuxiliaryDataHash (Crypto era))
      -> StrictMaybe SlotNo
      -> Value era
      -> 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))
inp) -- We don't have to send these in TxBodyX order
    Encode
  ('Closed 'Sparse)
  (StrictSeq (TxOut era)
   -> Coin
   -> StrictMaybe SlotNo
   -> StrictSeq (DCert (Crypto era))
   -> Wdrl (Crypto era)
   -> StrictMaybe (Update era)
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> StrictMaybe SlotNo
   -> Value era
   -> 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 (AuxiliaryDataHash (Crypto era))
      -> StrictMaybe SlotNo
      -> Value era
      -> 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)
out) -- Just hack up a fake constructor with the lambda.
    Encode
  ('Closed 'Sparse)
  (Coin
   -> StrictMaybe SlotNo
   -> StrictSeq (DCert (Crypto era))
   -> Wdrl (Crypto era)
   -> StrictMaybe (Update era)
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> StrictMaybe SlotNo
   -> Value era
   -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) Coin
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe SlotNo
      -> StrictSeq (DCert (Crypto era))
      -> Wdrl (Crypto era)
      -> StrictMaybe (Update era)
      -> StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> StrictMaybe SlotNo
      -> Value era
      -> 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
fee)
    Encode
  ('Closed 'Sparse)
  (StrictMaybe SlotNo
   -> StrictSeq (DCert (Crypto era))
   -> Wdrl (Crypto era)
   -> StrictMaybe (Update era)
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> StrictMaybe SlotNo
   -> Value era
   -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) (StrictMaybe SlotNo)
-> Encode
     ('Closed 'Sparse)
     (StrictSeq (DCert (Crypto era))
      -> Wdrl (Crypto era)
      -> StrictMaybe (Update era)
      -> StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> StrictMaybe SlotNo
      -> Value era
      -> 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 (AuxiliaryDataHash (Crypto era))
   -> StrictMaybe SlotNo
   -> Value era
   -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) (StrictSeq (DCert (Crypto era)))
-> Encode
     ('Closed 'Sparse)
     (Wdrl (Crypto era)
      -> StrictMaybe (Update era)
      -> StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> StrictMaybe SlotNo
      -> Value era
      -> 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))
cert))
    Encode
  ('Closed 'Sparse)
  (Wdrl (Crypto era)
   -> StrictMaybe (Update era)
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> StrictMaybe SlotNo
   -> Value era
   -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) (Wdrl (Crypto era))
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe (Update era)
      -> StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> StrictMaybe SlotNo
      -> Value era
      -> 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)
wdrl))
    Encode
  ('Closed 'Sparse)
  (StrictMaybe (Update era)
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> StrictMaybe SlotNo
   -> Value era
   -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) (StrictMaybe (Update era))
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> StrictMaybe SlotNo -> Value era -> 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)
up
    Encode
  ('Closed 'Sparse)
  (StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> StrictMaybe SlotNo -> Value era -> TxBodyRaw era)
-> Encode
     ('Closed 'Sparse) (StrictMaybe (AuxiliaryDataHash (Crypto era)))
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe SlotNo -> Value era -> 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))
hash
    Encode
  ('Closed 'Sparse)
  (StrictMaybe SlotNo -> Value era -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) (StrictMaybe SlotNo)
-> Encode ('Closed 'Sparse) (Value era -> 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) (Value era -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) (Value era)
-> Encode ('Closed 'Sparse) (TxBodyRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Value era -> Bool)
-> Encode ('Closed 'Sparse) (Value era)
-> Encode ('Closed 'Sparse) (Value era)
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit Value era -> Bool
forall t. Val t => t -> Bool
isZero (Word
-> Encode ('Closed 'Dense) (Value era)
-> Encode ('Closed 'Sparse) (Value era)
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
9 ((Value era -> Encoding)
-> Value era -> Encode ('Closed 'Dense) (Value era)
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E Value era -> Encoding
forall v. EncodeMint v => v -> Encoding
encodeMint Value era
frge))

bodyFields :: FamsFrom era => 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
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 era -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed 'Dense) (Value era) -> Field (TxBodyRaw era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Value era
x TxBodyRaw era
tx -> TxBodyRaw era
tx {mint :: Value era
mint = Value era
x}) ((forall s. Decoder s (Value era))
-> Decode ('Closed 'Dense) (Value era)
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall s. Decoder s (Value era)
forall v s. DecodeMint v => Decoder s v
decodeMint)
bodyFields Word
n = Word -> Field (TxBodyRaw era)
forall t. Word -> Field t
invalidField Word
n

initial :: (Val (Value era)) => TxBodyRaw era
initial :: TxBodyRaw era
initial =
  Set (TxIn (Crypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (DCert (Crypto era))
-> Wdrl (Crypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> Value era
-> TxBodyRaw era
forall era.
Set (TxIn (Crypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (DCert (Crypto era))
-> Wdrl (Crypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> Value era
-> TxBodyRaw era
TxBodyRaw
    Set (TxIn (Crypto era))
forall a. Set a
empty
    ([TxOut era] -> StrictSeq (TxOut era)
forall a. [a] -> StrictSeq a
fromList [])
    ([DCert (Crypto era)] -> StrictSeq (DCert (Crypto era))
forall a. [a] -> StrictSeq a
fromList [])
    (Map (RewardAcnt (Crypto era)) Coin -> Wdrl (Crypto era)
forall crypto. Map (RewardAcnt crypto) Coin -> Wdrl crypto
Wdrl Map (RewardAcnt (Crypto era)) Coin
forall k a. Map k a
Map.empty)
    (Integer -> Coin
Coin Integer
0)
    (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
    StrictMaybe (AuxiliaryDataHash (Crypto era))
forall a. StrictMaybe a
SNothing
    Value era
forall t. Val t => t
zero

-- ===========================================================================
-- Wrap it all up in a newtype, hiding the insides with a pattern construtor.

newtype TxBody e = TxBodyConstr (MemoBytes (TxBodyRaw e))
  deriving (Typeable)
  deriving newtype (Proxy c -> Proxy index -> TxBody e -> SafeHash c index
TxBody e -> ByteString
(TxBody e -> ByteString)
-> (forall c index.
    HasAlgorithm c =>
    Proxy c -> Proxy index -> TxBody e -> SafeHash c index)
-> SafeToHash (TxBody e)
forall e. TxBody e -> 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 e -> SafeHash c index
forall e c index.
HasAlgorithm c =>
Proxy c -> Proxy index -> TxBody e -> SafeHash c index
makeHashWithExplicitProxys :: Proxy c -> Proxy index -> TxBody e -> SafeHash c index
$cmakeHashWithExplicitProxys :: forall e c index.
HasAlgorithm c =>
Proxy c -> Proxy index -> TxBody e -> SafeHash c index
originalBytes :: TxBody e -> ByteString
$coriginalBytes :: forall e. TxBody e -> ByteString
SafeToHash)

deriving instance Eq (TxBody era)

deriving instance
  (TransValue Show era, Show (PParamsDelta era)) =>
  Show (TxBody era)

deriving instance Generic (TxBody era)

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

deriving newtype instance
  ( NFData (Value era),
    NFData (PParamsDelta era),
    Era era
  ) =>
  NFData (TxBody era)

deriving newtype instance (Typeable era) => ToCBOR (TxBody era)

deriving via
  (Mem (TxBodyRaw era))
  instance
    (FamsFrom era) =>
    FromCBOR (Annotator (TxBody era))

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

-- Make a Pattern so the newtype and the MemoBytes are hidden

pattern TxBody ::
  FamsTo era =>
  Set (TxIn (Crypto era)) ->
  StrictSeq (TxOut era) ->
  StrictSeq (DCert (Crypto era)) ->
  Wdrl (Crypto era) ->
  Coin ->
  ValidityInterval ->
  StrictMaybe (Update era) ->
  StrictMaybe (AuxiliaryDataHash (Crypto era)) ->
  Value era ->
  TxBody era
pattern $bTxBody :: Set (TxIn (Crypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (DCert (Crypto era))
-> Wdrl (Crypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> Value era
-> TxBody era
$mTxBody :: forall r era.
FamsTo era =>
TxBody era
-> (Set (TxIn (Crypto era))
    -> StrictSeq (TxOut era)
    -> StrictSeq (DCert (Crypto era))
    -> Wdrl (Crypto era)
    -> Coin
    -> ValidityInterval
    -> StrictMaybe (Update era)
    -> StrictMaybe (AuxiliaryDataHash (Crypto era))
    -> Value era
    -> r)
-> (Void# -> r)
-> r
TxBody inputs outputs certs wdrls txfee vldt update adHash mint <-
  TxBodyConstr
    ( Memo
        TxBodyRaw {inputs, outputs, certs, wdrls, txfee, vldt, update, adHash, mint}
        _
      )
  where
    TxBody Set (TxIn (Crypto era))
inputs StrictSeq (TxOut era)
outputs StrictSeq (DCert (Crypto era))
certs Wdrl (Crypto era)
wdrls Coin
txfee ValidityInterval
vldt StrictMaybe (Update era)
update StrictMaybe (AuxiliaryDataHash (Crypto era))
adHash Value era
mint =
      MemoBytes (TxBodyRaw era) -> TxBody era
forall e. MemoBytes (TxBodyRaw e) -> TxBody e
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 (Encode ('Closed 'Sparse) (TxBodyRaw era)
 -> MemoBytes (TxBodyRaw era))
-> Encode ('Closed 'Sparse) (TxBodyRaw era)
-> MemoBytes (TxBodyRaw era)
forall a b. (a -> b) -> a -> b
$
          TxBodyRaw era -> Encode ('Closed 'Sparse) (TxBodyRaw era)
forall era.
FamsTo era =>
TxBodyRaw era -> Encode ('Closed 'Sparse) (TxBodyRaw era)
txSparse
            TxBodyRaw :: forall era.
Set (TxIn (Crypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (DCert (Crypto era))
-> Wdrl (Crypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> Value era
-> TxBodyRaw era
TxBodyRaw {Set (TxIn (Crypto era))
inputs :: Set (TxIn (Crypto era))
inputs :: Set (TxIn (Crypto era))
inputs, StrictSeq (TxOut era)
outputs :: StrictSeq (TxOut era)
outputs :: StrictSeq (TxOut era)
outputs, StrictSeq (DCert (Crypto era))
certs :: StrictSeq (DCert (Crypto era))
certs :: StrictSeq (DCert (Crypto era))
certs, Wdrl (Crypto era)
wdrls :: Wdrl (Crypto era)
wdrls :: Wdrl (Crypto era)
wdrls, Coin
txfee :: Coin
txfee :: Coin
txfee, ValidityInterval
vldt :: ValidityInterval
vldt :: ValidityInterval
vldt, StrictMaybe (Update era)
update :: StrictMaybe (Update era)
update :: StrictMaybe (Update era)
update, StrictMaybe (AuxiliaryDataHash (Crypto era))
adHash :: StrictMaybe (AuxiliaryDataHash (Crypto era))
adHash :: StrictMaybe (AuxiliaryDataHash (Crypto era))
adHash, Value era
mint :: Value era
mint :: Value era
mint}

{-# COMPLETE TxBody #-}

-- | This pattern is for deconstruction only but accompanied with fields and
-- projection functions.
pattern TxBody' ::
  Set (TxIn (Crypto era)) ->
  StrictSeq (TxOut era) ->
  StrictSeq (DCert (Crypto era)) ->
  Wdrl (Crypto era) ->
  Coin ->
  ValidityInterval ->
  StrictMaybe (Update era) ->
  StrictMaybe (AuxiliaryDataHash (Crypto era)) ->
  Value era ->
  TxBody era
pattern $mTxBody' :: forall r era.
TxBody era
-> (Set (TxIn (Crypto era))
    -> StrictSeq (TxOut era)
    -> StrictSeq (DCert (Crypto era))
    -> Wdrl (Crypto era)
    -> Coin
    -> ValidityInterval
    -> StrictMaybe (Update era)
    -> StrictMaybe (AuxiliaryDataHash (Crypto era))
    -> Value era
    -> r)
-> (Void# -> r)
-> r
TxBody' {TxBody era -> Set (TxIn (Crypto era))
inputs', TxBody era -> StrictSeq (TxOut era)
outputs', TxBody era -> StrictSeq (DCert (Crypto era))
certs', TxBody era -> Wdrl (Crypto era)
wdrls', TxBody era -> Coin
txfee', TxBody era -> ValidityInterval
vldt', TxBody era -> StrictMaybe (Update era)
update', TxBody era -> StrictMaybe (AuxiliaryDataHash (Crypto era))
adHash', TxBody era -> Value era
mint'} <-
  TxBodyConstr
    ( Memo
        TxBodyRaw
          { inputs = inputs',
            outputs = outputs',
            certs = certs',
            wdrls = wdrls',
            txfee = txfee',
            vldt = vldt',
            update = update',
            adHash = adHash',
            mint = mint'
          }
        _
      )

{-# COMPLETE TxBody' #-}

-- ==================================================================
-- Promote the fields of TxBodyRaw to be fields of TxBody. Either
-- automatically or by hand. Both methods have drawbacks.

{-
instance HasField tag (TxBodyRaw e) c => HasField (tag::Symbol) (TxBody e) c where
   getField (TxBodyConstr (Memo x _)) = getField @tag x

-- The method above autmatically lifts the Hasfield instances from TxBodyRaw to TxBody
-- the problem is, if some other file imports this file, it needs to import both
-- the hidden type TxBodyRaw and its constructors like this
-- import Cardano.Ledger.ShelleyMA.TxBody(TxBodyRaw(..))     OR
-- import qualified Cardano.Ledger.ShelleyMA.TxBody as XXX
-- Both are very ugly, but at least in the second way, one doesn't need to know the name of TxBodyRaw
-- So instead we tediously write by hand explicit HasField instances for TxBody
-}

-- ========================================
-- WellFormed era (and a few other) instances

instance Crypto era ~ crypto => HasField "inputs" (TxBody era) (Set (TxIn crypto)) where
  getField :: TxBody era -> Set (TxIn crypto)
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> Set (TxIn crypto)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"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 k (x :: k) r a. HasField x r a => r -> a
getField @"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)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"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
forall k (x :: k) r a. HasField x r a => r -> a
getField @"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 k (x :: k) r a. HasField x r a => r -> a
getField @"txfee" 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 k (x :: k) r a. HasField x r a => r -> a
getField @"vldt" 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 k (x :: k) r a. HasField x r a => r -> a
getField @"update" TxBodyRaw era
m

instance
  Crypto era ~ crypto =>
  HasField "adHash" (TxBody era) (StrictMaybe (AuxiliaryDataHash crypto))
  where
  getField :: TxBody era -> StrictMaybe (AuxiliaryDataHash crypto)
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> StrictMaybe (AuxiliaryDataHash crypto)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"adHash" TxBodyRaw era
m

instance Value era ~ value => HasField "mint" (TxBody era) value where
  getField :: TxBody era -> value
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> value
forall k (x :: k) r a. HasField x r a => r -> a
getField @"mint" TxBodyRaw era
m