{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Shelley.TxBody (
  ShelleyTxBody (
    ShelleyTxBody,
    TxBodyConstr,
    stbInputs,
    stbOutputs,
    stbCerts,
    stbWithdrawals,
    stbTxFee,
    stbTTL,
    stbUpdate,
    stbMDHash
  ),
  ShelleyEraTxBody (..),
  ShelleyTxBodyRaw (..),
  EraIndependentTxBody,
  RewardAccount (..),
  Withdrawals (..),
  getShelleyGenesisKeyHashCountTxBody,
) where

import Cardano.Ledger.Address (RewardAccount (..), Withdrawals (..))
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.Binary (
  Annotator (..),
  DecCBOR (decCBOR),
  EncCBOR (..),
  ToCBOR (..),
 )
import Cardano.Ledger.Binary.Coders (
  Decode (..),
  Density (..),
  Encode (..),
  Field,
  Wrapped (..),
  decode,
  encode,
  encodeKeyedStrictMaybe,
  field,
  invalidField,
  ofield,
  (!>),
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Core
import Cardano.Ledger.MemoBytes (
  EqRaw (..),
  Mem,
  MemoBytes,
  MemoHashIndex,
  Memoized (..),
  getMemoRawType,
  getMemoSafeHash,
  lensMemoRawType,
  mkMemoized,
 )
import Cardano.Ledger.Shelley.Era (ShelleyEra)
import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates (..), Update (..))
import Cardano.Ledger.Shelley.TxCert (ShelleyEraTxCert (..))
import Cardano.Ledger.Shelley.TxOut ()
import Cardano.Ledger.Slot (SlotNo (..))
import Cardano.Ledger.TxIn (TxIn)
import Control.DeepSeq (NFData)
import qualified Data.Map.Strict as Map
import Data.Sequence.Strict (StrictSeq)
import qualified Data.Sequence.Strict as StrictSeq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks (..))

class (ShelleyEraTxCert era, EraTxBody era, ProtVerAtMost era 8) => ShelleyEraTxBody era where
  ttlTxBodyL :: ExactEra ShelleyEra era => Lens' (TxBody era) SlotNo

  updateTxBodyL :: Lens' (TxBody era) (StrictMaybe (Update era))

-- ==============================
-- The underlying type for TxBody

data ShelleyTxBodyRaw era = ShelleyTxBodyRaw
  { forall era. ShelleyTxBodyRaw era -> Set TxIn
stbrInputs :: !(Set TxIn)
  , forall era. ShelleyTxBodyRaw era -> StrictSeq (TxOut era)
stbrOutputs :: !(StrictSeq (TxOut era))
  , forall era. ShelleyTxBodyRaw era -> StrictSeq (TxCert era)
stbrCerts :: !(StrictSeq (TxCert era))
  , forall era. ShelleyTxBodyRaw era -> Withdrawals
stbrWithdrawals :: !Withdrawals
  , forall era. ShelleyTxBodyRaw era -> Coin
stbrTxFee :: !Coin
  , forall era. ShelleyTxBodyRaw era -> SlotNo
stbrTTL :: !SlotNo
  , forall era. ShelleyTxBodyRaw era -> StrictMaybe (Update era)
stbrUpdate :: !(StrictMaybe (Update era))
  , forall era. ShelleyTxBodyRaw era -> StrictMaybe TxAuxDataHash
stbrMDHash :: !(StrictMaybe TxAuxDataHash)
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ShelleyTxBodyRaw era) x -> ShelleyTxBodyRaw era
forall era x. ShelleyTxBodyRaw era -> Rep (ShelleyTxBodyRaw era) x
$cto :: forall era x. Rep (ShelleyTxBodyRaw era) x -> ShelleyTxBodyRaw era
$cfrom :: forall era x. ShelleyTxBodyRaw era -> Rep (ShelleyTxBodyRaw era) x
Generic, Typeable)

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

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

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

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

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

instance
  ( Era era
  , DecCBOR (PParamsUpdate era)
  , DecCBOR (TxOut era)
  , DecCBOR (TxCert era)
  ) =>
  DecCBOR (ShelleyTxBodyRaw era)
  where
  decCBOR :: forall s. Decoder s (ShelleyTxBodyRaw era)
