{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Constrained.Conway.Instances.TxBody where

import Cardano.Ledger.Address (RewardAccount (..), Withdrawals (..))
import Cardano.Ledger.Allegra.Core (AllegraEraTxBody (..))
import Cardano.Ledger.Allegra.TxBody (AllegraTxBody (..), ValidityInterval (..))
import Cardano.Ledger.Alonzo.TxBody (AlonzoEraTxBody (..), AlonzoTxBody (..), ScriptIntegrityHash)
import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash)
import Cardano.Ledger.Babbage.TxBody (BabbageEraTxBody (..), BabbageTxBody (..))
import Cardano.Ledger.BaseTypes hiding (inject)
import Cardano.Ledger.Binary (EncCBOR (..), Sized (..))
import Cardano.Ledger.Coin
import Cardano.Ledger.Core
import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..))
import Cardano.Ledger.Mary.Core (MaryEraTxBody (..))
import Cardano.Ledger.Mary.TxBody (MaryTxBody (..))
import Cardano.Ledger.Mary.Value (MultiAsset (..))
import Cardano.Ledger.Shelley.PParams (Update (..))
import Cardano.Ledger.Shelley.TxBody (ShelleyTxBody (..))
import Cardano.Ledger.TxIn (TxIn (..))
import Constrained hiding (Value)
import Data.Foldable (toList)
import Data.Map.Strict (Map)
import qualified Data.Sequence.Strict as SS (fromList)
import Data.Set (Set)
import Lens.Micro
import Test.Cardano.Ledger.Constrained.Conway.Instances.Ledger

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

instance HasSimpleRep (Update era)
instance (EraSpecPParams era, IsConwayUniv fn) => HasSpec fn (Update era)

-- =========================================
-- ShelleyTxBody

-- | This is an abstraction of the Pattern ShelleyTxBody, that uses [x] instead of (StrictSeq x)
--   and (Maybe x) instead of (StrictMaybe x). It transforms bewtween the two, in the toSimpleRep
--   and fromSimpleRep methods. This makes it much easier to write Specifications, because
--   the Constrained packaage knows about Lists and Maybe.
type ShelleyTxBodyTypes era =
  '[ Set (TxIn (EraCrypto era))
   , [TxOut era]
   , [TxCert era]
   , Map (RewardAccount (EraCrypto era)) Coin
   , Coin
   , SlotNo
   , Maybe (Update era)
   , Maybe (AuxiliaryDataHash (EraCrypto era))
   ]

instance
  ( EraTxOut era
  , EncCBOR (TxCert era)
  ) =>
  HasSimpleRep (ShelleyTxBody era)
  where
  type SimpleRep (ShelleyTxBody era) = SOP '["ShelleyTxBody" ::: ShelleyTxBodyTypes era]
  toSimpleRep :: ShelleyTxBody era -> SimpleRep (ShelleyTxBody era)
toSimpleRep (ShelleyTxBody Set (TxIn (EraCrypto era))
is StrictSeq (TxOut era)
os StrictSeq (TxCert era)
certs Withdrawals (EraCrypto era)
w Coin
c SlotNo
s StrictMaybe (Update era)
up StrictMaybe (AuxiliaryDataHash (EraCrypto era))
aux) =
    forall (c :: Symbol) (constrs :: [*]).
Inject c constrs (SOP constrs) =>
FunTy (ConstrOf c constrs) (SOP constrs)
inject @"ShelleyTxBody" @'["ShelleyTxBody" ::: ShelleyTxBodyTypes era]
      Set (TxIn (EraCrypto era))
is
      (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (TxOut era)
os)
      (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (TxCert era)
certs)
      (forall c. Withdrawals c -> Map (RewardAccount c) Coin
unWithdrawals Withdrawals (EraCrypto era)
w)
      Coin
c
      SlotNo
s
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (Update era)
up)
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (AuxiliaryDataHash (EraCrypto era))
aux)

  fromSimpleRep :: SimpleRep (ShelleyTxBody era) -> ShelleyTxBody era
fromSimpleRep SimpleRep (ShelleyTxBody era)
rep =
    forall (constrs :: [*]) r.
