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

-- | Provides Allegra TxBody internals
--
-- = Warning
--
-- This module is considered __internal__.
--
-- The contents of this module may change __in any way whatsoever__
-- and __without any warning__ between minor versions of this package.
module Cardano.Ledger.Allegra.TxBody.Internal (
  AllegraEraTxBody (..),
  AllegraTxBody (
    ..,
    AllegraTxBody,
    atbAuxDataHash,
    atbCerts,
    atbInputs,
    atbOutputs,
    atbTxFee,
    atbUpdate,
    atbValidityInterval,
    atbWithdrawals
  ),
  emptyAllegraTxBodyRaw,
  AllegraTxBodyRaw (..),
  StrictMaybe (..),
  ValidityInterval (..),
)
where

import Cardano.Ledger.Allegra.Era (AllegraEra)
import Cardano.Ledger.Allegra.Scripts (ValidityInterval (..))
import Cardano.Ledger.Allegra.TxCert ()
import Cardano.Ledger.Allegra.TxOut ()
import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash)
import Cardano.Ledger.BaseTypes (SlotNo, StrictMaybe (SJust, SNothing))
import Cardano.Ledger.Binary (Annotator, DecCBOR (..), EncCBOR (..), ToCBOR)
import Cardano.Ledger.Binary.Coders (
  Decode (..),
  Encode (..),
  Field,
  decode,
  encode,
  encodeKeyedStrictMaybe,
  field,
  invalidField,
  ofield,
  (!>),
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Compactible (Compactible (..))
import Cardano.Ledger.Core
import Cardano.Ledger.Crypto (Crypto, StandardCrypto)
import Cardano.Ledger.MemoBytes (
  EqRaw,
  Mem,
  MemoBytes,
  MemoHashIndex,
  Memoized (RawType),
  getMemoRawType,
  getMemoSafeHash,
  lensMemoRawType,
  mkMemoized,
 )
import Cardano.Ledger.SafeHash (HashAnnotated (..), SafeToHash)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.PParams (Update (..), upgradeUpdate)
import Cardano.Ledger.Shelley.TxBody (getShelleyGenesisKeyHashCountTxBody)
import Cardano.Ledger.TxIn (TxIn (..))
import Control.DeepSeq (NFData (..))
import qualified Data.Map.Strict as Map
import Data.Sequence.Strict (StrictSeq, fromList)
import Data.Set (Set, empty)
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks (..))

class EraTxBody era => AllegraEraTxBody era where
  vldtTxBodyL :: Lens' (TxBody era) ValidityInterval

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

data AllegraTxBodyRaw ma era = AllegraTxBodyRaw
  { forall ma era.
AllegraTxBodyRaw ma era -> Set (TxIn (EraCrypto era))
atbrInputs :: !(Set (TxIn (EraCrypto era)))
  , forall ma era. AllegraTxBodyRaw ma era -> StrictSeq (TxOut era)
atbrOutputs :: !(StrictSeq (TxOut era))
  , forall ma era. AllegraTxBodyRaw ma era -> StrictSeq (TxCert era)
atbrCerts :: !(StrictSeq (TxCert era))
  , forall ma era.
AllegraTxBodyRaw ma era -> Withdrawals (EraCrypto era)
atbrWithdrawals :: !(Withdrawals (EraCrypto era))
  , forall ma era. AllegraTxBodyRaw ma era -> Coin
atbrTxFee :: !Coin
  , forall ma era. AllegraTxBodyRaw ma era -> ValidityInterval
atbrValidityInterval :: !ValidityInterval
  , forall ma era. AllegraTxBodyRaw ma era -> StrictMaybe (Update era)
atbrUpdate :: !(StrictMaybe (Update era))
  , forall ma era.
AllegraTxBodyRaw ma era
-> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
atbrAuxDataHash :: !(StrictMaybe (AuxiliaryDataHash (EraCrypto era)))
  , forall ma era. AllegraTxBodyRaw ma era -> ma
atbrMint :: !ma
  }

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

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

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

deriving instance Generic (AllegraTxBodyRaw ma era)

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