decCBOR =
    forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode
      ( forall t.
Typeable t =>
String
-> t
-> (Word -> Field t)
-> [(Word, String)]
-> Decode ('Closed 'Dense) t
SparseKeyed
          String
"TxBody"
          forall era. ShelleyTxBodyRaw era
basicShelleyTxBodyRaw
          forall era.
(Era era, DecCBOR (PParamsUpdate era), DecCBOR (TxOut era),
 DecCBOR (TxCert era)) =>
Word -> Field (ShelleyTxBodyRaw era)
boxBody
          [(Word
0, String
"inputs"), (Word
1, String
"outputs"), (Word
2, String
"fee"), (Word
3, String
"ttl")]
      )

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

-- =================================================================
-- Composable components for building TxBody optional sparse serialisers.
-- The order of serializing optional fields, and their key values is
-- demanded by backward compatibility concerns.

-- | Choose a de-serialiser when given the key (of type Word).
--   Wrap it in a Field which pairs it with its update function which
--   changes only the field being deserialised.
boxBody ::
  ( Era era
  , DecCBOR (PParamsUpdate era)
  , DecCBOR (TxOut era)
  , DecCBOR (TxCert era)
  ) =>
  Word ->
  Field (ShelleyTxBodyRaw era)
boxBody :: forall era.
(Era era, DecCBOR (PParamsUpdate era), DecCBOR (TxOut era),
 DecCBOR (TxCert era)) =>
Word -> Field (ShelleyTxBodyRaw era)
boxBody Word
0 = forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Set TxIn
x ShelleyTxBodyRaw era
tx -> ShelleyTxBodyRaw era
tx {stbrInputs :: Set TxIn
stbrInputs = Set TxIn
x}) forall t (w :: Wrapped). DecCBOR t => Decode w t
From
boxBody Word
1 = forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\StrictSeq (TxOut era)
x ShelleyTxBodyRaw era
tx -> ShelleyTxBodyRaw era
tx {stbrOutputs :: StrictSeq (TxOut era)
stbrOutputs = StrictSeq (TxOut era)
x}) forall t (w :: Wrapped). DecCBOR t => Decode w t
From
boxBody Word
4 = forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\StrictSeq (TxCert era)
x ShelleyTxBodyRaw era
tx -> ShelleyTxBodyRaw era
tx {stbrCerts :: StrictSeq (TxCert era)
stbrCerts = StrictSeq (TxCert era)
x}) forall t (w :: Wrapped). DecCBOR t => Decode w t
From
boxBody Word
5 = forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Withdrawals
x ShelleyTxBodyRaw era
tx -> ShelleyTxBodyRaw era
tx {stbrWithdrawals :: Withdrawals
stbrWithdrawals = Withdrawals
x}) forall t (w :: Wrapped). DecCBOR t => Decode w t
From
boxBody Word
2 = forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Coin
x ShelleyTxBodyRaw era
tx -> ShelleyTxBodyRaw era
tx {stbrTxFee :: Coin
stbrTxFee = Coin
x}) forall t (w :: Wrapped). DecCBOR t => Decode w t
From
boxBody Word
3 = forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\SlotNo
x ShelleyTxBodyRaw era
tx -> ShelleyTxBodyRaw era
tx {stbrTTL :: SlotNo
stbrTTL = SlotNo
x}) forall t (w :: Wrapped). DecCBOR t => Decode w t
From
boxBody Word
6 = forall x t (d :: Density).
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield (\StrictMaybe (Update era)
x ShelleyTxBodyRaw era
tx -> ShelleyTxBodyRaw era
tx {stbrUpdate :: StrictMaybe (Update era)
stbrUpdate = StrictMaybe (Update era)
x}) forall t (w :: Wrapped). DecCBOR t => Decode w t
From
boxBody Word
7 = forall x t (d :: Density).
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield (\StrictMaybe TxAuxDataHash
x ShelleyTxBodyRaw era
tx -> ShelleyTxBodyRaw era
tx {stbrMDHash :: StrictMaybe TxAuxDataHash
stbrMDHash = StrictMaybe TxAuxDataHash
x}) forall t (w :: Wrapped). DecCBOR t => Decode w t
From
boxBody Word
n = forall t. Word -> Field t
invalidField Word
n

