Add DijkstraTx

Author: Soupstraw

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

@@ -1,33 +1,33 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module Cardano.Ledger.Dijkstra.Tx (
+  DijkstraTx (..),
   Tx (..),
   validateDijkstraNativeScript,
 ) where
 
-import Cardano.Ledger.Allegra.TxBody (AllegraEraTxBody (..))
+import Cardano.Ledger.Allegra.TxBody (AllegraEraTxBody (..), StrictMaybe)
 import Cardano.Ledger.Alonzo.Tx (
   AlonzoEraTx,
-  AlonzoTx (..),
+  IsValid,
   alonzoTxEqRaw,
-  auxDataAlonzoTxL,
-  bodyAlonzoTxL,
-  isValidAlonzoTxL,
-  sizeAlonzoTxF,
-  witsAlonzoTxL,
  )
-import Cardano.Ledger.Binary (Annotator, DecCBOR (..), EncCBOR, ToCBOR)
+import Cardano.Ledger.Binary (Annotator, DecCBOR (..), EncCBOR (..), ToCBOR (..))
 import Cardano.Ledger.Conway.Tx (AlonzoEraTx (..), Tx (..), getConwayMinFeeTx)
 import Cardano.Ledger.Core
 import Cardano.Ledger.Dijkstra.Era (DijkstraEra)
@@ -41,51 +41,103 @@ import Cardano.Ledger.Dijkstra.TxBody (DijkstraEraTxBody (..))
 import Cardano.Ledger.Dijkstra.TxWits ()
 import Cardano.Ledger.Keys.WitVKey (witVKeyHash)
 import Cardano.Ledger.MemoBytes (EqRaw (..))
-import Control.DeepSeq (NFData)
+import Control.DeepSeq (NFData (..))
 import qualified Data.Set as Set
 import Data.Typeable (Typeable)