instance (DecCBOR ma, Monoid ma, AllegraEraTxBody era) => DecCBOR (AllegraTxBodyRaw ma era) where
  decCBOR :: forall s. Decoder s (AllegraTxBodyRaw ma 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
"AllegraTxBodyRaw"
          forall ma era. Monoid ma => AllegraTxBodyRaw ma era
emptyAllegraTxBodyRaw
          forall ma era.
(DecCBOR ma, EraTxOut era, EraTxCert era) =>
Word -> Field (AllegraTxBodyRaw ma era)
bodyFields
          [(Word
0, String
"atbrInputs"), (Word
1, String
"atbrOutputs"), (Word
2, String
"atbrTxFee")]
      )

instance AllegraEraTxBody era => DecCBOR (Annotator (AllegraTxBodyRaw () era)) where
  decCBOR :: forall s. Decoder s (Annotator (AllegraTxBodyRaw () 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

-- Sparse encodings of AllegraTxBodyRaw, the key values are fixed by backward compatibility
-- concerns as we want the ShelleyTxBody to deserialise as AllegraTxBody.
-- txXparse and bodyFields should be Duals, visual inspection helps ensure this.
instance
  (EraTxOut era, EraTxCert era, Eq ma, EncCBOR ma, Monoid ma) =>
  EncCBOR (AllegraTxBodyRaw ma era)
  where
  encCBOR :: AllegraTxBodyRaw ma era -> Encoding
encCBOR (AllegraTxBodyRaw Set (TxIn (EraCrypto era))
inp StrictSeq (TxOut era)
out StrictSeq (TxCert era)
cert Withdrawals (EraCrypto era)
wdrl Coin
fee (ValidityInterval StrictMaybe SlotNo
bot StrictMaybe SlotNo
top) StrictMaybe (Update era)
up StrictMaybe (AuxiliaryDataHash (EraCrypto era))
hash ma
frge) =
    forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$
      forall t. t -> Encode ('Closed 'Sparse) t
Keyed
        ( \Set (TxIn (EraCrypto era))
i StrictSeq (TxOut era)
o Coin
f StrictMaybe SlotNo
topx StrictSeq (TxCert era)
c Withdrawals (EraCrypto era)
w StrictMaybe (Update era)
u StrictMaybe (AuxiliaryDataHash (EraCrypto era))
h StrictMaybe SlotNo
botx ma
forg ->
            forall ma era.
Set (TxIn (EraCrypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals (EraCrypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
-> ma
-> AllegraTxBodyRaw ma era
AllegraTxBodyRaw Set (TxIn (EraCrypto era))
i StrictSeq (TxOut era)
o StrictSeq (TxCert era)
c Withdrawals (EraCrypto era)
w Coin
f (StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval StrictMaybe SlotNo
botx StrictMaybe SlotNo
topx) StrictMaybe (Update era)
u StrictMaybe (AuxiliaryDataHash (EraCrypto era))
h ma
forg
        )
        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))
inp) -- We don't have to send these in TxBodyX 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)
out) -- 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 a.
EncCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
3 StrictMaybe SlotNo
top
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
4 (forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictSeq (TxCert era)
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)
up
        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
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall a.
EncCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
8 StrictMaybe SlotNo
bot
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit (forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty) (forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
9 (forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To ma
frge))

bodyFields :: (DecCBOR ma, EraTxOut era, EraTxCert era) => Word -> Field (AllegraTxBodyRaw ma era)
bodyFields :: forall ma era.
(DecCBOR ma, EraTxOut era, EraTxCert era) =>
Word -> Field (AllegraTxBodyRaw ma era)
bodyFields Word
0 = forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Set (TxIn (EraCrypto era))
x AllegraTxBodyRaw ma era
tx -> AllegraTxBodyRaw ma era
tx {atbrInputs :: Set (TxIn (EraCrypto era))
atbrInputs = Set (TxIn (EraCrypto era))
x}) forall t (w :: Wrapped). DecCBOR t => Decode w t
From
bodyFields Word
1 = forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\StrictSeq (TxOut era)
x AllegraTxBodyRaw ma era
tx -> AllegraTxBodyRaw ma era
tx {atbrOutputs :: StrictSeq (TxOut era)
atbrOutputs = StrictSeq (TxOut era)
x}) forall t (w :: Wrapped). DecCBOR t => Decode w t
From
bodyFields Word
2 = forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Coin
x AllegraTxBodyRaw ma era
tx -> AllegraTxBodyRaw ma era
tx {atbrTxFee :: Coin
atbrTxFee = Coin
x}) forall t (w :: Wrapped). DecCBOR t => Decode w t
From
bodyFields Word
3 =
  forall x t (d :: Density).
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield
    ( \StrictMaybe SlotNo
x AllegraTxBodyRaw ma era
tx ->
        AllegraTxBodyRaw ma era
tx
          { atbrValidityInterval :: ValidityInterval
atbrValidityInterval =
              (forall ma era. AllegraTxBodyRaw ma era -> ValidityInterval
atbrValidityInterval AllegraTxBodyRaw ma era
tx) {invalidHereafter :: StrictMaybe SlotNo
invalidHereafter = StrictMaybe SlotNo
x}
          }
    )
    forall t (w :: Wrapped). DecCBOR t => Decode w t