-- | Tells how to serialise each field, and what tag to label it with in the
--   serialisation. boxBody and txSparse should be Duals, visually inspect
--   The key order looks strange but was choosen for backward compatibility.
txSparse ::
  (Era era, EncCBOR (TxOut era), EncCBOR (TxCert era), EncCBOR (PParamsUpdate era)) =>
  ShelleyTxBodyRaw era ->
  Encode ('Closed 'Sparse) (ShelleyTxBodyRaw era)
txSparse :: forall era.
(Era era, EncCBOR (TxOut era), EncCBOR (TxCert era),
 EncCBOR (PParamsUpdate era)) =>
ShelleyTxBodyRaw era
-> Encode ('Closed 'Sparse) (ShelleyTxBodyRaw era)
txSparse (ShelleyTxBodyRaw Set TxIn
input StrictSeq (TxOut era)
output StrictSeq (TxCert era)
cert Withdrawals
wdrl Coin
fee SlotNo
ttl StrictMaybe (Update era)
update StrictMaybe TxAuxDataHash
hash) =
  forall t. t -> Encode ('Closed 'Sparse) t
Keyed (\Set TxIn
i StrictSeq (TxOut era)
o Coin
f SlotNo
t StrictSeq (TxCert era)
c Withdrawals
w StrictMaybe (Update era)
u StrictMaybe TxAuxDataHash
h -> forall era.
Set TxIn
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe TxAuxDataHash
-> ShelleyTxBodyRaw era
ShelleyTxBodyRaw Set TxIn
i StrictSeq (TxOut era)
o StrictSeq (TxCert era)
c Withdrawals
w Coin
f SlotNo
t StrictMaybe (Update era)
u StrictMaybe TxAuxDataHash
h)
    forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
0 (forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set TxIn
input) -- We don't have to send these in ShelleyTxBodyRaw order
    forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
1 (forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictSeq (TxOut era)
output) -- Just hack up a fake constructor with the lambda.
    forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
2 (forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
fee)
    forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
3 (forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To SlotNo
ttl)
    forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
4 (forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictSeq (TxCert era)
cert))
    forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. Withdrawals -> Map RewardAccount Coin
unWithdrawals) (forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
5 (forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Withdrawals
wdrl))
    forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall a.
EncCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
6 StrictMaybe (Update era)
update
    forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall a.
EncCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
7 StrictMaybe TxAuxDataHash
hash

-- The initial TxBody. We will overide some of these fields as we build a TxBody,
-- adding one field at a time, using optional serialisers, inside the Pattern.
basicShelleyTxBodyRaw :: ShelleyTxBodyRaw era
basicShelleyTxBodyRaw :: forall era. ShelleyTxBodyRaw era
basicShelleyTxBodyRaw =
  ShelleyTxBodyRaw
    { stbrInputs :: Set TxIn
stbrInputs = forall a. Set a
Set.empty
    , stbrOutputs :: StrictSeq (TxOut era)
stbrOutputs = forall a. StrictSeq a
StrictSeq.empty
    , stbrTxFee :: Coin
stbrTxFee = Integer -> Coin
Coin Integer
0
    , stbrTTL :: SlotNo
stbrTTL = Word64 -> SlotNo
SlotNo forall a. Bounded a => a
maxBound -- transaction is eternally valid by default
    , stbrCerts :: StrictSeq (TxCert era)
stbrCerts = forall a. StrictSeq a
StrictSeq.empty
    , stbrWithdrawals :: Withdrawals
stbrWithdrawals = Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty
    , stbrUpdate :: StrictMaybe (Update era)
stbrUpdate = forall a. StrictMaybe a
SNothing
    , stbrMDHash :: StrictMaybe TxAuxDataHash
stbrMDHash = forall a. StrictMaybe a
SNothing
    }

instance
  (Era era, EncCBOR (TxOut era), EncCBOR (TxCert era), EncCBOR (PParamsUpdate era)) =>
  EncCBOR (ShelleyTxBodyRaw era)
  where
  encCBOR :: ShelleyTxBodyRaw era -> Encoding