SOPLike constrs r =>
SOP constrs -> ALG constrs r
algebra @'["ShelleyTxBody" ::: ShelleyTxBodyTypes era]
      SimpleRep (ShelleyTxBody era)
rep
      ( \Set (TxIn (EraCrypto era))
is [TxOut era]
os [TxCert era]
certs Map (RewardAccount (EraCrypto era)) Coin
w Coin
c SlotNo
s Maybe (Update era)
up Maybe (AuxiliaryDataHash (EraCrypto era))
aux ->
          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
ShelleyTxBody
            Set (TxIn (EraCrypto era))
is
            (forall a. [a] -> StrictSeq a
SS.fromList [TxOut era]
os)
            (forall a. [a] -> StrictSeq a
SS.fromList [TxCert era]
certs)
            (forall c. Map (RewardAccount c) Coin -> Withdrawals c
Withdrawals Map (RewardAccount (EraCrypto era)) Coin
w)
            Coin
c
            SlotNo
s
            (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (Update era)
up)
            (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (AuxiliaryDataHash (EraCrypto era))
aux)
      )

instance
  ( EraSpecPParams era
  , IsConwayUniv fn
  , HasSpec fn (TxOut era)
  , HasSpec fn (TxCert era)
  ) =>
  HasSpec fn (ShelleyTxBody era)

fromShelleyBody :: forall era. EraTxBody era => ShelleyTxBody era -> TxBody era
fromShelleyBody :: forall era. EraTxBody era => ShelleyTxBody era -> TxBody era
fromShelleyBody (ShelleyTxBody Set (TxIn (EraCrypto era))
inputs StrictSeq (TxOut era)
outputs StrictSeq (TxCert era)
certs Withdrawals (EraCrypto era)
withdrawals Coin
coin SlotNo
_slot StrictMaybe (Update era)
_up StrictMaybe (AuxiliaryDataHash (EraCrypto era))
aux) =
  forall era. EraTxBody era => TxBody era
mkBasicTxBody @era
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
inputsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (TxIn (EraCrypto era))
inputs
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxOut era)
outputs
    forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
coin
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (Withdrawals (EraCrypto era))
withdrawalsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals (EraCrypto era)
withdrawals
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxCert era)
certs
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (AuxiliaryDataHash (EraCrypto era)))
auxDataHashTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (AuxiliaryDataHash (EraCrypto era))
aux

-- =======================================================
-- AllegraTxBody

-- | This is an abstraction of the Pattern AllegraTxBody, that uses [x] instead of (StrictSeq x)
--   and (Maybe x) instead of (StrictMaybe x). It transforms bewtween the two, in the toSimpleRep
--   and fromSimpleRep methods. This makes it much easier to write Specifications, because
--   the Constrained packaage knows about Lists and Maybe.
type AllegraTxBodyTypes era =
  '[ Set (TxIn (EraCrypto era))
   , [TxOut era]
   , [TxCert era]
   , Map (RewardAccount (EraCrypto era)) Coin
   , Coin
   , ValidityInterval
   , Maybe (Update era)
   , Maybe (AuxiliaryDataHash (EraCrypto era))
   ]

instance
  ( EraTxOut era
  , EraTxCert era
  ) =>
  HasSimpleRep (AllegraTxBody era)
  where
  type SimpleRep (AllegraTxBody era) = SOP '["AllegraTxBody" ::: AllegraTxBodyTypes era]
  toSimpleRep :: AllegraTxBody era -> SimpleRep (AllegraTxBody era)
toSimpleRep (AllegraTxBody Set (TxIn (EraCrypto era))
is StrictSeq (TxOut era)
os StrictSeq (TxCert era)
certs Withdrawals (EraCrypto era)
w Coin
c ValidityInterval
vi StrictMaybe (Update era)
up StrictMaybe (AuxiliaryDataHash (EraCrypto era))
aux) =
    forall (c :: Symbol) (constrs :: [*]).
Inject c constrs (SOP constrs) =>
FunTy (ConstrOf c constrs) (SOP constrs)
inject @"AllegraTxBody" @'["AllegraTxBody" ::: AllegraTxBodyTypes era]
      Set (TxIn (EraCrypto era))