From
bodyFields Word
4 = forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\StrictSeq (TxCert era)
x AllegraTxBodyRaw ma era
tx -> AllegraTxBodyRaw ma era
tx {atbrCerts :: StrictSeq (TxCert era)
atbrCerts = StrictSeq (TxCert era)
x}) forall t (w :: Wrapped). DecCBOR t => Decode w t
From
bodyFields Word
5 = forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Withdrawals (EraCrypto era)
x AllegraTxBodyRaw ma era
tx -> AllegraTxBodyRaw ma era
tx {atbrWithdrawals :: Withdrawals (EraCrypto era)
atbrWithdrawals = Withdrawals (EraCrypto era)
x}) forall t (w :: Wrapped). DecCBOR t => Decode w t
From
bodyFields Word
6 = forall x t (d :: Density).
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield (\StrictMaybe (Update era)
x AllegraTxBodyRaw ma era
tx -> AllegraTxBodyRaw ma era
tx {atbrUpdate :: StrictMaybe (Update era)
atbrUpdate = StrictMaybe (Update era)
x}) forall t (w :: Wrapped). DecCBOR t => Decode w t
From
bodyFields Word
7 = forall x t (d :: Density).
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield (\StrictMaybe (AuxiliaryDataHash (EraCrypto era))
x AllegraTxBodyRaw ma era
tx -> AllegraTxBodyRaw ma era
tx {atbrAuxDataHash :: StrictMaybe (AuxiliaryDataHash (EraCrypto era))
atbrAuxDataHash = StrictMaybe (AuxiliaryDataHash (EraCrypto era))
x}) forall t (w :: Wrapped). DecCBOR t => Decode w t
From
bodyFields Word
8 =
  forall x t (d :: Density).
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield
    ( \StrictMaybe SlotNo
x AllegraTxBodyRaw ma era
tx ->
        AllegraTxBodyRaw ma era
tx
          { atbrValidityInterval :: ValidityInterval
atbrValidityInterval =
              (forall ma era. AllegraTxBodyRaw ma era -> ValidityInterval
atbrValidityInterval AllegraTxBodyRaw ma era
tx) {invalidBefore :: StrictMaybe SlotNo
invalidBefore = StrictMaybe SlotNo
x}
          }
    )
    forall t (w :: Wrapped). DecCBOR t => Decode w t
From
bodyFields Word
9 = forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\ma
x AllegraTxBodyRaw ma era
tx -> AllegraTxBodyRaw ma era
tx {atbrMint :: ma
atbrMint = ma
x}) forall t (w :: Wrapped). DecCBOR t => Decode w t
From
bodyFields Word
n = forall t. Word -> Field t
invalidField Word
n

emptyAllegraTxBodyRaw :: Monoid ma => AllegraTxBodyRaw ma era
emptyAllegraTxBodyRaw :: forall ma era. Monoid ma => AllegraTxBodyRaw ma era
emptyAllegraTxBodyRaw =
  forall ma era.
