{-# 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.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.MemoBytes (
  EqRaw,
  Mem,
  MemoBytes,
  MemoHashIndex,
  Memoized (RawType),
  getMemoRawType,
  getMemoSafeHash,
  lensMemoRawType,
  mkMemoized,
 )
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
atbrInputs :: !(Set TxIn)
  , 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
atbrWithdrawals :: !Withdrawals
  , 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 TxAuxDataHash
atbrAuxDataHash :: !(StrictMaybe TxAuxDataHash)
  , 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
inp StrictSeq (TxOut era)
out StrictSeq (TxCert era)
cert Withdrawals
wdrl Coin
fee (ValidityInterval StrictMaybe SlotNo
bot StrictMaybe SlotNo
top) StrictMaybe (Update era)
up StrictMaybe TxAuxDataHash
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
i StrictSeq (TxOut era)
o Coin
f StrictMaybe SlotNo
topx StrictSeq (TxCert era)
c Withdrawals
w StrictMaybe (Update era)
u StrictMaybe TxAuxDataHash
h StrictMaybe SlotNo
botx ma
forg ->
            forall ma era.
Set TxIn
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> StrictMaybe TxAuxDataHash
-> ma
-> AllegraTxBodyRaw ma era
AllegraTxBodyRaw Set TxIn
i StrictSeq (TxOut era)
o StrictSeq (TxCert era)
c Withdrawals
w Coin
f (StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval StrictMaybe SlotNo
botx StrictMaybe SlotNo
topx) StrictMaybe (Update era)
u StrictMaybe TxAuxDataHash
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
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
. 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)
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 TxAuxDataHash
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
x AllegraTxBodyRaw ma era
tx -> AllegraTxBodyRaw ma era
tx {atbrInputs :: Set TxIn
atbrInputs = Set TxIn
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
x AllegraTxBodyRaw ma era
tx -> AllegraTxBodyRaw ma era
tx {atbrWithdrawals :: Withdrawals
atbrWithdrawals = Withdrawals
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 TxAuxDataHash
x AllegraTxBodyRaw ma era
tx -> AllegraTxBodyRaw ma era
tx {atbrAuxDataHash :: StrictMaybe TxAuxDataHash
atbrAuxDataHash = StrictMaybe TxAuxDataHash
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
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> StrictMaybe TxAuxDataHash
-> ma
-> AllegraTxBodyRaw ma era
AllegraTxBodyRaw
    forall a. Set a
empty
    (forall a. [a] -> StrictSeq a
fromList [])
    (forall a. [a] -> StrictSeq a
fromList [])
    (Map RewardAccount Coin -> Withdrawals
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 i. Proxy i -> AllegraTxBody e -> SafeHash i
forall e. AllegraTxBody e -> Int
forall e. AllegraTxBody e -> ByteString
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall i. Proxy i -> t -> SafeHash i)
-> SafeToHash t
forall e i. Proxy i -> AllegraTxBody e -> SafeHash i
makeHashWithExplicitProxys :: forall i. Proxy i -> AllegraTxBody e -> SafeHash i
$cmakeHashWithExplicitProxys :: forall e i. Proxy i -> AllegraTxBody e -> SafeHash i
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 Era era => HashAnnotated (AllegraTxBody era) EraIndependentTxBody where
  hashAnnotated :: AllegraTxBody era -> SafeHash EraIndependentTxBody
hashAnnotated = forall (t :: * -> *) era.
Memoized t =>
t era -> SafeHash (MemoHashIndex (RawType t))
getMemoSafeHash

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

{-# COMPLETE AllegraTxBody #-}

instance EraTxBody AllegraEra where
  type TxBody AllegraEra = AllegraTxBody AllegraEra

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

  outputsTxBodyL :: Lens' (TxBody AllegraEra) (StrictSeq (TxOut AllegraEra))
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
txBodyRaw StrictSeq (TxOut AllegraEra)
outputs -> RawType AllegraTxBody AllegraEra
txBodyRaw {atbrOutputs :: StrictSeq (TxOut AllegraEra)
atbrOutputs = StrictSeq (TxOut AllegraEra)
outputs}
  {-# INLINEABLE outputsTxBodyL #-}

  feeTxBodyL :: Lens' (TxBody AllegraEra) 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
txBodyRaw Coin
fee -> RawType AllegraTxBody AllegraEra
txBodyRaw {atbrTxFee :: Coin
atbrTxFee = Coin
fee}
  {-# INLINEABLE feeTxBodyL #-}

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

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

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

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

  certsTxBodyL :: Lens' (TxBody AllegraEra) (StrictSeq (TxCert AllegraEra))
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
txBodyRaw StrictSeq (TxCert AllegraEra)
certs -> RawType AllegraTxBody AllegraEra
txBodyRaw {atbrCerts :: StrictSeq (TxCert AllegraEra)
atbrCerts = StrictSeq (TxCert AllegraEra)
certs}
  {-# INLINEABLE certsTxBodyL #-}

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

  upgradeTxBody :: EraTxBody (PreviousEra AllegraEra) =>
TxBody (PreviousEra AllegraEra)
-> Either (TxBodyUpgradeError AllegraEra) (TxBody AllegraEra)
upgradeTxBody TxBody (PreviousEra AllegraEra)
txBody = do
    StrictSeq (TxCert AllegraEra)
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)
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
atbInputs = TxBody (PreviousEra AllegraEra)
txBody forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
inputsTxBodyL
        , atbOutputs :: StrictSeq (TxOut AllegraEra)
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)
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)
atbCerts = StrictSeq (TxCert AllegraEra)
certs
        , atbWithdrawals :: Withdrawals
atbWithdrawals = TxBody (PreviousEra AllegraEra)
txBody forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL
        , atbTxFee :: Coin
atbTxFee = TxBody (PreviousEra AllegraEra)
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)
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)
atbUpdate = forall era.
(EraPParams era, EraPParams (PreviousEra 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)
txBody forall s a. s -> Getting a s a -> a
^. forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
updateTxBodyL)
        , atbAuxDataHash :: StrictMaybe TxAuxDataHash
atbAuxDataHash = TxBody (PreviousEra AllegraEra)
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictMaybe TxAuxDataHash)
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 ShelleyEraTxBody AllegraEra where
  ttlTxBodyL :: ExactEra ShelleyEra AllegraEra => Lens' (TxBody AllegraEra) SlotNo
ttlTxBodyL = forall a b. HasCallStack => Lens' a b
notSupportedInThisEraL
  {-# INLINEABLE ttlTxBodyL #-}

  updateTxBodyL :: Lens' (TxBody AllegraEra) (StrictMaybe (Update AllegraEra))
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
txBodyRaw StrictMaybe (Update AllegraEra)
update -> RawType AllegraTxBody AllegraEra
txBodyRaw {atbrUpdate :: StrictMaybe (Update AllegraEra)
atbrUpdate = StrictMaybe (Update AllegraEra)
update}
  {-# INLINEABLE updateTxBodyL #-}

instance AllegraEraTxBody AllegraEra where
  vldtTxBodyL :: Lens' (TxBody AllegraEra) 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
txBodyRaw ValidityInterval
vldt -> RawType AllegraTxBody AllegraEra
txBodyRaw {atbrValidityInterval :: ValidityInterval
atbrValidityInterval = ValidityInterval
vldt}
  {-# INLINEABLE vldtTxBodyL #-}

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