is
      (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (TxOut era)
os)
      (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (TxCert era)
certs)
      (forall c. Withdrawals c -> Map (RewardAccount c) Coin
unWithdrawals Withdrawals (EraCrypto era)
w)
      Coin
c
      ValidityInterval
vi
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (Update era)
up)
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (AuxiliaryDataHash (EraCrypto era))
aux)

  fromSimpleRep :: SimpleRep (AllegraTxBody era) -> AllegraTxBody era
fromSimpleRep SimpleRep (AllegraTxBody era)
rep =
    forall (constrs :: [*]) r.
SOPLike constrs r =>
SOP constrs -> ALG constrs r
algebra @'["AllegraTxBody" ::: AllegraTxBodyTypes era]
      SimpleRep (AllegraTxBody era)
rep
      ( \Set (TxIn (EraCrypto era))
is [TxOut era]
os [TxCert era]
certs Map (RewardAccount (EraCrypto era)) Coin
w Coin
c ValidityInterval
vi Maybe (Update era)
up Maybe (AuxiliaryDataHash (EraCrypto era))
aux ->
          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
AllegraTxBody
            Set (TxIn (EraCrypto era))
is
            (forall a. [a] -> StrictSeq a
SS.fromList [TxOut era]
os)
            (forall a. [a] -> StrictSeq a
SS.fromList [TxCert era]
certs)
            (forall c. Map (RewardAccount c) Coin -> Withdrawals c
Withdrawals Map (RewardAccount (EraCrypto era)) Coin
w)
            Coin
c
            ValidityInterval
vi
            (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (Update era)
up)
            (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (AuxiliaryDataHash (EraCrypto era))
aux)
      )
instance
  ( EraSpecPParams era
  , IsConwayUniv fn
  , HasSpec fn (TxOut era)
  , HasSpec fn (TxCert era)
  ) =>
  HasSpec fn (AllegraTxBody era)

fromAllegraBody :: forall era. AllegraEraTxBody era => AllegraTxBody era -> TxBody era
fromAllegraBody :: forall era. AllegraEraTxBody era => AllegraTxBody era -> TxBody era
fromAllegraBody (AllegraTxBody Set (TxIn (EraCrypto era))
inputs StrictSeq (TxOut era)
outputs StrictSeq (TxCert era)
certs Withdrawals (EraCrypto era)
withdrawals Coin
coin ValidityInterval
vi StrictMaybe (Update era)
_up StrictMaybe (AuxiliaryDataHash (EraCrypto era))
aux) =
  forall era. EraTxBody era => TxBody era
mkBasicTxBody @era
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
inputsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (TxIn (EraCrypto era))
inputs
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxOut era)
outputs
    forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
coin
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (Withdrawals (EraCrypto era))
withdrawalsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals (EraCrypto era)
withdrawals
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxCert era)
certs
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (AuxiliaryDataHash (EraCrypto era)))
auxDataHashTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (AuxiliaryDataHash (EraCrypto era))
aux
    forall a b. a -> (a -> b) -> b
& forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
vldtTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValidityInterval
vi

-- =========================================================================
-- MaryTxBody

-- | This is an abstraction of the Pattern MaryTxBody, that uses [x] instead of (StrictSeq x)
--   and (Maybe x) instead of (StrictMaybe x). It transforms between the abstractions and the
--   real types in the toSimpleRep and fromSimpleRep methods. This makes it much easier to
--   write Specifications, because the Constrained packaage knows about Lists and Maybe.
type MaryTxBodyTypes era =
  '[ Set (TxIn (EraCrypto era))
   , [TxOut era]
   , [TxCert era]
   , Map (RewardAccount (EraCrypto era)) Coin
   , Coin
   , ValidityInterval
   , Maybe (Update era)
   , Maybe (AuxiliaryDataHash (EraCrypto era))
   , MultiAsset (EraCrypto era)
   ]

instance
  ( EraTxOut era
  , EraTxCert era
  ) =>
  HasSimpleRep (MaryTxBody era)
  where
  type SimpleRep (MaryTxBody era) = SOP '["MaryTxBody" ::: MaryTxBodyTypes era]
  toSimpleRep :: MaryTxBody era -> SimpleRep (MaryTxBody era)