+import Data.Word (Word32)
 import GHC.Generics (Generic)
 import Lens.Micro (Lens', lens, (^.))
-import NoThunks.Class (NoThunks)
+import NoThunks.Class (InspectHeap (..), NoThunks)
+
+data DijkstraTx l era where
+  DijkstraTx ::
+    { dtBody :: !(TxBody TopTx era)
+    , dtWits :: !(TxWits era)
+    , dtIsValid :: !IsValid
+    , dtAuxData :: !(StrictMaybe (TxAuxData era))
+    } ->
+    DijkstraTx TopTx era
+  DijkstraSubTx ::
+    { dstBody :: !(TxBody SubTx era)
+    , dstWits :: !(TxWits era)
+    , dstAuxData :: !(StrictMaybe (TxAuxData era))
+    } ->
+    DijkstraTx SubTx era
+
+deriving instance EraTx era => Eq (DijkstraTx l era)
+
+deriving instance EraTx era => Show (DijkstraTx l era)
+
+instance NFData (DijkstraTx l era) where
+  rnf = undefined
+
+deriving via
+  InspectHeap (DijkstraTx l era)
+  instance
+    ( Era era
+    , Typeable l
+    ) =>
+    NoThunks (DijkstraTx l era)
+
+instance (EraTx era, Typeable l) => ToCBOR (DijkstraTx l era) where
+  toCBOR = undefined
+
+instance EncCBOR (DijkstraTx l era) where
+  encCBOR = undefined
+
+instance (EraTx era, Typeable l) => DecCBOR (Annotator (DijkstraTx l era)) where
+  decCBOR = undefined
 
 instance HasEraTxLevel Tx DijkstraEra where
   toSTxLevel (MkDijkstraTx _) = undefined
 
-mkBasicDijkstraTx :: TxBody l DijkstraEra -> AlonzoTx l DijkstraEra
+mkBasicDijkstraTx :: TxBody l DijkstraEra -> DijkstraTx l DijkstraEra
 mkBasicDijkstraTx = undefined
 
 instance EraTx DijkstraEra where
-  newtype Tx l DijkstraEra = MkDijkstraTx {unDijkstraTx :: AlonzoTx l DijkstraEra}
+  newtype Tx l DijkstraEra = MkDijkstraTx {unDijkstraTx :: DijkstraTx l DijkstraEra}
     deriving newtype (Eq, Show, NFData, NoThunks, ToCBOR, EncCBOR)
     deriving (Generic)
 
   mkBasicTx = MkDijkstraTx . mkBasicDijkstraTx
 
-  bodyTxL = dijkstraTxL . bodyAlonzoTxL
+  bodyTxL = dijkstraTxL . bodyDijkstraTxL
   {-# INLINE bodyTxL #-}
 
-  witsTxL = dijkstraTxL . witsAlonzoTxL
+  witsTxL = dijkstraTxL . witsDijkstraTxL
   {-# INLINE witsTxL #-}
 
-  auxDataTxL = dijkstraTxL . auxDataAlonzoTxL
+  auxDataTxL = dijkstraTxL . auxDataDijkstraTxL
   {-# INLINE auxDataTxL #-}
 
-  sizeTxF = dijkstraTxL . sizeAlonzoTxF
+  sizeTxF = dijkstraTxL . sizeDijkstraTxF
   {-# INLINE sizeTxF #-}
 
   validateNativeScript = validateDijkstraNativeScript
   {-# INLINE validateNativeScript #-}
 
   getMinFeeTx = getConwayMinFeeTx
 
+bodyDijkstraTxL :: Lens' (DijkstraTx l era) (TxBody l era)
+bodyDijkstraTxL = undefined
+
+witsDijkstraTxL :: Lens' (DijkstraTx l era) (TxWits era)
+witsDijkstraTxL = undefined
+
+auxDataDijkstraTxL :: Lens' (DijkstraTx l era) (StrictMaybe (TxAuxData era))
+auxDataDijkstraTxL = undefined
+
+sizeDijkstraTxF :: Lens' (DijkstraTx l era) Word32
+sizeDijkstraTxF = undefined
+
 instance EqRaw (Tx l DijkstraEra) where
   eqRaw = alonzoTxEqRaw
 
-dijkstraTxL :: Lens' (Tx l DijkstraEra) (AlonzoTx l DijkstraEra)
+dijkstraTxL :: Lens' (Tx l DijkstraEra) (DijkstraTx l DijkstraEra)
 dijkstraTxL = lens unDijkstraTx (\x y -> x {unDijkstraTx = y})
 
 instance AlonzoEraTx DijkstraEra where
-  isValidTxL = dijkstraTxL . isValidAlonzoTxL
+  isValidTxL = undefined -- dijkstraTxL . isValidAlonzoTxL
   {-# INLINE isValidTxL #-}
 
 instance Typeable l => DecCBOR (Annotator (Tx l DijkstraEra)) where

eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Binary/Annotator.hs

@@ -15,7 +15,7 @@ import Cardano.Ledger.Binary.Coders
 import Cardano.Ledger.Core
 import Cardano.Ledger.Dijkstra (DijkstraEra)
 import Cardano.Ledger.Dijkstra.Scripts
-import Cardano.Ledger.Dijkstra.Tx (Tx (..))
+import Cardano.Ledger.Dijkstra.Tx (DijkstraTx, Tx (..))
 import Cardano.Ledger.Dijkstra.TxBody (TxBody (..))
 import Cardano.Ledger.MemoBytes (decodeMemoized)
 import Data.Typeable (Typeable)
@@ -37,4 +37,7 @@ instance Era era => DecCBOR (DijkstraNativeScriptRaw era) where
 instance Era era => DecCBOR (DijkstraNativeScript era) where
   decCBOR = MkDijkstraNativeScript <$> decodeMemoized decCBOR
 
-deriving newtype instance DecCBOR (Tx TopTx DijkstraEra)
+instance Typeable l => DecCBOR (DijkstraTx l DijkstraEra) where
+  decCBOR = undefined
+
+deriving newtype instance Typeable l => DecCBOR (Tx l DijkstraEra)

libs/cardano-ledger-api/src/Cardano/Ledger/Api/Era.hs

@@ -99,7 +99,7 @@ import Cardano.Ledger.Core
 import Cardano.Ledger.Credential (Credential (..))
 import Cardano.Ledger.Dijkstra (DijkstraEra)
 import Cardano.Ledger.Dijkstra.Scripts
-import Cardano.Ledger.Dijkstra.Tx (Tx (..))
+import Cardano.Ledger.Dijkstra.Tx (Tx (..), DijkstraTx (..))
 import Cardano.Ledger.Dijkstra.TxBody (TxBody (..), upgradeProposals)
 import Cardano.Ledger.Dijkstra.TxCert (DijkstraTxCertUpgradeError)
 import Cardano.Ledger.Internal.Era (EraHasName (..))
@@ -608,7 +608,7 @@ instance EraApi DijkstraEra where
   type TxBodyUpgradeError DijkstraEra = DijkstraTxBodyUpgradeError
   upgradeTx (MkConwayTx (AlonzoTx b w valid aux)) =
     fmap MkDijkstraTx $
-      AlonzoTx
+      DijkstraTx
         <$> upgradeTxBody b
         <*> pure (upgradeTxWits w)
         <*> pure valid