Jj/multi level txs

eras/allegra/impl/src/Cardano/Ledger/Allegra/TxBody.hs

@@ -285,11 +285,7 @@ pattern AllegraTxBody
 
 {-# COMPLETE AllegraTxBody #-}
 
-instance EraTxBody AllegraEra where
-  newtype TxBody AllegraEra = MkAllegraTxBody (MemoBytes (AllegraTxBodyRaw () AllegraEra))
-    deriving newtype (SafeToHash, ToCBOR)
-
-  mkBasicTxBody = mkMemoizedEra @AllegraEra emptyAllegraTxBodyRaw
+instance EraTxBodyCommon AllegraEra TxBody where
 
   inputsTxBodyL =
     lensMemoRawType @AllegraEra atbrInputs $
@@ -326,6 +322,12 @@ instance EraTxBody AllegraEra where
       \txBodyRaw certs -> txBodyRaw {atbrCerts = certs}
   {-# INLINEABLE certsTxBodyL #-}
 
+instance EraTxBody AllegraEra where
+  newtype TxBody AllegraEra = MkAllegraTxBody (MemoBytes (AllegraTxBodyRaw () AllegraEra))
+    deriving newtype (SafeToHash, ToCBOR)
+
+  mkBasicTxBody = mkMemoizedEra @AllegraEra emptyAllegraTxBodyRaw
+
   getGenesisKeyHashCountTxBody = getShelleyGenesisKeyHashCountTxBody
 
 instance ShelleyEraTxBody AllegraEra where

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs

@@ -197,13 +197,7 @@ deriving instance Show AlonzoTxBodyRaw
 instance Memoized (TxBody AlonzoEra) where
   type RawType (TxBody AlonzoEra) = AlonzoTxBodyRaw
 
-instance EraTxBody AlonzoEra where
-  newtype TxBody AlonzoEra = MkAlonzoTxBody (MemoBytes AlonzoTxBodyRaw)
-    deriving (ToCBOR, Generic)
-    deriving newtype (SafeToHash)
-
-  mkBasicTxBody = mkMemoizedEra @AlonzoEra emptyAlonzoTxBodyRaw
-
+instance EraTxBodyCommon AlonzoEra TxBody where
   inputsTxBodyL =
     lensMemoRawType @AlonzoEra atbrInputs $
       \txBodyRaw inputs_ -> txBodyRaw {atbrInputs = inputs_}
@@ -241,6 +235,13 @@ instance EraTxBody AlonzoEra where
       \txBodyRaw certs_ -> txBodyRaw {atbrCerts = certs_}
   {-# INLINEABLE certsTxBodyL #-}
 
+instance EraTxBody AlonzoEra where
+  newtype TxBody AlonzoEra = MkAlonzoTxBody (MemoBytes AlonzoTxBodyRaw)
+    deriving (ToCBOR, Generic)
+    deriving newtype (SafeToHash)
+
+  mkBasicTxBody = mkMemoizedEra @AlonzoEra emptyAlonzoTxBodyRaw
+
   getGenesisKeyHashCountTxBody = getShelleyGenesisKeyHashCountTxBody
 
 instance ShelleyEraTxBody AlonzoEra where

eras/alonzo/impl/test/Test/Cardano/Ledger/Alonzo/Imp/TxInfoSpec.hs

@@ -8,7 +8,7 @@ import Cardano.Ledger.Alonzo (AlonzoEra)
 import Cardano.Ledger.Alonzo.Core (
   EraTx (..),
   EraTxBody (..),
-  EraTxOut (..),
+  EraTxOut (..), EraTxBodyCommon (..),
  )
 import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusTxInfo (..), LedgerTxInfo (..))
 import Cardano.Ledger.BaseTypes

eras/babbage/impl/src/Cardano/Ledger/Babbage/TxBody.hs

@@ -238,12 +238,7 @@ allSizedOutputsBabbageTxBodyF =
           SJust collTxOut -> txOuts |> collTxOut
 {-# INLINEABLE allSizedOutputsBabbageTxBodyF #-}
 
-instance EraTxBody BabbageEra where
-  newtype TxBody BabbageEra = MkBabbageTxBody (MemoBytes BabbageTxBodyRaw)
-    deriving newtype (Generic, SafeToHash, ToCBOR)
-
-  mkBasicTxBody = mkMemoizedEra @BabbageEra basicBabbageTxBodyRaw
-
+instance EraTxBodyCommon BabbageEra TxBody where
   inputsTxBodyL =
     lensMemoRawType @BabbageEra btbrInputs $ \txBodyRaw inputs -> txBodyRaw {btbrInputs = inputs}
   {-# INLINE inputsTxBodyL #-}
@@ -277,6 +272,12 @@ instance EraTxBody BabbageEra where
     lensMemoRawType @BabbageEra btbrCerts $ \txBodyRaw certs -> txBodyRaw {btbrCerts = certs}
   {-# INLINE certsTxBodyL #-}
 
+instance EraTxBody BabbageEra where
+  newtype TxBody BabbageEra = MkBabbageTxBody (MemoBytes BabbageTxBodyRaw)
+    deriving newtype (Generic, SafeToHash, ToCBOR)
+
+  mkBasicTxBody = mkMemoizedEra @BabbageEra basicBabbageTxBodyRaw
+
   getGenesisKeyHashCountTxBody = getShelleyGenesisKeyHashCountTxBody
 
 instance ShelleyEraTxBody BabbageEra where

eras/conway/impl/src/Cardano/Ledger/Conway/TxBody.hs

@@ -282,12 +282,7 @@ basicConwayTxBodyRaw =
     SNothing
     mempty
 
-instance EraTxBody ConwayEra where
-  newtype TxBody ConwayEra = MkConwayTxBody (MemoBytes ConwayTxBodyRaw)
-    deriving (Generic, SafeToHash, ToCBOR)
-
-  mkBasicTxBody = mkConwayTxBody
-
+instance EraTxBodyCommon ConwayEra TxBody where
   inputsTxBodyL = lensMemoRawType @ConwayEra ctbrSpendInputs $
     \txb x -> txb {ctbrSpendInputs = x}
   {-# INLINE inputsTxBodyL #-}
@@ -324,6 +319,12 @@ instance EraTxBody ConwayEra where
   getTotalRefundsTxBody pp lookupStakingDeposit lookupDRepDeposit txBody =
     getTotalRefundsTxCerts pp lookupStakingDeposit lookupDRepDeposit (txBody ^. certsTxBodyL)
 
+instance EraTxBody ConwayEra where
+  newtype TxBody ConwayEra = MkConwayTxBody (MemoBytes ConwayTxBodyRaw)
+    deriving (Generic, SafeToHash, ToCBOR)
+
+  mkBasicTxBody = mkConwayTxBody
+
 -- ==========================================
 -- Deposits and Refunds for Conway TxBody
 

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/UtxowSpec.hs

@@ -25,6 +25,7 @@ import Cardano.Ledger.Conway.Core (
   EraIndependentScriptIntegrity,
   EraTx (..),
   EraTxBody (..),
+  EraTxBodyCommon (..),
   EraTxOut (..),
   EraTxWits (..),
   InjectRuleFailure (..),

eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/TxBody.hs

@@ -13,6 +13,7 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
@@ -40,11 +41,13 @@ module Cardano.Ledger.Dijkstra.TxBody (
     dtbProposalProcedures,
     dtbCurrentTreasuryValue,
     dtbTreasuryDonation,
-    dtbGuards
+    dtbGuards,
+    dtbSubTransactions
   ),
   upgradeProposals,
   upgradeGovAction,
   DijkstraTxBodyRaw (..),
+  DijkstraSubTxBodyRaw (..),
 ) where
 
 import Cardano.Ledger.Alonzo.TxBody (Indexable (..))
@@ -110,18 +113,20 @@ import Cardano.Ledger.MemoBytes (
   lensMemoRawType,
   mkMemoizedEra,
  )
-import Cardano.Ledger.TxIn (TxIn)
+import Cardano.Ledger.TxIn (TxId, TxIn)
 import Cardano.Ledger.Val (Val (..))
 import Control.DeepSeq (NFData)
 import Data.Coerce (coerce)
+import Data.Kind (Type)
+import qualified Data.OMap.Strict as OMap
 import Data.OSet.Strict (OSet, decodeOSet)
 import qualified Data.OSet.Strict as OSet
 import Data.STRef (newSTRef, readSTRef, writeSTRef)
 import Data.Sequence.Strict (StrictSeq)
 import Data.Set (Set, foldr')
 import qualified Data.Set as Set
 import GHC.Generics (Generic)
-import Lens.Micro (Lens', to, (^.))
+import Lens.Micro (Lens', lens, to, (^.))
 import NoThunks.Class (NoThunks)
 
 data DijkstraTxBodyRaw = DijkstraTxBodyRaw
@@ -144,6 +149,7 @@ data DijkstraTxBodyRaw = DijkstraTxBodyRaw
   , dtbrProposalProcedures :: !(OSet.OSet (ProposalProcedure DijkstraEra))
   , dtbrCurrentTreasuryValue :: !(StrictMaybe Coin)
   , dtbrTreasuryDonation :: !Coin
+  , dtbrSubTransactions :: !(OMap.OMap TxId (SubTxBody DijkstraEra))
   }
   deriving (Generic)
 
@@ -179,6 +185,7 @@ basicDijkstraTxBodyRaw =
     OSet.empty
     SNothing
     mempty
+    mempty
 
 instance DecCBOR DijkstraTxBodyRaw where
   decCBOR =
@@ -273,8 +280,8 @@ encodeTxBodyRaw ::
 encodeTxBodyRaw DijkstraTxBodyRaw {..} =
   let ValidityInterval bot top = dtbrVldt
    in Keyed
-        ( \i ci ri o cr tc f t c w b ->
-            DijkstraTxBodyRaw i ci ri o cr tc c w f (ValidityInterval b t)
+        ( \i ci ri o cr tc f t c w b stxs ->
+            DijkstraTxBodyRaw i ci ri o cr tc c w f (ValidityInterval b t) stxs
         )
         !> Key 0 (To dtbrSpendInputs)
         !> Omit null (Key 13 (To dtbrCollateralInputs))
@@ -296,6 +303,7 @@ encodeTxBodyRaw DijkstraTxBodyRaw {..} =
         !> Omit OSet.null (Key 20 (To dtbrProposalProcedures))
         !> encodeKeyedStrictMaybe 21 dtbrCurrentTreasuryValue
         !> Omit (== mempty) (Key 22 $ To dtbrTreasuryDonation)
+        !> undefined
 
 instance EncCBOR DijkstraTxBodyRaw where
   encCBOR = encode . encodeTxBodyRaw
@@ -328,6 +336,7 @@ pattern DijkstraTxBody ::
   OSet.OSet (ProposalProcedure DijkstraEra) ->
   StrictMaybe Coin ->
   Coin ->
+  OMap.OMap TxId (SubTxBody DijkstraEra) ->
   TxBody DijkstraEra
 pattern DijkstraTxBody
   { dtbSpendInputs
@@ -349,6 +358,7 @@ pattern DijkstraTxBody
   , dtbProposalProcedures
   , dtbCurrentTreasuryValue
   , dtbTreasuryDonation
+  , dtbSubTransactions
   } <-
   ( getMemoRawType ->
       DijkstraTxBodyRaw
@@ -371,6 +381,7 @@ pattern DijkstraTxBody
         , dtbrProposalProcedures = dtbProposalProcedures
         , dtbrCurrentTreasuryValue = dtbCurrentTreasuryValue
         , dtbrTreasuryDonation = dtbTreasuryDonation
+        , dtbrSubTransactions = dtbSubTransactions
         }
     )
   where
@@ -393,7 +404,8 @@ pattern DijkstraTxBody
       votingProcedures
       proposalProcedures
       currentTreasuryValue
-      treasuryDonation =
+      treasuryDonation
+      subTransactions =
         mkMemoizedEra @DijkstraEra $
           DijkstraTxBodyRaw
             inputsX
@@ -415,6 +427,7 @@ pattern DijkstraTxBody
             proposalProcedures
             currentTreasuryValue
             treasuryDonation
+            subTransactions
 
 {-# COMPLETE DijkstraTxBody #-}
 
@@ -433,12 +446,7 @@ instance DecCBOR (Annotator DijkstraTxBodyRaw) where
 
 deriving via Mem DijkstraTxBodyRaw instance DecCBOR (Annotator (TxBody DijkstraEra))
 
-instance EraTxBody DijkstraEra where
-  newtype TxBody DijkstraEra = MkDijkstraTxBody (MemoBytes DijkstraTxBodyRaw)
-    deriving (Generic, SafeToHash, ToCBOR)
-
-  mkBasicTxBody = mkMemoizedEra @DijkstraEra basicDijkstraTxBodyRaw
-
+instance EraTxBodyCommon DijkstraEra TxBody where
   inputsTxBodyL = lensMemoRawType @DijkstraEra dtbrSpendInputs $
     \txb x -> txb {dtbrSpendInputs = x}
   {-# INLINE inputsTxBodyL #-}
@@ -475,6 +483,42 @@ instance EraTxBody DijkstraEra where
   getTotalRefundsTxBody pp lookupStakingDeposit lookupDRepDeposit txBody =
     getTotalRefundsTxCerts pp lookupStakingDeposit lookupDRepDeposit (txBody ^. certsTxBodyL)
 
+instance EraTxBodyCommon DijkstraEra SubTxBody where
+  inputsTxBodyL = undefined
+  {-# INLINE inputsTxBodyL #-}
+
+  outputsTxBodyL = undefined
+  {-# INLINE outputsTxBodyL #-}
+
+  feeTxBodyL = undefined
+  {-# INLINE feeTxBodyL #-}
+
+  auxDataHashTxBodyL = undefined
+  {-# INLINE auxDataHashTxBodyL #-}
+
+  spendableInputsTxBodyF = undefined
+  {-# INLINE spendableInputsTxBodyF #-}
+
+  allInputsTxBodyF = undefined
+  {-# INLINE allInputsTxBodyF #-}
+
+  withdrawalsTxBodyL = undefined
+  {-# INLINE withdrawalsTxBodyL #-}
+
+  certsTxBodyL = undefined
+  {-# INLINE certsTxBodyL #-}
+
+  getTotalDepositsTxBody = undefined
+
+  getTotalRefundsTxBody pp lookupStakingDeposit lookupDRepDeposit txBody =
+    getTotalRefundsTxCerts pp lookupStakingDeposit lookupDRepDeposit (txBody ^. certsTxBodyL)
+
+instance EraTxBody DijkstraEra where
+  newtype TxBody DijkstraEra = MkDijkstraTxBody (MemoBytes DijkstraTxBodyRaw)
+    deriving (Generic, SafeToHash, ToCBOR)
+
+  mkBasicTxBody = mkMemoizedEra @DijkstraEra basicDijkstraTxBodyRaw
+
 upgradeGovAction ::
   forall era.
   (AlonzoEraPParams era, EraPParams (PreviousEra era)) =>
@@ -649,10 +693,20 @@ instance ConwayEraTxBody DijkstraEra where
       \txb x -> txb {dtbrTreasuryDonation = x}
   {-# INLINE treasuryDonationTxBodyL #-}
 
-class ConwayEraTxBody era => DijkstraEraTxBody era where
+class
+  ( ConwayEraTxBody era
+  , EraTxBodyCommon era SubTxBody
+  ) =>
+  DijkstraEraTxBody era
+  where
+  data SubTxBody era :: Type
+
   guardsTxBodyL :: Lens' (TxBody era) (OSet (Credential Guard))
 
 instance DijkstraEraTxBody DijkstraEra where
+  newtype SubTxBody DijkstraEra = MkDijkstraSubTxBody DijkstraSubTxBodyRaw
+    deriving (Generic, Eq, NoThunks, NFData, Show)
+
   {-# INLINE guardsTxBodyL #-}
   guardsTxBodyL =
     lensMemoRawType @DijkstraEra dtbrGuards $
@@ -679,3 +733,32 @@ decodeGuards = do
         Just True -> decCBOR
         Just False -> KeyHashObj <$> decCBOR
   decodeOSet decodeElement
+
+data DijkstraSubTxBodyRaw = DijkstraSubTxBodyRaw
+  { dstbrSpendInputs :: !(Set TxIn)
+  , dstbrCollateralInputs :: !(Set TxIn)
+  , dstbrReferenceInputs :: !(Set TxIn)
+  , dstbrOutputs :: !(StrictSeq (Sized (TxOut DijkstraEra)))
+  , dstbrCollateralReturn :: !(StrictMaybe (Sized (TxOut DijkstraEra)))
+  , dstbrTotalCollateral :: !(StrictMaybe Coin)
+  , dstbrCerts :: !(OSet.OSet (TxCert DijkstraEra))
+  , dstbrWithdrawals :: !Withdrawals
+  , dstbrFee :: !Coin
+  , dstbrVldt :: !ValidityInterval
+  , dstbrMint :: !MultiAsset
+  , dstbrScriptIntegrityHash :: !(StrictMaybe ScriptIntegrityHash)
+  , dstbrAuxDataHash :: !(StrictMaybe TxAuxDataHash)
+  , dstbrNetworkId :: !(StrictMaybe Network)
+  , dstbrVotingProcedures :: !(VotingProcedures DijkstraEra)
+  , dstbrProposalProcedures :: !(OSet.OSet (ProposalProcedure DijkstraEra))
+  , dstbrCurrentTreasuryValue :: !(StrictMaybe Coin)
+  , dstbrTreasuryDonation :: !Coin
+  }
+  deriving (Generic, Eq, Show)
+
+instance NoThunks DijkstraSubTxBodyRaw
+
+instance NFData DijkstraSubTxBodyRaw
+
+instance OMap.HasOKey TxId (SubTxBody DijkstraEra) where
+  okeyL = lens undefined undefined

eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Arbitrary.hs

@@ -22,7 +22,7 @@ import Cardano.Ledger.Dijkstra.PParams (DijkstraPParams, UpgradeDijkstraPParams)
 import Cardano.Ledger.Dijkstra.Scripts
 import Cardano.Ledger.Dijkstra.Transition (TransitionConfig (..))
 import Cardano.Ledger.Dijkstra.Tx (Tx (..))
-import Cardano.Ledger.Dijkstra.TxBody (TxBody (..))
+import Cardano.Ledger.Dijkstra.TxBody (DijkstraEraTxBody (..), DijkstraSubTxBodyRaw, TxBody (..))
 import Cardano.Ledger.Dijkstra.TxCert
 import Cardano.Ledger.Shelley.Scripts (
   pattern RequireSignature,
@@ -40,6 +40,13 @@ instance Arbitrary (DijkstraPParams Identity DijkstraEra) where
 instance Arbitrary (DijkstraPParams StrictMaybe DijkstraEra) where
   arbitrary = genericArbitraryU
 
+-- TODO we probably want to scale the validity interval and multiasset here as well
+instance Arbitrary DijkstraSubTxBodyRaw where
+  arbitrary = genericArbitraryU
+
+instance Arbitrary (SubTxBody DijkstraEra) where
+  arbitrary = genericArbitraryU
+
 instance Arbitrary (TxBody DijkstraEra) where
   arbitrary =
     DijkstraTxBody
@@ -62,6 +69,7 @@ instance Arbitrary (TxBody DijkstraEra) where
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
+      <*> arbitrary
 
 instance Arbitrary (UpgradeDijkstraPParams Identity DijkstraEra) where
   arbitrary = genericArbitraryU

eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Examples.hs

@@ -114,6 +114,7 @@ exampleTxBodyDijkstra =
     mempty
     (SJust $ Coin 867530900000) -- current treasury value
     mempty
+    mempty
   where
     MaryValue _ exampleMultiAsset = exampleMultiAssetValue 3