toSimpleRep (MaryTxBody Set (TxIn (EraCrypto era))
is StrictSeq (TxOut era)
os StrictSeq (TxCert era)
certs Withdrawals (EraCrypto era)
w Coin
c ValidityInterval
vi StrictMaybe (Update era)
up StrictMaybe (AuxiliaryDataHash (EraCrypto era))
aux MultiAsset (EraCrypto era)
ma) =
    forall (c :: Symbol) (constrs :: [*]).
Inject c constrs (SOP constrs) =>
FunTy (ConstrOf c constrs) (SOP constrs)
inject @"MaryTxBody" @'["MaryTxBody" ::: MaryTxBodyTypes era]
      Set (TxIn (EraCrypto era))
is
      (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (TxOut era)
os)
      (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (TxCert era)
certs)
      (forall c. Withdrawals c -> Map (RewardAccount c) Coin
unWithdrawals Withdrawals (EraCrypto era)
w)
      Coin
c
      ValidityInterval
vi
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (Update era)
up)
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (AuxiliaryDataHash (EraCrypto era))
aux)
      MultiAsset (EraCrypto era)
ma

  fromSimpleRep :: SimpleRep (MaryTxBody era) -> MaryTxBody era
fromSimpleRep SimpleRep (MaryTxBody era)
rep =
    forall (constrs :: [*]) r.
SOPLike constrs r =>
SOP constrs -> ALG constrs r
algebra @'["MaryTxBody" ::: MaryTxBodyTypes era]
      SimpleRep (MaryTxBody era)
rep
      ( \Set (TxIn (EraCrypto era))
is [TxOut era]
os [TxCert era]
certs Map (RewardAccount (EraCrypto era)) Coin
w Coin
c ValidityInterval
vi Maybe (Update era)
up Maybe (AuxiliaryDataHash (EraCrypto era))
aux MultiAsset (EraCrypto era)
ma ->
          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))
-> MultiAsset (EraCrypto era)
-> MaryTxBody era
MaryTxBody
            Set (TxIn (EraCrypto era))
is
            (forall a. [a] -> StrictSeq a
SS.fromList [TxOut era]
os)
            (forall a. [a] -> StrictSeq a
SS.fromList [TxCert era]
certs)
            (forall c. Map (RewardAccount c) Coin -> Withdrawals c
Withdrawals Map (RewardAccount (EraCrypto era)) Coin
w)
            Coin
c
            ValidityInterval
vi
            (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (Update era)
up)
            (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (AuxiliaryDataHash (EraCrypto era))
aux)
            MultiAsset (EraCrypto era)
ma
      )
instance
  ( EraSpecPParams era
  , IsConwayUniv fn
  , HasSpec fn (TxOut era)
  , HasSpec fn (TxCert era)
  ) =>
  HasSpec fn (MaryTxBody era)

fromMaryBody :: forall era. MaryEraTxBody era => MaryTxBody era -> TxBody era
fromMaryBody :: forall era. MaryEraTxBody era => MaryTxBody era -> TxBody era
fromMaryBody (MaryTxBody Set (TxIn (EraCrypto era))
inputs StrictSeq (TxOut era)
outputs StrictSeq (TxCert era)
certs Withdrawals (EraCrypto era)
withdrawals Coin
coin ValidityInterval
vi StrictMaybe (Update era)
_up StrictMaybe (AuxiliaryDataHash (EraCrypto era))
aux MultiAsset (EraCrypto era)
ma) =
  forall era. EraTxBody era => TxBody era
mkBasicTxBody @era
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
inputsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (TxIn (EraCrypto era))
inputs
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxOut era)
outputs
    forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
coin
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (Withdrawals (EraCrypto era))
withdrawalsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals (EraCrypto era)
withdrawals
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxCert era)
certs
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (AuxiliaryDataHash (EraCrypto era)))
auxDataHashTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (AuxiliaryDataHash (EraCrypto era))
aux
    forall a b. a -> (a -> b) -> b
& forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
vldtTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValidityInterval
vi
    forall a b. a -> (a -> b) -> b
& forall era.
MaryEraTxBody era =>
Lens' (TxBody era) (MultiAsset (EraCrypto era))
mintTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ MultiAsset (EraCrypto era)
ma

-- =================================================================================
-- AlonzoTxBody

