{-# 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,

  -- * Deprecations
  RewardAcnt,
) where

import Cardano.Ledger.Address (RewardAccount (..), RewardAcnt, Withdrawals (..))
import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash)
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.Crypto (Crypto, StandardCrypto)
import Cardano.Ledger.MemoBytes (
  EqRaw (..),
  Mem,
  MemoBytes,
  MemoHashIndex,
  Memoized (..),
  getMemoRawType,
  getMemoSafeHash,
  lensMemoRawType,
  mkMemoized,
 )
import Cardano.Ledger.SafeHash (HashAnnotated (..), SafeToHash)
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 (EraCrypto era))
stbrInputs :: !(Set (TxIn (EraCrypto era)))
  , 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 (EraCrypto era)
stbrWithdrawals :: !(Withdrawals (EraCrypto era))
  , 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 (AuxiliaryDataHash (EraCrypto era))
stbrMDHash :: !(StrictMaybe (AuxiliaryDataHash (EraCrypto era)))
  }
  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 (EraCrypto era))
x ShelleyTxBodyRaw era
tx -> ShelleyTxBodyRaw era
tx {stbrInputs :: Set (TxIn (EraCrypto era))
stbrInputs = Set (TxIn (EraCrypto era))
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 (EraCrypto era)
x ShelleyTxBodyRaw era
tx -> ShelleyTxBodyRaw era
tx {stbrWithdrawals :: Withdrawals (EraCrypto era)
stbrWithdrawals = Withdrawals (EraCrypto era)
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 (AuxiliaryDataHash (EraCrypto era))
x ShelleyTxBodyRaw era
tx -> ShelleyTxBodyRaw era
tx {stbrMDHash :: StrictMaybe (AuxiliaryDataHash (EraCrypto era))
stbrMDHash = StrictMaybe (AuxiliaryDataHash (EraCrypto era))
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 (EraCrypto era))
input StrictSeq (TxOut era)
output StrictSeq (TxCert era)
cert Withdrawals (EraCrypto era)
wdrl Coin
fee SlotNo
ttl StrictMaybe (Update era)
update StrictMaybe (AuxiliaryDataHash (EraCrypto era))
hash) =
  forall t. t -> Encode ('Closed 'Sparse) t
Keyed (\Set (TxIn (EraCrypto era))
i StrictSeq (TxOut era)
o Coin
f SlotNo
t StrictSeq (TxCert era)
c Withdrawals (EraCrypto era)
w StrictMaybe (Update era)
u StrictMaybe (AuxiliaryDataHash (EraCrypto era))
h -> forall era.
Set (TxIn (EraCrypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals (EraCrypto era)
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
-> ShelleyTxBodyRaw era
ShelleyTxBodyRaw Set (TxIn (EraCrypto era))
i StrictSeq (TxOut era)
o StrictSeq (TxCert era)
c Withdrawals (EraCrypto era)
w Coin
f SlotNo
t StrictMaybe (Update era)
u StrictMaybe (AuxiliaryDataHash (EraCrypto era))
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 (EraCrypto era))
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
. forall c. Withdrawals c -> Map (RewardAcnt c) Coin
unWithdrawals) (forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
5 (forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Withdrawals (EraCrypto era)
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 (AuxiliaryDataHash (EraCrypto era))
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 (EraCrypto era))
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 (EraCrypto era)
stbrWithdrawals = forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty
    , stbrUpdate :: StrictMaybe (Update era)
stbrUpdate = forall a. StrictMaybe a
SNothing
    , stbrMDHash :: StrictMaybe (AuxiliaryDataHash (EraCrypto era))
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, Typeable)
  deriving newtype (ShelleyTxBody era -> Int
ShelleyTxBody era -> ByteString
forall era. ShelleyTxBody era -> Int
forall era. ShelleyTxBody era -> ByteString
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall c index.
    HashAlgorithm (HASH c) =>
    Proxy c -> Proxy index -> t -> SafeHash c index)
-> SafeToHash t
forall c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> ShelleyTxBody era -> SafeHash c index
forall era c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> ShelleyTxBody era -> SafeHash c index
makeHashWithExplicitProxys :: forall c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> ShelleyTxBody era -> SafeHash c index
$cmakeHashWithExplicitProxys :: forall era c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> ShelleyTxBody era -> SafeHash c index
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 Crypto c => EraTxBody (ShelleyEra c) where
  {-# SPECIALIZE instance EraTxBody (ShelleyEra StandardCrypto) #-}

  type TxBody (ShelleyEra c) = ShelleyTxBody (ShelleyEra c)

  mkBasicTxBody :: TxBody (ShelleyEra c)
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 c)) (Set (TxIn (EraCrypto (ShelleyEra c))))
spendableInputsTxBodyF = forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
inputsTxBodyL
  {-# INLINE spendableInputsTxBodyF #-}

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

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

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

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

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

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

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

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

  upgradeTxBody :: EraTxBody (PreviousEra (ShelleyEra c)) =>
TxBody (PreviousEra (ShelleyEra c))
-> Either
     (TxBodyUpgradeError (ShelleyEra c)) (TxBody (ShelleyEra c))
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 Crypto c => ShelleyEraTxBody (ShelleyEra c) where
  {-# SPECIALIZE instance ShelleyEraTxBody (ShelleyEra StandardCrypto) #-}

  ttlTxBodyL :: ExactEra ShelleyEra (ShelleyEra c) =>
Lens' (TxBody (ShelleyEra c)) 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 c)
txBodyRaw SlotNo
ttl -> RawType ShelleyTxBody (ShelleyEra c)
txBodyRaw {stbrTTL :: SlotNo
stbrTTL = SlotNo
ttl}
  {-# INLINEABLE ttlTxBodyL #-}

  updateTxBodyL :: Lens' (TxBody (ShelleyEra c)) (StrictMaybe (Update (ShelleyEra c)))
updateTxBodyL =
    forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. ShelleyTxBodyRaw era -> StrictMaybe (Update era)
stbrUpdate forall a b. (a -> b) -> a -> b
$ \RawType ShelleyTxBody (ShelleyEra c)
txBodyRaw StrictMaybe (Update (ShelleyEra c))
update -> RawType ShelleyTxBody (ShelleyEra c)
txBodyRaw {stbrUpdate :: StrictMaybe (Update (ShelleyEra c))
stbrUpdate = StrictMaybe (Update (ShelleyEra c))
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 (EraCrypto era)) ->
  StrictSeq (TxOut era) ->
  StrictSeq (TxCert era) ->
  Withdrawals (EraCrypto era) ->
  Coin ->
  SlotNo ->
  StrictMaybe (Update era) ->
  StrictMaybe (AuxiliaryDataHash (EraCrypto era)) ->
  ShelleyTxBody era
pattern $bShelleyTxBody :: forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
Set (TxIn (EraCrypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals (EraCrypto era)
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
-> ShelleyTxBody era
$mShelleyTxBody :: forall {r} {era}.
(EraTxOut era, EncCBOR (TxCert era)) =>
ShelleyTxBody era
-> (Set (TxIn (EraCrypto era))
    -> StrictSeq (TxOut era)
    -> StrictSeq (TxCert era)
    -> Withdrawals (EraCrypto era)
    -> Coin
    -> SlotNo
    -> StrictMaybe (Update era)
    -> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
    -> r)
-> ((# #) -> r)
-> r
ShelleyTxBody
  { forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
ShelleyTxBody era -> Set (TxIn (EraCrypto era))
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 (EraCrypto era)
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 (AuxiliaryDataHash (EraCrypto era))
stbMDHash
  } <-
  ( getMemoRawType ->
      ShelleyTxBodyRaw
        { stbrInputs = stbInputs
        , stbrOutputs = stbOutputs
        , stbrCerts = stbCerts
        , stbrWithdrawals = stbWithdrawals
        , stbrTxFee = stbTxFee
        , stbrTTL = stbTTL
        , stbrUpdate = stbUpdate
        , stbrMDHash = stbMDHash
        }
    )
  where
    ShelleyTxBody
      Set (TxIn (EraCrypto era))
inputs
      StrictSeq (TxOut era)
outputs
      StrictSeq (TxCert era)
certs
      Withdrawals (EraCrypto era)
withdrawals
      Coin
txFee
      SlotNo
ttl
      StrictMaybe (Update era)
update
      StrictMaybe (AuxiliaryDataHash (EraCrypto era))
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 (EraCrypto era))
stbrInputs = Set (TxIn (EraCrypto era))
inputs
            , stbrOutputs :: StrictSeq (TxOut era)
stbrOutputs = StrictSeq (TxOut era)
outputs
            , stbrCerts :: StrictSeq (TxCert era)
stbrCerts = StrictSeq (TxCert era)
certs
            , stbrWithdrawals :: Withdrawals (EraCrypto era)
stbrWithdrawals = Withdrawals (EraCrypto era)
withdrawals
            , stbrTxFee :: Coin
stbrTxFee = Coin
txFee
            , stbrTTL :: SlotNo
stbrTTL = SlotNo
ttl
            , stbrUpdate :: StrictMaybe (Update era)
stbrUpdate = StrictMaybe (Update era)
update
            , stbrMDHash :: StrictMaybe (AuxiliaryDataHash (EraCrypto era))
stbrMDHash = StrictMaybe (AuxiliaryDataHash (EraCrypto era))
mDHash
            }

{-# COMPLETE ShelleyTxBody #-}

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

type instance MemoHashIndex ShelleyTxBodyRaw = EraIndependentTxBody

instance
  (Era era, c ~ EraCrypto era) =>
  HashAnnotated (ShelleyTxBody era) EraIndependentTxBody c
  where
  hashAnnotated :: HashAlgorithm (HASH c) =>
ShelleyTxBody era -> SafeHash c EraIndependentTxBody
hashAnnotated = forall (t :: * -> *) era.
Memoized t =>
t era -> SafeHash (EraCrypto era) (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 (EraCrypto era)) (PParamsUpdate era)
m) EpochNo
_) -> forall k a. Map k a -> Int
Map.size Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdate era)
m
    StrictMaybe (Update era)
_ -> Int
0