Set (TxIn (EraCrypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals (EraCrypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
-> ma
-> AllegraTxBodyRaw ma era
AllegraTxBodyRaw
    forall a. Set a
empty
    (forall a. [a] -> StrictSeq a
fromList [])
    (forall a. [a] -> StrictSeq a
fromList [])
    (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall k a. Map k a
Map.empty)
    (Integer -> Coin
Coin Integer
0)
    (StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval forall a. StrictMaybe a
SNothing forall a. StrictMaybe a
SNothing)
    forall a. StrictMaybe a
SNothing
    forall a. StrictMaybe a
SNothing
    forall a. Monoid a => a
mempty

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

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

instance Memoized AllegraTxBody where
  type RawType AllegraTxBody = AllegraTxBodyRaw ()

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

deriving instance
  (Era era, Show (TxOut era), Show (TxCert era), Compactible (Value era), Show (PParamsUpdate era)) =>
  Show (AllegraTxBody era)

deriving instance Generic (AllegraTxBody era)

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

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

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

deriving via
  Mem (AllegraTxBodyRaw ()) era
  instance
    AllegraEraTxBody era => DecCBOR (Annotator (AllegraTxBody era))

type instance MemoHashIndex (AllegraTxBodyRaw c) = EraIndependentTxBody

instance (c ~ EraCrypto era, Era era) => HashAnnotated (AllegraTxBody era) EraIndependentTxBody c where
  hashAnnotated :: HashAlgorithm (HASH c) =>
AllegraTxBody era -> SafeHash c EraIndependentTxBody
hashAnnotated = forall (t :: * -> *) era.
Memoized t =>
t era -> SafeHash (EraCrypto era) (MemoHashIndex (RawType t))
getMemoSafeHash

-- | A pattern to keep the newtype and the MemoBytes hidden
pattern AllegraTxBody ::
  (EraTxOut era, EraTxCert era) =>
  Set (TxIn (EraCrypto era)) ->
  StrictSeq (TxOut era) ->
  StrictSeq (TxCert era) ->
  Withdrawals (EraCrypto era) ->
  Coin ->
  ValidityInterval ->
  StrictMaybe (Update era) ->
  StrictMaybe (AuxiliaryDataHash (EraCrypto era)) ->
  AllegraTxBody era
pattern $bAllegraTxBody :: forall era.
(EraTxOut era, EraTxCert era) =>
Set (TxIn (EraCrypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals (EraCrypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
-> AllegraTxBody era
$mAllegraTxBody :: forall {r} {era}.
(EraTxOut era, EraTxCert era) =>
AllegraTxBody era
-> (Set (TxIn (EraCrypto era))
    -> StrictSeq (TxOut era)
    -> StrictSeq (TxCert era)
    -> Withdrawals (EraCrypto era)
    -> Coin
    -> ValidityInterval
    -> StrictMaybe (Update era)
    -> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
    -> r)
-> ((# #) -> r)
-> r
AllegraTxBody
  { forall era.
(EraTxOut era, EraTxCert era) =>
AllegraTxBody era -> Set (TxIn (EraCrypto era))
atbInputs
  , forall era.
(EraTxOut era, EraTxCert era) =>
AllegraTxBody era -> StrictSeq (TxOut era)
atbOutputs
  , forall era.
(EraTxOut era, EraTxCert era) =>
AllegraTxBody era -> StrictSeq (TxCert era)
atbCerts
  , forall era.
(EraTxOut era, EraTxCert era) =>
AllegraTxBody era -> Withdrawals (EraCrypto era)
atbWithdrawals
  , forall era.
(EraTxOut era, EraTxCert era) =>
AllegraTxBody era -> Coin
atbTxFee
  , forall era.
(EraTxOut era, EraTxCert era) =>
AllegraTxBody era -> ValidityInterval
atbValidityInterval
  , forall era.
(EraTxOut era, EraTxCert era) =>
AllegraTxBody era -> StrictMaybe (Update era)
atbUpdate
  , forall era.
(EraTxOut era, EraTxCert era) =>
AllegraTxBody era
-> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
atbAuxDataHash
  } <-
  ( getMemoRawType ->
      AllegraTxBodyRaw
        { atbrInputs = atbInputs
        , atbrOutputs = atbOutputs
        , atbrCerts = atbCerts
        , atbrWithdrawals = atbWithdrawals
        , atbrTxFee = atbTxFee
        , atbrValidityInterval = atbValidityInterval
        , atbrUpdate = atbUpdate
        , atbrAuxDataHash = atbAuxDataHash
        }
    )
  where
    AllegraTxBody
      Set (TxIn (EraCrypto era))
inputs
      StrictSeq (TxOut era)
outputs
      StrictSeq (TxCert era)
certs
      Withdrawals (EraCrypto era)
withdrawals
      Coin
txFee
      ValidityInterval
validityInterval
      StrictMaybe (Update era)
update
      StrictMaybe (AuxiliaryDataHash (EraCrypto era))
auxDataHash =
        forall era (t :: * -> *).
(Era era, EncCBOR (RawType t era), Memoized t) =>
RawType t era -> t era
mkMemoized forall a b. (a -> b) -> a -> b
$
          AllegraTxBodyRaw
            { atbrInputs :: Set (TxIn (EraCrypto era))
atbrInputs = Set (TxIn (EraCrypto era))
inputs
            , atbrOutputs :: StrictSeq (TxOut era)
atbrOutputs = StrictSeq (TxOut era)
outputs
            , atbrCerts :: StrictSeq (TxCert era)
atbrCerts = StrictSeq (TxCert era)
certs
            , atbrWithdrawals :: Withdrawals (EraCrypto era)
atbrWithdrawals = Withdrawals (EraCrypto era)
withdrawals
            , atbrTxFee :: Coin
atbrTxFee = Coin
txFee
            , atbrValidityInterval :: ValidityInterval
atbrValidityInterval = ValidityInterval
validityInterval
            , atbrUpdate :: StrictMaybe (Update era)
atbrUpdate = StrictMaybe (Update era)
update
            , atbrAuxDataHash :: StrictMaybe (AuxiliaryDataHash (EraCrypto era))
atbrAuxDataHash = StrictMaybe (AuxiliaryDataHash (EraCrypto era))
auxDataHash
            , atbrMint :: ()
atbrMint = ()
            }

{-# COMPLETE AllegraTxBody #-}

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

  type TxBody (AllegraEra c) = AllegraTxBody (AllegraEra c)

  mkBasicTxBody :: TxBody (AllegraEra c)
mkBasicTxBody = forall era (t :: * -> *).
(Era era, EncCBOR (RawType t era), Memoized t) =>
RawType t era -> t era
mkMemoized forall ma era. Monoid ma => AllegraTxBodyRaw ma era
emptyAllegraTxBodyRaw

  inputsTxBodyL :: Lens'
  (TxBody (AllegraEra c)) (Set (TxIn (EraCrypto (AllegraEra 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 ma era.
AllegraTxBodyRaw ma era -> Set (TxIn (EraCrypto era))
atbrInputs forall a b. (a -> b) -> a -> b
$ \RawType AllegraTxBody (AllegraEra c)
txBodyRaw Set (TxIn (EraCrypto (AllegraEra c)))
inputs -> RawType AllegraTxBody (AllegraEra c)
txBodyRaw {atbrInputs :: Set (TxIn (EraCrypto (AllegraEra c)))
atbrInputs = Set (TxIn (EraCrypto (AllegraEra c)))
inputs}
  {-# INLINEABLE inputsTxBodyL #-}

  outputsTxBodyL :: Lens' (TxBody (AllegraEra c)) (StrictSeq (TxOut (AllegraEra 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 ma era. AllegraTxBodyRaw ma era -> StrictSeq (TxOut era)
atbrOutputs forall a b. (a -> b) -> a -> b
$ \RawType AllegraTxBody (AllegraEra c)
txBodyRaw StrictSeq (TxOut (AllegraEra c))
outputs -> RawType AllegraTxBody (AllegraEra c)
txBodyRaw {atbrOutputs :: StrictSeq (TxOut (AllegraEra c))
atbrOutputs = StrictSeq (TxOut (AllegraEra c))
outputs}
  {-# INLINEABLE outputsTxBodyL #-}

  feeTxBodyL :: Lens' (TxBody (AllegraEra 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 ma era. AllegraTxBodyRaw ma era -> Coin
atbrTxFee forall a b. (a -> b) -> a -> b
$ \RawType AllegraTxBody (AllegraEra c)
txBodyRaw Coin
fee -> RawType AllegraTxBody (AllegraEra c)
txBodyRaw {atbrTxFee :: Coin
atbrTxFee = Coin
fee}
  {-# INLINEABLE feeTxBodyL #-}

  auxDataHashTxBodyL :: Lens'
  (TxBody (AllegraEra c))
  (StrictMaybe (AuxiliaryDataHash (EraCrypto (AllegraEra 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 ma era.
AllegraTxBodyRaw ma era
-> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
atbrAuxDataHash forall a b. (a -> b) -> a -> b
$
      \RawType AllegraTxBody (AllegraEra c)
txBodyRaw StrictMaybe (AuxiliaryDataHash (EraCrypto (AllegraEra c)))
auxDataHash -> RawType AllegraTxBody (AllegraEra c)
txBodyRaw {atbrAuxDataHash :: StrictMaybe (AuxiliaryDataHash (EraCrypto (AllegraEra c)))
atbrAuxDataHash = StrictMaybe (AuxiliaryDataHash (EraCrypto (AllegraEra c)))
auxDataHash}
  {-# INLINEABLE auxDataHashTxBodyL #-}

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

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

  withdrawalsTxBodyL :: Lens'
  (TxBody (AllegraEra c)) (Withdrawals (EraCrypto (AllegraEra 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 ma era.
AllegraTxBodyRaw ma era -> Withdrawals (EraCrypto era)
atbrWithdrawals forall a b. (a -> b) -> a -> b
$
      \RawType AllegraTxBody (AllegraEra c)
txBodyRaw Withdrawals (EraCrypto (AllegraEra c))
withdrawals -> RawType AllegraTxBody (AllegraEra c)
txBodyRaw {atbrWithdrawals :: Withdrawals (EraCrypto (AllegraEra c))
atbrWithdrawals = Withdrawals (EraCrypto (AllegraEra c))
withdrawals}
  {-# INLINEABLE withdrawalsTxBodyL #-}

  certsTxBodyL :: Lens' (TxBody (AllegraEra c)) (StrictSeq (TxCert (AllegraEra 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 ma era. AllegraTxBodyRaw ma era -> StrictSeq (TxCert era)
atbrCerts forall a b. (a -> b) -> a -> b
$ \RawType AllegraTxBody (AllegraEra c)
txBodyRaw StrictSeq (TxCert (AllegraEra c))
certs -> RawType AllegraTxBody (AllegraEra c)
txBodyRaw {atbrCerts :: StrictSeq (TxCert (AllegraEra c))
atbrCerts = StrictSeq (TxCert (AllegraEra c))
certs}
  {-# INLINEABLE certsTxBodyL #-}

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

  upgradeTxBody :: EraTxBody (PreviousEra (AllegraEra c)) =>
TxBody (PreviousEra (AllegraEra c))
-> Either
     (TxBodyUpgradeError (AllegraEra c)) (TxBody (AllegraEra c))
upgradeTxBody TxBody (PreviousEra (AllegraEra c))
txBody = do
    StrictSeq (TxCert (AllegraEra c))
certs <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall era.
(EraTxCert era, EraTxCert (PreviousEra era)) =>
TxCert (PreviousEra era)
-> Either (TxCertUpgradeError era) (TxCert era)
upgradeTxCert (TxBody (PreviousEra (AllegraEra c))
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      AllegraTxBody
        { atbInputs :: Set (TxIn (EraCrypto (AllegraEra c)))
atbInputs = TxBody (PreviousEra (AllegraEra c))
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
inputsTxBodyL
        , atbOutputs :: StrictSeq (TxOut (AllegraEra c))
atbOutputs = forall era.
(EraTxOut era, EraTxOut (PreviousEra era)) =>
TxOut (PreviousEra era) -> TxOut era
upgradeTxOut forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxBody (PreviousEra (AllegraEra c))
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL)
        , atbCerts :: StrictSeq (TxCert (AllegraEra c))
atbCerts = StrictSeq (TxCert (AllegraEra c))
certs
        , atbWithdrawals :: Withdrawals (EraCrypto (AllegraEra c))
atbWithdrawals = TxBody (PreviousEra (AllegraEra c))
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (Withdrawals (EraCrypto era))
withdrawalsTxBodyL
        , atbTxFee :: Coin
atbTxFee = TxBody (PreviousEra (AllegraEra c))
txBody forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL
        , atbValidityInterval :: ValidityInterval
atbValidityInterval = SlotNo -> ValidityInterval
ttlToValidityInterval (TxBody (PreviousEra (AllegraEra c))
txBody forall s a. s -> Getting a s a -> a
^. forall era.
(ShelleyEraTxBody era, ExactEra ShelleyEra era) =>
Lens' (TxBody era) SlotNo
ttlTxBodyL)
        , atbUpdate :: StrictMaybe (Update (AllegraEra c))
atbUpdate = forall era.
(EraPParams era, EraPParams (PreviousEra era),
 EraCrypto (PreviousEra era) ~ EraCrypto era) =>
UpgradePParams StrictMaybe era
-> Update (PreviousEra era) -> Update era
upgradeUpdate () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxBody (PreviousEra (AllegraEra c))
txBody forall s a. s -> Getting a s a -> a
^. forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
updateTxBodyL)
        , atbAuxDataHash :: StrictMaybe (AuxiliaryDataHash (EraCrypto (AllegraEra c)))
atbAuxDataHash = TxBody (PreviousEra (AllegraEra c))
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (AuxiliaryDataHash (EraCrypto era)))
auxDataHashTxBodyL
        }
    where
      ttlToValidityInterval :: SlotNo -> ValidityInterval
      ttlToValidityInterval :: SlotNo -> ValidityInterval
ttlToValidityInterval SlotNo
ttl = StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval forall a. StrictMaybe a
SNothing (forall a. a -> StrictMaybe a
SJust SlotNo
ttl)

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

  ttlTxBodyL :: ExactEra ShelleyEra (AllegraEra c) =>
Lens' (TxBody (AllegraEra c)) SlotNo
ttlTxBodyL = forall a b. HasCallStack => Lens' a b
notSupportedInThisEraL
  {-# INLINEABLE ttlTxBodyL #-}

  updateTxBodyL :: Lens' (TxBody (AllegraEra c)) (StrictMaybe (Update (AllegraEra 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 ma era. AllegraTxBodyRaw ma era -> StrictMaybe (Update era)
atbrUpdate forall a b. (a -> b) -> a -> b
$ \RawType AllegraTxBody (AllegraEra c)
txBodyRaw StrictMaybe (Update (AllegraEra c))
update -> RawType AllegraTxBody (AllegraEra c)
txBodyRaw {atbrUpdate :: StrictMaybe (Update (AllegraEra c))
atbrUpdate = StrictMaybe (Update (AllegraEra c))
update}
  {-# INLINEABLE updateTxBodyL #-}

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

  vldtTxBodyL :: Lens' (TxBody (AllegraEra c)) ValidityInterval
vldtTxBodyL =
    forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall ma era. AllegraTxBodyRaw ma era -> ValidityInterval
atbrValidityInterval forall a b. (a -> b) -> a -> b
$
      \RawType AllegraTxBody (AllegraEra c)
txBodyRaw ValidityInterval
vldt -> RawType AllegraTxBody (AllegraEra c)
txBodyRaw {atbrValidityInterval :: ValidityInterval
atbrValidityInterval = ValidityInterval
vldt}
  {-# INLINEABLE vldtTxBodyL #-}

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