-- | This is an abstraction of the Pattern AlonzoTxBody, that uses [x] instead of (StrictSeq x)
--   and (Maybe x) instead of (StrictMaybe x). It transforms between the abstractions and the
--   real types in the toSimpleRep and fromSimpleRep methods. This makes it much easier to
--   write Specifications, because the Constrained packaage knows about Lists and Maybe.
type AlonzoTxBodyTypes era =
  '[ Set (TxIn (EraCrypto era))
   , Set (TxIn (EraCrypto era))
   , [TxOut era]
   , [TxCert era]
   , Map (RewardAccount (EraCrypto era)) Coin
   , Coin
   , ValidityInterval
   , Maybe (Update era)
   , Set (KeyHash 'Witness (EraCrypto era))
   , MultiAsset (EraCrypto era)
   , Maybe (ScriptIntegrityHash (EraCrypto era))
   , Maybe (AuxiliaryDataHash (EraCrypto era))
   , Maybe Network
   ]

instance
  ( EraTxOut era
  , EraTxCert era
  ) =>
  HasSimpleRep (AlonzoTxBody era)
  where
  type SimpleRep (AlonzoTxBody era) = SOP '["AlonzoTxBody" ::: AlonzoTxBodyTypes era]
  toSimpleRep :: AlonzoTxBody era -> SimpleRep (AlonzoTxBody era)
toSimpleRep (AlonzoTxBody Set (TxIn (EraCrypto era))
inputs Set (TxIn (EraCrypto era))
colinputs StrictSeq (TxOut era)
os StrictSeq (TxCert era)
certs Withdrawals (EraCrypto era)
w Coin
c ValidityInterval
vi StrictMaybe (Update era)
up Set (KeyHash 'Witness (EraCrypto era))
kh MultiAsset (EraCrypto era)
ma StrictMaybe (ScriptIntegrityHash (EraCrypto era))
ihash StrictMaybe (AuxiliaryDataHash (EraCrypto era))
aux StrictMaybe Network
nw) =
    forall (c :: Symbol) (constrs :: [*]).
Inject c constrs (SOP constrs) =>
FunTy (ConstrOf c constrs) (SOP constrs)
inject @"AlonzoTxBody" @'["AlonzoTxBody" ::: AlonzoTxBodyTypes era]
      Set (TxIn (EraCrypto era))
inputs
      Set (TxIn (EraCrypto era))
colinputs
      (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (TxOut era)
os)
      (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (TxCert era)
certs)
      (forall c. Withdrawals c -> Map (RewardAccount c) Coin
unWithdrawals Withdrawals (EraCrypto era)
w)
      Coin
c
      ValidityInterval
vi
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (Update era)
up)
      Set (KeyHash 'Witness (EraCrypto era))
kh
      MultiAsset (EraCrypto era)
ma
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (ScriptIntegrityHash (EraCrypto era))
ihash)
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (AuxiliaryDataHash (EraCrypto era))
aux)
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Network
nw)

  fromSimpleRep :: SimpleRep (AlonzoTxBody era) -> AlonzoTxBody era
fromSimpleRep SimpleRep (AlonzoTxBody era)
rep =
    forall (constrs :: [*]) r.
SOPLike constrs r =>
SOP constrs -> ALG constrs r
algebra @'["AlonzoTxBody" ::: AlonzoTxBodyTypes era]
      SimpleRep (AlonzoTxBody era)
