Make Byron constructors and functions propagate ByronEraOnly eon

IntersectMBO · Oct 22, 2023 · b3c8953 · b3c8953
1 parent 2e299c1
commit b3c8953
Show file tree

Hide file tree

Showing 6 changed files with 84 additions and 71 deletions.
diff --git a/cardano-api/internal/Cardano/Api/Block.hs b/cardano-api/internal/Cardano/Api/Block.hs
@@ -51,6 +51,7 @@ module Cardano.Api.Block (
     makeChainTip,
   ) where
 
+import           Cardano.Api.Eon.ByronEraOnly
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eras
 import           Cardano.Api.Hash
@@ -172,7 +173,7 @@ getBlockTxs = \case
             Byron.ABody {
               Byron.bodyTxPayload = Byron.ATxPayload txs
             }
-        } -> map ByronTx txs
+        } -> map (ByronTx ByronEraOnlyByron) txs
   ShelleyBlock sbe Consensus.ShelleyBlock{Consensus.shelleyBlockRaw} ->
     shelleyBasedEraConstraints sbe $
       getShelleyBlockTxs sbe shelleyBlockRaw

diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs
@@ -48,6 +48,7 @@ module Cardano.Api.Fees (
 import           Cardano.Api.Address
 import           Cardano.Api.Certificate
 import           Cardano.Api.Eon.BabbageEraOnwards
+import           Cardano.Api.Eon.ByronEraOnly
 import           Cardano.Api.Eon.MaryEraOnwards
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eon.ShelleyToAllegraEra
@@ -120,7 +121,7 @@ transactionFee sbe txFeeFixed txFeePerByte tx =
     ShelleyTx _ tx' ->
       let x = shelleyBasedEraConstraints sbe $ tx' ^. L.sizeTxF in Lovelace (a * x + b)
       --TODO: This can be made to work for Byron txs too.
-    ByronTx _ -> case sbe of {}
+    ByronTx ByronEraOnlyByron _ -> case sbe of {}
 
 {-# DEPRECATED transactionFee "Use 'evaluateTransactionFee' instead" #-}
 
@@ -148,7 +149,7 @@ estimateTransactionFee :: ()
   -> Lovelace
 estimateTransactionFee sbe nw txFeeFixed txFeePerByte = \case
   -- TODO: This can be made to work for Byron txs too.
-  ByronTx _ ->
+  ByronTx ByronEraOnlyByron _ ->
     case sbe of {}
   ShelleyTx era tx ->
     let Lovelace baseFee = transactionFee sbe txFeeFixed txFeePerByte (ShelleyTx era tx)
@@ -218,7 +219,7 @@ evaluateTransactionFee _ _ _ _ byronwitcount | byronwitcount > 0 =
 evaluateTransactionFee sbe pp txbody keywitcount _byronwitcount =
   shelleyBasedEraConstraints sbe $
     case makeSignedTransaction [] txbody of
-      ByronTx{} -> case sbe of {}
+      ByronTx ByronEraOnlyByron _ -> case sbe of {}
       --TODO: we could actually support Byron here, it'd be different but simpler
 
       ShelleyTx _ tx -> fromShelleyLovelace $ Ledger.evaluateTransactionFee pp tx keywitcount
@@ -566,7 +567,7 @@ evaluateTransactionBalance :: forall era. ()
                            -> UTxO era
                            -> TxBody era
                            -> TxOutValue era
-evaluateTransactionBalance sbe _ _ _ _ _ (ByronTxBody _) =
+evaluateTransactionBalance sbe _ _ _ _ _ (ByronTxBody ByronEraOnlyByron _) =
   -- TODO: we could actually support Byron here, it'd be different but simpler
   case sbe of {}
 

diff --git a/cardano-api/internal/Cardano/Api/InMode.hs b/cardano-api/internal/Cardano/Api/InMode.hs
@@ -25,6 +25,7 @@ module Cardano.Api.InMode (
     fromConsensusApplyTxErr,
   ) where
 
+import           Cardano.Api.Eon.ByronEraOnly
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eras
 import           Cardano.Api.Modes
@@ -111,12 +112,12 @@ fromConsensusGenTx CardanoMode (Consensus.HardForkGenTx (Consensus.OneEraGenTx (
 toConsensusGenTx :: ConsensusBlockForMode mode ~ block
                  => TxInMode mode
                  -> Consensus.GenTx block
-toConsensusGenTx (TxInMode (ByronTx tx) ByronEraInByronMode) =
+toConsensusGenTx (TxInMode (ByronTx ByronEraOnlyByron tx) ByronEraInByronMode) =
     Consensus.HardForkGenTx (Consensus.OneEraGenTx (Z tx'))
   where
     tx' = Consensus.ByronTx (Consensus.byronIdTx tx) tx
 
-toConsensusGenTx (TxInMode (ByronTx tx) ByronEraInCardanoMode) =
+toConsensusGenTx (TxInMode (ByronTx ByronEraOnlyByron tx) ByronEraInCardanoMode) =
     Consensus.HardForkGenTx (Consensus.OneEraGenTx (Z tx'))
   where
     tx' = Consensus.ByronTx (Consensus.byronIdTx tx) tx

diff --git a/cardano-api/internal/Cardano/Api/SerialiseLedgerCddl.hs b/cardano-api/internal/Cardano/Api/SerialiseLedgerCddl.hs
@@ -30,6 +30,7 @@ module Cardano.Api.SerialiseLedgerCddl
   )
   where
 
+import           Cardano.Api.Eon.ByronEraOnly
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eras
 import           Cardano.Api.Error
@@ -162,7 +163,7 @@ deserialiseTx :: ()
 deserialiseTx era bs =
   case era of
     ByronEra ->
-      ByronTx
+      ByronTx ByronEraOnlyByron
         <$> CBOR.decodeFullAnnotatedBytes CBOR.byronProtVer "Byron Tx" CBOR.decCBOR (LBS.fromStrict bs)
     _ -> cardanoEraConstraints era $ deserialiseFromCBOR (AsTx (proxyToAsType Proxy)) bs
 

diff --git a/cardano-api/internal/Cardano/Api/Tx.hs b/cardano-api/internal/Cardano/Api/Tx.hs
@@ -53,6 +53,7 @@ module Cardano.Api.Tx (
 
 import           Cardano.Api.Address
 import           Cardano.Api.Certificate
+import           Cardano.Api.Eon.ByronEraOnly
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eras
 import           Cardano.Api.HasTypeProxy
@@ -101,8 +102,9 @@ import           Lens.Micro
 data Tx era where
 
      ByronTx
-       :: Byron.ATxAux ByteString
-       -> Tx ByronEra
+       :: ByronEraOnly era
+       -> Byron.ATxAux ByteString
+       -> Tx era
 
      ShelleyTx
        :: ShelleyBasedEra era
@@ -121,21 +123,21 @@ instance Eq (InAnyCardanoEra Tx) where
 
 -- The GADT in the ShelleyTx case requires a custom instance
 instance Eq (Tx era) where
-    (==) (ByronTx txA)
-         (ByronTx txB) = txA == txB
+    (==) (ByronTx _ txA)
+         (ByronTx _ txB) = txA == txB
 
     (==) (ShelleyTx sbe txA)
          (ShelleyTx _   txB) =
       shelleyBasedEraConstraints sbe $ txA == txB
 
-    (==) ByronTx{} (ShelleyTx sbe _) = case sbe of {}
-    (==) (ShelleyTx sbe _) ByronTx{} = case sbe of {}
+    (==) (ByronTx ByronEraOnlyByron _) (ShelleyTx sbe _) = case sbe of {}
+    (==) (ShelleyTx sbe _) (ByronTx ByronEraOnlyByron _) = case sbe of {}
 
 -- The GADT in the ShelleyTx case requires a custom instance
 instance Show (Tx era) where
-    showsPrec p (ByronTx tx) =
+    showsPrec p (ByronTx _ tx) =
       showParen (p >= 11) $
-        showString "ByronTx "
+        showString "ByronTx ByronEraOnlyByron "
       . showsPrec 11 tx
 
     showsPrec p (ShelleyTx ShelleyBasedEraShelley tx) =
@@ -195,15 +197,15 @@ pattern AsAlonzoTx = AsTx AsAlonzoEra
 {-# COMPLETE AsAlonzoTx #-}
 
 instance IsCardanoEra era => SerialiseAsCBOR (Tx era) where
-    serialiseToCBOR (ByronTx tx) = CBOR.recoverBytes tx
+    serialiseToCBOR (ByronTx _ tx) = CBOR.recoverBytes tx
 
     serialiseToCBOR (ShelleyTx sbe tx) =
       shelleyBasedEraConstraints sbe $ serialiseShelleyBasedTx tx
 
     deserialiseFromCBOR _ bs =
       case cardanoEra :: CardanoEra era of
         ByronEra ->
-          ByronTx <$>
+          ByronTx ByronEraOnlyByron <$>
             CBOR.decodeFullAnnotatedBytes
               CBOR.byronProtVer "Byron Tx" CBOR.decCBOR (LBS.fromStrict bs)
 
@@ -443,8 +445,8 @@ getTxBodyAndWitnesses :: Tx era -> (TxBody era, [KeyWitness era])
 getTxBodyAndWitnesses tx = (getTxBody tx, getTxWitnesses tx)
 
 getTxBody :: forall era. Tx era -> TxBody era
-getTxBody (ByronTx Byron.ATxAux { Byron.aTaTx = txbody }) =
-    ByronTxBody txbody
+getTxBody (ByronTx eon Byron.ATxAux { Byron.aTaTx = txbody }) =
+    ByronTxBody eon txbody
 
 getTxBody (ShelleyTx sbe tx) =
   caseShelleyToMaryOrAlonzoEraOnwards
@@ -475,7 +477,7 @@ getTxBody (ShelleyTx sbe tx) =
 
 
 getTxWitnesses :: forall era. Tx era -> [KeyWitness era]
-getTxWitnesses (ByronTx Byron.ATxAux { Byron.aTaWitness = witnesses }) =
+getTxWitnesses (ByronTx ByronEraOnlyByron Byron.ATxAux { Byron.aTaWitness = witnesses }) =
     map ByronKeyWitness
   . Vector.toList
   . unAnnotated
@@ -507,8 +509,8 @@ makeSignedTransaction :: forall era.
      [KeyWitness era]
   -> TxBody era
   -> Tx era
-makeSignedTransaction witnesses (ByronTxBody txbody) =
-    ByronTx
+makeSignedTransaction witnesses (ByronTxBody eon txbody) =
+    ByronTx eon
   . Byron.annotateTxAux
   $ Byron.mkTxAux
       (unAnnotated txbody)
@@ -580,7 +582,7 @@ makeByronKeyWitness :: forall key.
                     -> SigningKey key
                     -> KeyWitness ByronEra
 makeByronKeyWitness _ (ShelleyTxBody sbe _ _ _ _ _) = case sbe of {}
-makeByronKeyWitness nw (ByronTxBody txbody) =
+makeByronKeyWitness nw (ByronTxBody _ txbody) =
     let txhash :: Byron.Hash Byron.Tx
         txhash = Byron.hashDecoded txbody
 
@@ -629,7 +631,7 @@ makeShelleyBootstrapWitness :: forall era. ()
   -> KeyWitness era
 makeShelleyBootstrapWitness sbe nwOrAddr txBody sk =
   case txBody of
-    ByronTxBody{} -> case sbe of {}
+    ByronTxBody ByronEraOnlyByron _ -> case sbe of {}
     ShelleyTxBody _ txbody _ _ _ _ -> makeShelleyBasedBootstrapWitness sbe nwOrAddr txbody sk
 
 makeShelleyBasedBootstrapWitness :: forall era. ()
@@ -746,7 +748,7 @@ makeShelleyKeyWitness sbe = \case
               signature = makeShelleySignature txhash sk
           in ShelleyKeyWitness sbe $
                 L.WitVKey vk signature
-  ByronTxBody{} -> case sbe of {}
+  ByronTxBody ByronEraOnlyByron _ -> case sbe of {}
 
 
 -- | We support making key witnesses with both normal and extended signing keys.