{-# 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 (..))
import Cardano.Ledger.Allegra.TxBody (AllegraTxBody (..))
import Cardano.Ledger.Alonzo.TxBody (AlonzoTxBody (..))
import Cardano.Ledger.Babbage.TxBody (BabbageTxBody (..))
import Cardano.Ledger.BaseTypes hiding (inject)
import Cardano.Ledger.Binary (EncCBOR (..), Sized (..))
import Cardano.Ledger.Coin
import Cardano.Ledger.Conway.Core
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 (Sized, 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
   , [TxOut era]
   , [TxCert era]
   , Map RewardAccount Coin
   , Coin
   , SlotNo
   , Maybe (Update era)
   , Maybe TxAuxDataHash
   ]

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
is StrictSeq (TxOut era)
os StrictSeq (TxCert era)
certs Withdrawals
w Coin
c SlotNo
s StrictMaybe (Update era)
up StrictMaybe TxAuxDataHash
aux) =
    forall (c :: Symbol) (constrs :: [*]).
Inject c constrs (SOP constrs) =>
FunTy (ConstrOf c constrs) (SOP constrs)
inject @"ShelleyTxBody" @'["ShelleyTxBody" ::: ShelleyTxBodyTypes era]
      Set TxIn
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)
      (Withdrawals -> Map RewardAccount Coin
unWithdrawals Withdrawals
w)
      Coin
c
      SlotNo
s
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (Update era)
up)
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe TxAuxDataHash
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
is [TxOut era]
os [TxCert era]
certs Map RewardAccount Coin
w Coin
c SlotNo
s Maybe (Update era)
up Maybe TxAuxDataHash
aux ->
          forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
Set TxIn
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe TxAuxDataHash
-> ShelleyTxBody era
ShelleyTxBody
            Set TxIn
is
            (forall a. [a] -> StrictSeq a
SS.fromList [TxOut era]
os)
            (forall a. [a] -> StrictSeq a
SS.fromList [TxCert era]
certs)
            (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount 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 TxAuxDataHash
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
inputs StrictSeq (TxOut era)
outputs StrictSeq (TxCert era)
certs Withdrawals
withdrawals Coin
coin SlotNo
_slot StrictMaybe (Update era)
_up StrictMaybe TxAuxDataHash
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)
inputsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
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
withdrawalsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals
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 TxAuxDataHash)
auxDataHashTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe TxAuxDataHash
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
   , [TxOut era]
   , [TxCert era]
   , Map RewardAccount Coin
   , Coin
   , ValidityInterval
   , Maybe (Update era)
   , Maybe TxAuxDataHash
   ]

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
is StrictSeq (TxOut era)
os StrictSeq (TxCert era)
certs Withdrawals
w Coin
c ValidityInterval
vi StrictMaybe (Update era)
up StrictMaybe TxAuxDataHash
aux) =
    forall (c :: Symbol) (constrs :: [*]).
Inject c constrs (SOP constrs) =>
FunTy (ConstrOf c constrs) (SOP constrs)
inject @"AllegraTxBody" @'["AllegraTxBody" ::: AllegraTxBodyTypes era]
      Set TxIn
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)
      (Withdrawals -> Map RewardAccount Coin
unWithdrawals Withdrawals
w)
      Coin
c
      ValidityInterval
vi
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (Update era)
up)
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe TxAuxDataHash
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
is [TxOut era]
os [TxCert era]
certs Map RewardAccount Coin
w Coin
c ValidityInterval
vi Maybe (Update era)
up Maybe TxAuxDataHash
aux ->
          forall era.
(EraTxOut era, EraTxCert era) =>
Set TxIn
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> StrictMaybe TxAuxDataHash
-> AllegraTxBody era
AllegraTxBody
            Set TxIn
is
            (forall a. [a] -> StrictSeq a
SS.fromList [TxOut era]
os)
            (forall a. [a] -> StrictSeq a
SS.fromList [TxCert era]
certs)
            (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount 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 TxAuxDataHash
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
inputs StrictSeq (TxOut era)
outputs StrictSeq (TxCert era)
certs Withdrawals
withdrawals Coin
coin ValidityInterval
vi StrictMaybe (Update era)
_up StrictMaybe TxAuxDataHash
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)
inputsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
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
withdrawalsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals
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 TxAuxDataHash)
auxDataHashTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe TxAuxDataHash
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
   , [TxOut era]
   , [TxCert era]
   , Map RewardAccount Coin
   , Coin
   , ValidityInterval
   , Maybe (Update era)
   , Maybe TxAuxDataHash
   , MultiAsset
   ]

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
is StrictSeq (TxOut era)
os StrictSeq (TxCert era)
certs Withdrawals
w Coin
c ValidityInterval
vi StrictMaybe (Update era)
up StrictMaybe TxAuxDataHash
aux MultiAsset
ma) =
    forall (c :: Symbol) (constrs :: [*]).