rep
      ( \Set (TxIn (EraCrypto era))
inputs Set (TxIn (EraCrypto era))
colinputs [TxOut era]
os [TxCert era]
certs Map (RewardAccount (EraCrypto era)) Coin
w Coin
c ValidityInterval
vi Maybe (Update era)
up Set (KeyHash 'Witness (EraCrypto era))
kh MultiAsset (EraCrypto era)
ma Maybe (ScriptIntegrityHash (EraCrypto era))
ihash Maybe (AuxiliaryDataHash (EraCrypto era))
aux Maybe Network
nw ->
          forall era.
(EraTxOut era, EraTxCert era) =>
Set (TxIn (EraCrypto era))
-> Set (TxIn (EraCrypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals (EraCrypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> Set (KeyHash 'Witness (EraCrypto era))
-> MultiAsset (EraCrypto era)
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
-> StrictMaybe Network
-> AlonzoTxBody era
AlonzoTxBody
            Set (TxIn (EraCrypto era))
inputs
            Set (TxIn (EraCrypto era))
colinputs
            (forall a. [a] -> StrictSeq a
SS.fromList [TxOut era]
os)
            (forall a. [a] -> StrictSeq a
SS.fromList [TxCert era]
certs)
            (forall c. Map (RewardAccount c) Coin -> Withdrawals c
Withdrawals Map (RewardAccount (EraCrypto era)) Coin
w)
            Coin
c
            ValidityInterval
vi
            (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (Update era)
up)
            Set (KeyHash 'Witness (EraCrypto era))
kh
            MultiAsset (EraCrypto era)
ma
            (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (ScriptIntegrityHash (EraCrypto era))
ihash)
            (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (AuxiliaryDataHash (EraCrypto era))
aux)
            (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe Network
nw)
      )

instance
  ( EraSpecPParams era
  , IsConwayUniv fn
  , HasSpec fn (TxOut era)
  , HasSpec fn (TxCert era)
  ) =>
  HasSpec fn (AlonzoTxBody era)

fromAlonzoBody :: forall era. AlonzoEraTxBody era => AlonzoTxBody era -> TxBody era
fromAlonzoBody :: forall era. AlonzoEraTxBody era => AlonzoTxBody era -> TxBody era
fromAlonzoBody (AlonzoTxBody Set (TxIn (EraCrypto era))
colinputs Set (TxIn (EraCrypto era))
inputs StrictSeq (TxOut era)
outputs StrictSeq (TxCert era)
certs Withdrawals (EraCrypto era)
withdrawals Coin
coin ValidityInterval
vi StrictMaybe (Update era)
_up Set (KeyHash 'Witness (EraCrypto era))
kh MultiAsset (EraCrypto era)
ma StrictMaybe (ScriptIntegrityHash (EraCrypto era))
ihash StrictMaybe (AuxiliaryDataHash (EraCrypto era))
aux StrictMaybe Network
nw) =
  forall era. EraTxBody era => TxBody era
mkBasicTxBody @era
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
inputsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (TxIn (EraCrypto era))
inputs
    forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
collateralInputsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (TxIn (EraCrypto era))
colinputs
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxOut era)
outputs
    forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
coin
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (Withdrawals (EraCrypto era))
withdrawalsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals (EraCrypto era)
withdrawals
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxCert era)
certs
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (AuxiliaryDataHash (EraCrypto era)))
auxDataHashTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (AuxiliaryDataHash (EraCrypto era))
aux
    forall a b. a -> (a -> b) -> b
& forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
vldtTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValidityInterval
vi
    forall a b. a -> (a -> b) -> b
& forall era.
MaryEraTxBody era =>
Lens' (TxBody era) (MultiAsset (EraCrypto era))
mintTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ MultiAsset (EraCrypto era)
ma
    forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
collateralInputsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (TxIn (EraCrypto era))
colinputs
    forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (KeyHash 'Witness (EraCrypto era)))
reqSignerHashesTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (KeyHash 'Witness (EraCrypto era))
kh
    forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (ScriptIntegrityHash (EraCrypto era)))
scriptIntegrityHashTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (ScriptIntegrityHash (EraCrypto era))
ihash
    forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe Network)
networkIdTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Network
nw

-- =================================================================================
-- BabbageTxBody

-- | This is an abstraction of the Pattern BabbageTxBody, that uses [x] instead of (StrictSeq x)
--   and (Maybe x) instead of (StrictMaybe x). It transforms between the abstractions and the
--   real types in the toSimpleRep and fromSimpleRep methods. This makes it much easier to
--   write Specifications, because the Constrained packaage knows about Lists and Maybe.
type BabbageTxBodyTypes era =
  '[ Set (TxIn (EraCrypto era))
   , Set (TxIn (EraCrypto era))
   , Set (TxIn (EraCrypto era))
   , [Sized (TxOut era)]
   , Maybe (Sized (TxOut era))
   , Maybe Coin
   , [TxCert era]
   , Map (RewardAccount (EraCrypto era)) Coin -- Withdrawals without the newtype
   , Coin
   , ValidityInterval
   , Maybe (Update era)
   , Set (KeyHash 'Witness (EraCrypto era))
   , MultiAsset (EraCrypto era)
   , Maybe (ScriptIntegrityHash (EraCrypto era))
   , Maybe (AuxiliaryDataHash (EraCrypto era))
   , Maybe Network
   ]

instance
  (EraTxOut era, EraTxCert era, BabbageEraTxBody era) =>
  HasSimpleRep (BabbageTxBody era)
  where
  type SimpleRep (BabbageTxBody era) = SOP '["BabbageTxBody" ::: BabbageTxBodyTypes era]
  toSimpleRep :: BabbageTxBody era -> SimpleRep (BabbageTxBody era)
toSimpleRep (BabbageTxBody Set (TxIn (EraCrypto era))
inputs Set (TxIn (EraCrypto era))
colinputs Set (TxIn (EraCrypto era))
refinputs StrictSeq (Sized (TxOut era))
os StrictMaybe (Sized (TxOut era))
colOut StrictMaybe Coin
coin StrictSeq (TxCert era)
certs Withdrawals (EraCrypto era)
w Coin
c ValidityInterval
vi StrictMaybe (Update era)
up Set (KeyHash 'Witness (EraCrypto era))
kh MultiAsset (EraCrypto era)
ma StrictMaybe (ScriptIntegrityHash (EraCrypto era))
ihash StrictMaybe (AuxiliaryDataHash (EraCrypto era))
aux StrictMaybe Network
nw) =
    forall (c :: Symbol) (constrs :: [*]).
Inject c constrs (SOP constrs) =>
FunTy (ConstrOf c constrs) (SOP constrs)
inject @"BabbageTxBody" @'["BabbageTxBody" ::: BabbageTxBodyTypes era]
      Set (TxIn (EraCrypto era))
inputs
      Set (TxIn (EraCrypto era))
colinputs
      Set (TxIn (EraCrypto era))
refinputs
      (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (Sized (TxOut era))
os)
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (Sized (TxOut era))
colOut)
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Coin
coin)
      (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (TxCert era)
certs)
      (forall c. Withdrawals c -> Map (RewardAccount c) Coin
unWithdrawals Withdrawals (EraCrypto era)
w)
      Coin
c
      ValidityInterval
vi
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (Update era)
up)
      Set (KeyHash 'Witness (EraCrypto era))
kh
      MultiAsset (EraCrypto era)
ma
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (ScriptIntegrityHash (EraCrypto era))
ihash)
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (AuxiliaryDataHash (EraCrypto era))
aux)
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Network
nw)

  fromSimpleRep :: SimpleRep (BabbageTxBody era) -> BabbageTxBody era