encCBOR = forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(Era era, EncCBOR (TxOut era), EncCBOR (TxCert era),
 EncCBOR (PParamsUpdate era)) =>
ShelleyTxBodyRaw era
-> Encode ('Closed 'Sparse) (ShelleyTxBodyRaw era)
txSparse

-- ====================================================
-- Introduce ShelleyTxBody as a newtype around a MemoBytes

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

instance Memoized ShelleyTxBody where
  type RawType ShelleyTxBody = ShelleyTxBodyRaw

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

instance EraTxBody ShelleyEra where
  type TxBody ShelleyEra = ShelleyTxBody ShelleyEra

  mkBasicTxBody :: TxBody ShelleyEra
mkBasicTxBody = forall era (t :: * -> *).
(Era era, EncCBOR (RawType t era), Memoized t) =>
RawType t era -> t era
mkMemoized forall era. ShelleyTxBodyRaw era
basicShelleyTxBodyRaw

  spendableInputsTxBodyF :: SimpleGetter (TxBody ShelleyEra) (Set TxIn)
spendableInputsTxBodyF = forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
inputsTxBodyL
  {-# INLINE spendableInputsTxBodyF #-}

  allInputsTxBodyF :: SimpleGetter (TxBody ShelleyEra) (Set TxIn)
allInputsTxBodyF = forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
inputsTxBodyL
  {-# INLINE allInputsTxBodyF #-}

  inputsTxBodyL :: Lens' (TxBody ShelleyEra) (Set TxIn)
inputsTxBodyL =
    forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. ShelleyTxBodyRaw era -> Set TxIn
stbrInputs forall a b. (a -> b) -> a -> b
$ \RawType ShelleyTxBody ShelleyEra
txBodyRaw Set TxIn
inputs -> RawType ShelleyTxBody ShelleyEra
txBodyRaw {stbrInputs :: Set TxIn
stbrInputs = Set TxIn
inputs}
  {-# INLINEABLE inputsTxBodyL #-}

  outputsTxBodyL :: Lens' (TxBody ShelleyEra) (StrictSeq (TxOut ShelleyEra))
outputsTxBodyL =
    forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. ShelleyTxBodyRaw era -> StrictSeq (TxOut era)
stbrOutputs forall a b. (a -> b) -> a -> b
$ \RawType ShelleyTxBody ShelleyEra
txBodyRaw StrictSeq (TxOut ShelleyEra)
outputs -> RawType ShelleyTxBody ShelleyEra
txBodyRaw {stbrOutputs :: StrictSeq (TxOut ShelleyEra)
stbrOutputs = StrictSeq (TxOut ShelleyEra)
outputs}
  {-# INLINEABLE outputsTxBodyL #-}

  feeTxBodyL :: Lens' (TxBody ShelleyEra) Coin
feeTxBodyL =
    forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. ShelleyTxBodyRaw era -> Coin
stbrTxFee forall a b. (a -> b) -> a -> b
$ \RawType ShelleyTxBody ShelleyEra
txBodyRaw Coin
fee -> RawType ShelleyTxBody ShelleyEra
txBodyRaw {stbrTxFee :: Coin
stbrTxFee = Coin
fee}
  {-# INLINEABLE feeTxBodyL #-}

  auxDataHashTxBodyL :: Lens' (TxBody ShelleyEra) (StrictMaybe TxAuxDataHash)
auxDataHashTxBodyL =
    forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. ShelleyTxBodyRaw era -> StrictMaybe TxAuxDataHash
stbrMDHash forall a b. (a -> b) -> a -> b
$ \RawType ShelleyTxBody ShelleyEra
txBodyRaw StrictMaybe TxAuxDataHash
auxDataHash -> RawType ShelleyTxBody ShelleyEra
txBodyRaw {stbrMDHash :: StrictMaybe TxAuxDataHash
stbrMDHash = StrictMaybe TxAuxDataHash
auxDataHash}
  {-# INLINEABLE auxDataHashTxBodyL #-}

  withdrawalsTxBodyL :: Lens' (TxBody ShelleyEra) Withdrawals
withdrawalsTxBodyL =
    forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. ShelleyTxBodyRaw era -> Withdrawals
stbrWithdrawals forall a b. (a -> b) -> a -> b
$ \RawType ShelleyTxBody ShelleyEra
txBodyRaw Withdrawals
withdrawals -> RawType ShelleyTxBody ShelleyEra
txBodyRaw {stbrWithdrawals :: Withdrawals
stbrWithdrawals = Withdrawals
withdrawals}
  {-# INLINEABLE withdrawalsTxBodyL #-}

  certsTxBodyL :: Lens' (TxBody ShelleyEra) (StrictSeq (TxCert ShelleyEra))
certsTxBodyL =
    forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. ShelleyTxBodyRaw era -> StrictSeq (TxCert era)
stbrCerts forall a b. (a -> b) -> a -> b
$ \RawType ShelleyTxBody ShelleyEra
txBodyRaw StrictSeq (TxCert ShelleyEra)
certs -> RawType ShelleyTxBody ShelleyEra
txBodyRaw {stbrCerts :: StrictSeq (TxCert ShelleyEra)
stbrCerts = StrictSeq (TxCert ShelleyEra)
certs}
  {-# INLINEABLE certsTxBodyL #-}

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

  upgradeTxBody :: EraTxBody (PreviousEra ShelleyEra) =>
TxBody (PreviousEra ShelleyEra)
-> Either (TxBodyUpgradeError ShelleyEra) (TxBody ShelleyEra)
upgradeTxBody =
    forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$
      String
"Calling this function will cause a compilation error, "
        forall a. [a] -> [a] -> [a]
++ String
"since there is no TxBody instance for ByronEra"

instance ShelleyEraTxBody ShelleyEra where
  ttlTxBodyL :: ExactEra ShelleyEra ShelleyEra => Lens' (TxBody ShelleyEra) SlotNo
ttlTxBodyL =
    forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. ShelleyTxBodyRaw era -> SlotNo
stbrTTL forall a b. (a -> b) -> a -> b
$ \RawType ShelleyTxBody ShelleyEra
txBodyRaw SlotNo
ttl -> RawType ShelleyTxBody ShelleyEra
txBodyRaw {stbrTTL :: SlotNo
stbrTTL = SlotNo
ttl}
  {-# INLINEABLE ttlTxBodyL #-}

  updateTxBodyL :: Lens' (TxBody ShelleyEra) (StrictMaybe (Update ShelleyEra))
updateTxBodyL =
    forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. ShelleyTxBodyRaw era -> StrictMaybe (Update era)
stbrUpdate forall a b. (a -> b) -> a -> b
$ \RawType ShelleyTxBody ShelleyEra
txBodyRaw StrictMaybe (Update ShelleyEra)
update -> RawType ShelleyTxBody ShelleyEra
txBodyRaw {stbrUpdate :: StrictMaybe (Update ShelleyEra)
stbrUpdate = StrictMaybe (Update ShelleyEra)
update}
  {-# INLINEABLE updateTxBodyL #-}

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

deriving newtype instance EraTxBody era => NFData (ShelleyTxBody era)

deriving instance EraTxBody era => Show (ShelleyTxBody era)

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

deriving via
  Mem ShelleyTxBodyRaw era
  instance
    EraTxBody era => DecCBOR (Annotator (ShelleyTxBody era))

-- | Pattern for use by external users
pattern ShelleyTxBody ::
  (EraTxOut era, EncCBOR (TxCert era)) =>
  Set TxIn ->
  StrictSeq (TxOut era) ->
  StrictSeq (TxCert era) ->
  Withdrawals ->
  Coin ->
  SlotNo ->
  StrictMaybe (Update era) ->
  StrictMaybe TxAuxDataHash ->
  ShelleyTxBody era
pattern $bShelleyTxBody :: forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
Set TxIn
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe TxAuxDataHash
-> ShelleyTxBody era
$mShelleyTxBody :: forall {r} {era}.
(EraTxOut era, EncCBOR (TxCert era)) =>
ShelleyTxBody era
-> (Set TxIn
    -> StrictSeq (TxOut era)
    -> StrictSeq (TxCert era)
    -> Withdrawals
    -> Coin
    -> SlotNo
    -> StrictMaybe (Update era)
    -> StrictMaybe TxAuxDataHash
    -> r)
-> ((# #) -> r)
-> r
ShelleyTxBody
  { forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
ShelleyTxBody era -> Set TxIn
stbInputs
  , forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
ShelleyTxBody era -> StrictSeq (TxOut era)
stbOutputs
  , forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
ShelleyTxBody era -> StrictSeq (TxCert era)
stbCerts
  , forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
ShelleyTxBody era -> Withdrawals
stbWithdrawals
  , forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
ShelleyTxBody era -> Coin
stbTxFee
  , forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
ShelleyTxBody era -> SlotNo
stbTTL
  , forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
ShelleyTxBody era -> StrictMaybe (Update era)
stbUpdate
  , forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
ShelleyTxBody era -> StrictMaybe TxAuxDataHash
stbMDHash
  } <-
  ( getMemoRawType ->
      ShelleyTxBodyRaw
        { stbrInputs = stbInputs
        , stbrOutputs = stbOutputs
        , stbrCerts = stbCerts
        , stbrWithdrawals = stbWithdrawals
        , stbrTxFee = stbTxFee
        , stbrTTL = stbTTL
        , stbrUpdate = stbUpdate
        , stbrMDHash = stbMDHash
        }
    )
  where
    ShelleyTxBody
      Set TxIn
inputs
      StrictSeq (TxOut era)
outputs
      StrictSeq (TxCert era)
certs
      Withdrawals
withdrawals
      Coin
txFee
      SlotNo
ttl
      StrictMaybe (Update era)
update
      StrictMaybe TxAuxDataHash
mDHash =
        forall era (t :: * -> *).
(Era era, EncCBOR (RawType t era), Memoized t) =>
RawType t era -> t era
mkMemoized forall a b. (a -> b) -> a -> b
$
          ShelleyTxBodyRaw
            { stbrInputs :: Set TxIn
stbrInputs = Set TxIn
inputs
            , stbrOutputs :: StrictSeq (TxOut era)
stbrOutputs = StrictSeq (TxOut era)
outputs
            , stbrCerts :: StrictSeq (TxCert era)
stbrCerts = StrictSeq (TxCert era)
certs
            , stbrWithdrawals :: Withdrawals
stbrWithdrawals = Withdrawals
withdrawals
            , stbrTxFee :: Coin
stbrTxFee = Coin
txFee
            , stbrTTL :: SlotNo
stbrTTL = SlotNo
ttl
            , stbrUpdate :: StrictMaybe (Update era)
stbrUpdate = StrictMaybe (Update era)
update
            , stbrMDHash :: StrictMaybe TxAuxDataHash
stbrMDHash = StrictMaybe TxAuxDataHash
mDHash
            }

{-# COMPLETE ShelleyTxBody #-}

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

type instance MemoHashIndex ShelleyTxBodyRaw = EraIndependentTxBody

instance Era era => HashAnnotated (ShelleyTxBody era) EraIndependentTxBody where
  hashAnnotated :: ShelleyTxBody era -> SafeHash EraIndependentTxBody
hashAnnotated = forall (t :: * -> *) era.
Memoized t =>
t era -> SafeHash (MemoHashIndex (RawType t))
getMemoSafeHash

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

-- | Count number of Genesis keys supplied in the `updateTxBodyL` field.
getShelleyGenesisKeyHashCountTxBody :: ShelleyEraTxBody era => TxBody era -> Int
getShelleyGenesisKeyHashCountTxBody :: forall era. ShelleyEraTxBody era => TxBody era -> Int
getShelleyGenesisKeyHashCountTxBody TxBody era
txBody =
  case TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
updateTxBodyL of
    SJust (Update (ProposedPPUpdates Map (KeyHash 'Genesis) (PParamsUpdate era)
m) EpochNo
_) -> forall k a. Map k a -> Int
Map.size Map (KeyHash 'Genesis) (PParamsUpdate era)
m
    StrictMaybe (Update era)
_ -> Int
0