Inject c constrs (SOP constrs) =>
FunTy (ConstrOf c constrs) (SOP constrs)
inject @"MaryTxBody" @'["MaryTxBody" ::: MaryTxBodyTypes era]
      Set TxIn
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)
      (Withdrawals -> Map RewardAccount Coin
unWithdrawals Withdrawals
w)
      Coin
c
      ValidityInterval
vi
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (Update era)
up)
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe TxAuxDataHash
aux)
      MultiAsset
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
is [TxOut era]
os [TxCert era]
certs Map RewardAccount Coin
w Coin
c ValidityInterval
vi Maybe (Update era)
up Maybe TxAuxDataHash
aux MultiAsset
ma ->
          forall era.
(EraTxOut era, EraTxCert era) =>
Set TxIn
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> StrictMaybe TxAuxDataHash
-> MultiAsset
-> MaryTxBody era
MaryTxBody
            Set TxIn
is
            (forall a. [a] -> StrictSeq a
SS.fromList [TxOut era]
os)
            (forall a. [a] -> StrictSeq a
SS.fromList [TxCert era]
certs)
            (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount 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 TxAuxDataHash
aux)
            MultiAsset
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
inputs StrictSeq (TxOut era)
outputs StrictSeq (TxCert era)
certs Withdrawals
withdrawals Coin
coin ValidityInterval
vi StrictMaybe (Update era)
_up StrictMaybe TxAuxDataHash
aux MultiAsset
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)
inputsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
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
withdrawalsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals
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 TxAuxDataHash)
auxDataHashTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe TxAuxDataHash
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
mintTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ MultiAsset
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
   , Set TxIn
   , [TxOut era]
   , [TxCert era]
   , Map RewardAccount Coin
   , Coin
   , ValidityInterval
   , Maybe (Update era)
   , Set (KeyHash 'Witness)
   , MultiAsset
   , Maybe ScriptIntegrityHash
   , Maybe TxAuxDataHash
   , 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
inputs Set TxIn
colinputs StrictSeq (TxOut era)
os StrictSeq (TxCert era)
certs Withdrawals
w Coin
c ValidityInterval
vi StrictMaybe (Update era)
up Set (KeyHash 'Witness)
kh MultiAsset
ma StrictMaybe ScriptIntegrityHash
ihash StrictMaybe TxAuxDataHash
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
inputs
      Set TxIn
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)
      (Withdrawals -> Map RewardAccount Coin
unWithdrawals Withdrawals
w)
      Coin
c
      ValidityInterval
vi
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (Update era)
up)
      Set (KeyHash 'Witness)
kh
      MultiAsset
ma
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe ScriptIntegrityHash
ihash)
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe TxAuxDataHash
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
inputs Set TxIn
colinputs [TxOut era]
os [TxCert era]
certs Map RewardAccount Coin
w Coin
c ValidityInterval
vi Maybe (Update era)
up Set (KeyHash 'Witness)
kh MultiAsset
ma Maybe ScriptIntegrityHash
ihash Maybe TxAuxDataHash
aux Maybe Network
nw ->
          forall era.
(EraTxOut era, EraTxCert era) =>
Set TxIn
-> Set TxIn
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> Set (KeyHash 'Witness)
-> MultiAsset
-> StrictMaybe ScriptIntegrityHash
-> StrictMaybe TxAuxDataHash
-> StrictMaybe Network
-> AlonzoTxBody era
AlonzoTxBody
            Set TxIn
inputs
            Set TxIn
colinputs
            (forall a. [a] -> StrictSeq a
SS.fromList [TxOut era]
os)
            (forall a. [a] -> StrictSeq a
SS.fromList [TxCert era]
certs)
            (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
w)
            Coin
c
            ValidityInterval
vi
            (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (Update era)
up)
            Set (KeyHash 'Witness)
kh
            MultiAsset
ma
            (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe ScriptIntegrityHash
ihash)
            (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe TxAuxDataHash
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
colinputs Set TxIn
inputs StrictSeq (TxOut era)
outputs StrictSeq (TxCert era)
certs Withdrawals
withdrawals Coin
coin ValidityInterval
vi StrictMaybe (Update era)
_up Set (KeyHash 'Witness)
kh MultiAsset
ma StrictMaybe ScriptIntegrityHash
ihash StrictMaybe TxAuxDataHash
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)
inputsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
inputs
    forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
collateralInputsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
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
withdrawalsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals
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 TxAuxDataHash)
auxDataHashTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe TxAuxDataHash
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
mintTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ MultiAsset
ma
    forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
collateralInputsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
colinputs
    forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (KeyHash 'Witness))
reqSignerHashesTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (KeyHash 'Witness)
kh
    forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
scriptIntegrityHashTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe ScriptIntegrityHash
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
   , Set TxIn
   , Set TxIn
   , [Sized (TxOut era)]
   , Maybe (Sized (TxOut era))
   , Maybe Coin
   , [TxCert era]
   , Map RewardAccount Coin -- Withdrawals without the newtype
   , Coin
   , ValidityInterval
   , Maybe (Update era)
   , Set (KeyHash 'Witness)
   , MultiAsset
   , Maybe ScriptIntegrityHash
   , Maybe TxAuxDataHash
   , 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
inputs Set TxIn
colinputs Set TxIn
refinputs StrictSeq (Sized (TxOut era))
os StrictMaybe (Sized (TxOut era))
colOut StrictMaybe Coin
coin StrictSeq (TxCert era)
certs Withdrawals
w Coin
c ValidityInterval
vi StrictMaybe (Update era)
up Set (KeyHash 'Witness)
kh MultiAsset
ma StrictMaybe ScriptIntegrityHash
ihash StrictMaybe TxAuxDataHash
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
inputs
      Set TxIn
colinputs
      Set TxIn
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)
      (Withdrawals -> Map RewardAccount Coin
unWithdrawals Withdrawals
w)
      Coin
c
      ValidityInterval
vi
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (Update era)
up)
      Set (KeyHash 'Witness)
kh
      MultiAsset
ma
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe ScriptIntegrityHash
ihash)
      (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe TxAuxDataHash
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
inputs Set TxIn
colinputs Set TxIn
refinputs [Sized (TxOut era)]
os Maybe (Sized (TxOut era))
colret Maybe Coin
totalcol [TxCert era]
certs Map RewardAccount Coin
w Coin
fee ValidityInterval
vi Maybe (Update era)
up Set (KeyHash 'Witness)
kh MultiAsset
ma Maybe ScriptIntegrityHash
ihash Maybe TxAuxDataHash
aux Maybe Network
nw ->
          forall era.
BabbageEraTxBody era =>
Set TxIn
-> Set TxIn
-> Set TxIn
-> StrictSeq (Sized (TxOut era))
-> StrictMaybe (Sized (TxOut era))
-> StrictMaybe Coin
-> StrictSeq (TxCert era)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> Set (KeyHash 'Witness)
-> MultiAsset
-> StrictMaybe ScriptIntegrityHash
-> StrictMaybe TxAuxDataHash
-> StrictMaybe Network
-> BabbageTxBody era
BabbageTxBody
            Set TxIn
inputs
            Set TxIn
colinputs
            Set TxIn
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)
            (Map RewardAccount Coin -> Withdrawals
Withdrawals Map RewardAccount Coin
w)
            Coin
fee
            ValidityInterval
vi
            (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (Update era)
up)
            Set (KeyHash 'Witness)
kh
            MultiAsset
ma
            (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe ScriptIntegrityHash
ihash)
            (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe TxAuxDataHash
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
inputs Set TxIn
colinputs Set TxIn
refinputs StrictSeq (Sized (TxOut era))
os StrictMaybe (Sized (TxOut era))
colret StrictMaybe Coin
totalcol StrictSeq (TxCert era)
certs Withdrawals
w Coin
fee ValidityInterval
vi StrictMaybe (Update era)
_up Set (KeyHash 'Witness)
kh MultiAsset
ma StrictMaybe ScriptIntegrityHash
ihash StrictMaybe TxAuxDataHash
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)
inputsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
inputs
    forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
collateralInputsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
colinputs
    forall a b. a -> (a -> b) -> b
& forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
referenceInputsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
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
withdrawalsTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Withdrawals
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))
reqSignerHashesTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (KeyHash 'Witness)
kh
    forall a b. a -> (a -> b) -> b
& forall era. MaryEraTxBody era => Lens' (TxBody era) MultiAsset
mintTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ MultiAsset
ma
    forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
scriptIntegrityHashTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe ScriptIntegrityHash
ihash
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictMaybe TxAuxDataHash)
auxDataHashTxBodyL @era forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe TxAuxDataHash
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