fromSimpleRep SimpleRep (BabbageTxBody era)
rep =
    forall (constrs :: [*]) r.
SOPLike constrs r =>
SOP constrs -> ALG constrs r
algebra @'["BabbageTxBody" ::: BabbageTxBodyTypes era]
      SimpleRep (BabbageTxBody era)
rep
      ( \Set (TxIn (EraCrypto era))
inputs Set (TxIn (EraCrypto era))
colinputs Set (TxIn (EraCrypto era))
refinputs [Sized (TxOut era)]
os Maybe (Sized (TxOut era))
colret Maybe Coin
totalcol [TxCert era]
certs Map (RewardAccount (EraCrypto era)) Coin
w Coin
fee ValidityInterval
vi Maybe (Update era)
up Set (KeyHash 'Witness (EraCrypto era))
kh MultiAsset (EraCrypto era)
ma Maybe (ScriptIntegrityHash (EraCrypto era))
ihash Maybe (AuxiliaryDataHash (EraCrypto era))
aux Maybe Network
nw ->
          forall era.
BabbageEraTxBody era =>
Set (TxIn (EraCrypto era))
-> Set (TxIn (EraCrypto era))
-> Set (TxIn (EraCrypto era))
-> StrictSeq (Sized (TxOut era))
-> StrictMaybe (Sized (TxOut era))
-> StrictMaybe Coin
-> StrictSeq (TxCert era)
-> Withdrawals (EraCrypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> Set (KeyHash 'Witness (EraCrypto era))
-> MultiAsset (EraCrypto era)
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
-> StrictMaybe Network
-> BabbageTxBody era
BabbageTxBody
            Set (TxIn (EraCrypto era))
inputs
            Set (TxIn (EraCrypto era))
colinputs
            Set (TxIn (EraCrypto era))
refinputs
            (forall a. [a] -> StrictSeq a
SS.fromList [Sized (TxOut era)]
os)
            (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (Sized (TxOut era))
colret)
            (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe Coin
totalcol)
            (forall a. [a] -> StrictSeq a
SS.fromList [TxCert era]
certs)
            (forall c. Map (RewardAccount c) Coin -> Withdrawals c
Withdrawals Map (RewardAccount (EraCrypto era)) Coin
w)
            Coin
fee
            ValidityInterval
vi
            (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (Update era)
up)
            Set (KeyHash 'Witness (EraCrypto era))
kh
            MultiAsset (EraCrypto era)
ma
            (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (ScriptIntegrityHash (EraCrypto era))
ihash)
            (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (AuxiliaryDataHash (EraCrypto era))
aux)
            (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe Network
nw)
      )

instance
  ( EraSpecPParams era
  , BabbageEraTxBody era
  , IsConwayUniv fn
  , HasSpec fn (TxOut era)
  , HasSpec fn (TxCert era)
  ) =>
  HasSpec fn (BabbageTxBody era)

fromBabbageBody :: forall era. BabbageEraTxBody era => BabbageTxBody era -> TxBody era
fromBabbageBody :: forall era. BabbageEraTxBody era => BabbageTxBody era -> TxBody era
fromBabbageBody (BabbageTxBody Set (TxIn (EraCrypto era))
inputs Set (TxIn (EraCrypto era))
colinputs Set (TxIn (EraCrypto era))
refinputs StrictSeq (Sized (TxOut era))
os StrictMaybe (Sized (TxOut era))
colret StrictMaybe Coin
totalcol StrictSeq (TxCert era)
certs Withdrawals (EraCrypto era)
w Coin
fee ValidityInterval
vi StrictMaybe (Update era)
_up Set (KeyHash 'Witness (EraCrypto era))
kh MultiAsset (EraCrypto era)
ma StrictMaybe (ScriptIntegrityHash (EraCrypto era))
ihash StrictMaybe (AuxiliaryDataHash (EraCrypto era))
aux StrictMaybe Network
nw) =
  forall era. EraTxBody era => TxBody era
mkBasicTxBody @era
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
inputsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (TxIn (EraCrypto era))
inputs
    forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
collateralInputsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (TxIn (EraCrypto era))
colinputs
    forall a b. a -> (a -> b) -> b
& forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
referenceInputsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (TxIn (EraCrypto era))
refinputs
    forall a b. a -> (a -> b) -> b
& forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictSeq (Sized (TxOut era)))
sizedOutputsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (Sized (TxOut era))
os
    forall a b. a -> (a -> b) -> b
& forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Sized (TxOut era)))
sizedCollateralReturnTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (Sized (TxOut era))
colret
    forall a b. a -> (a -> b) -> b
& forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictMaybe Coin)
totalCollateralTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Coin
totalcol
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxCert era)
certs
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (Withdrawals (EraCrypto era))
withdrawalsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals (EraCrypto era)
w
    forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
fee
    forall a b. a -> (a -> b) -> b
& forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
vldtTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValidityInterval
vi
    forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (KeyHash 'Witness (EraCrypto era)))
reqSignerHashesTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (KeyHash 'Witness (EraCrypto era))
kh
    forall a b. a -> (a -> b) -> b
& forall era.
MaryEraTxBody era =>
Lens' (TxBody era) (MultiAsset (EraCrypto era))
mintTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ MultiAsset (EraCrypto era)
ma
    forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (ScriptIntegrityHash (EraCrypto era)))
scriptIntegrityHashTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (ScriptIntegrityHash (EraCrypto era))
ihash
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (AuxiliaryDataHash (EraCrypto era)))
auxDataHashTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (AuxiliaryDataHash (EraCrypto era))
aux
    forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe Network)
networkIdTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Network
nw