WIP

IntersectMBO · Nov 17, 2023 · ee82c03 · ee82c03
1 parent 470fc09
commit ee82c03
Show file tree

Hide file tree

Showing 10 changed files with 107 additions and 121 deletions.
diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Byron.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Byron.hs
@@ -7,6 +7,7 @@ module Test.Gen.Cardano.Api.Byron
   ) where
 
 import           Cardano.Api hiding (txIns)
+import           Cardano.Api.Byron
 
 import           Data.Proxy
 
@@ -20,8 +21,8 @@ import           Test.Tasty.Hedgehog
 prop_byron_roundtrip_txbody_CBOR :: Property
 prop_byron_roundtrip_txbody_CBOR = property $ do
   let byron = ByronEra
-  x <- forAll $ makeSignedTransaction [] <$> genTxBodyByron
-  tripping x (serialiseTxLedgerCddl byron) (deserialiseTxLedgerCddl byron)
+  x <- forAll $ makeSignedByronTransaction [] <$> genTxBodyByron
+  tripping (ByronTx ByronEraOnlyByron x) (serialiseTxLedgerCddl byron) (deserialiseTxLedgerCddl byron)
 
 
 prop_byron_roundtrip_tx_CBOR :: Property

diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs
@@ -134,12 +134,13 @@ module Test.Gen.Cardano.Api.Typed
 
 import           Cardano.Api hiding (txIns)
 import qualified Cardano.Api as Api
-import           Cardano.Api.Byron (KeyWitness (ByronKeyWitness),
+import           Cardano.Api.Byron (KeyWitness (ByronKeyWitness), Tx (ByronTx),
                    WitnessNetworkIdOrByronAddress (..))
 import           Cardano.Api.Eon.AllegraEraOnwards (allegraEraOnwardsToShelleyBasedEra)
-import           Cardano.Api.Pretty
+import           Cardano.Api.Error
 import qualified Cardano.Api.Ledger as L
 import qualified Cardano.Api.Ledger.Lens as A
+import           Cardano.Api.Pretty
 import           Cardano.Api.Script (scriptInEraToRefScript)
 import           Cardano.Api.Shelley
 import qualified Cardano.Api.Shelley as ShelleyApi
@@ -314,7 +315,7 @@ genScriptInEra era =
       [ ScriptInEra langInEra <$> genScript lang
       | AnyScriptLanguage lang <- [minBound..maxBound]
         -- TODO: scriptLanguageSupportedInEra should be parameterized on ShelleyBasedEra
-      , Just langInEra <- [scriptLanguageSupportedInEra (toCardanoEra era) lang] ]
+      , Just langInEra <- [scriptLanguageSupportedInEra era lang] ]
 
 genScriptHash :: Gen ScriptHash
 genScriptHash = do
@@ -711,17 +712,18 @@ genTxTotalCollateral =
 genTxFee :: CardanoEra era -> Gen (TxFee era)
 genTxFee =
   caseByronOrShelleyBasedEra
-    undefined -- (pure . TxFeeImplicit)
+    (pure . TxFeeImplicit)
     (\w -> TxFeeExplicit w <$> genLovelace)
 
 genAddressInEraByron :: Gen (AddressInEra ByronEra)
 genAddressInEraByron = byronAddressInEra <$> genAddressByron
 
 genTxByron :: Gen (Tx ByronEra)
-genTxByron =
-  makeSignedTransaction
-    <$> genWitnessesByron
-    <*> genTxBodyByron
+genTxByron = do
+  tx <- makeSignedByronTransaction
+          <$> genWitnessesByron
+          <*> genTxBodyByron
+  return $ ByronTx ByronEraOnlyByron tx
 
 genTxOutValueByron :: Gen (TxOutValue ByronEra)
 genTxOutValueByron = TxOutValueByron <$> genPositiveLovelace
@@ -733,24 +735,20 @@ genTxOutByron =
         <*> pure TxOutDatumNone
         <*> pure ReferenceScriptNone
 
-genTxBodyByron :: Gen (TxBody ByronEra)
+genTxBodyByron :: Gen (L.Annotated L.Tx ByteString)
 genTxBodyByron = do
   txIns <- map (, BuildTxWith (KeyWitness KeyWitnessForSpending)) <$> Gen.list (Range.constant 1 10) genTxIn
   txOuts <- Gen.list (Range.constant 1 10) genTxOutByron
-  let byronTxBodyContent = (defaultTxBodyContent ByronEra)
-                             { Api.txIns
-                             , Api.txOuts
-                             }
-  case Api.createAndValidateTransactionBody ByronEra byronTxBodyContent of
-    Left err -> fail $ prettyToString $ prettyError err
+  case Api.makeByronTransactionBody txIns txOuts of
+    Left err -> fail (displayError err)
     Right txBody -> pure txBody
 
 genWitnessesByron :: Gen [KeyWitness ByronEra]
 genWitnessesByron = Gen.list (Range.constant 1 10) genByronKeyWitness
 
 genTxBody :: ShelleyBasedEra era -> Gen (TxBody era)
 genTxBody era = do
-  res <- Api.createAndValidateTransactionBody (toCardanoEra era) <$> genTxBodyContent era
+  res <- Api.createAndValidateTransactionBody era <$> genTxBodyContent era
   case res of
     Left err -> fail (prettyToString (prettyError err))
     Right txBody -> pure txBody

diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs
@@ -579,10 +579,6 @@ evaluateTransactionBalance :: forall era. ()
                            -> UTxO era
                            -> TxBody era
                            -> TxOutValue era
-evaluateTransactionBalance sbe _ _ _ _ _ (ByronTxBody ByronEraOnlyByron _) =
-  -- TODO: we could actually support Byron here, it'd be different but simpler
-  case sbe of {}
-
 evaluateTransactionBalance sbe pp poolids stakeDelegDeposits drepDelegDeposits utxo (ShelleyTxBody _ txbody _ _ _ _) =
   shelleyBasedEraConstraints sbe
     $ TxOutValueShelleyBased sbe
@@ -803,7 +799,7 @@ makeTransactionBodyAutoBalance sbe systemstart history lpp@(LedgerProtocolParame
     -- 3. update tx with fees
     -- 4. balance the transaction and update tx change output
     txbody0 <-
-      first TxBodyError $ createAndValidateTransactionBody era txbodycontent
+      first TxBodyError $ createAndValidateTransactionBody sbe txbodycontent
         { txOuts = txOuts txbodycontent ++
                    [TxOut changeaddr (lovelaceToTxOutValue sbe 0) TxOutDatumNone ReferenceScriptNone]
             --TODO: think about the size of the change output
@@ -854,7 +850,7 @@ makeTransactionBodyAutoBalance sbe systemstart history lpp@(LedgerProtocolParame
 
     let (dummyCollRet, dummyTotColl) = maybeDummyTotalCollAndCollReturnOutput txbodycontent changeaddr
     txbody1 <- first TxBodyError $ -- TODO: impossible to fail now
-               createAndValidateTransactionBody era txbodycontent1 {
+               createAndValidateTransactionBody sbe txbodycontent1 {
                  txFee  = TxFeeExplicit sbe maxLovelaceFee,
                  txOuts = TxOut changeaddr changeTxOut TxOutDatumNone ReferenceScriptNone
                         : txOuts txbodycontent,
@@ -880,7 +876,7 @@ makeTransactionBodyAutoBalance sbe systemstart history lpp@(LedgerProtocolParame
     -- Here we do not want to start with any change output, since that's what
     -- we need to calculate.
     txbody2 <- first TxBodyError $ -- TODO: impossible to fail now
-               createAndValidateTransactionBody era txbodycontent1 {
+               createAndValidateTransactionBody sbe txbodycontent1 {
                  txFee = TxFeeExplicit sbe fee,
                  txReturnCollateral = retColl,
                  txTotalCollateral = reqCol
@@ -913,7 +909,7 @@ makeTransactionBodyAutoBalance sbe systemstart history lpp@(LedgerProtocolParame
       first TxBodyError $ -- TODO: impossible to fail now. We need to implement a function
                           -- that simply creates a transaction body because we have already
                           -- validated the transaction body earlier within makeTransactionBodyAutoBalance
-        createAndValidateTransactionBody era finalTxBodyContent
+        createAndValidateTransactionBody sbe finalTxBodyContent
     return (BalancedTxBody finalTxBodyContent txbody3 (TxOut changeaddr balance TxOutDatumNone ReferenceScriptNone) fee)
  where
    -- Essentially we check for the existence of collateral inputs. If they exist we

diff --git a/cardano-api/internal/Cardano/Api/IPC.hs b/cardano-api/internal/Cardano/Api/IPC.hs
@@ -77,6 +77,7 @@ module Cardano.Api.IPC (
   ) where
 
 import           Cardano.Api.Block
+import           Cardano.Api.Eras
 import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.InMode
 import           Cardano.Api.IO
@@ -85,7 +86,7 @@ import           Cardano.Api.Modes
 import           Cardano.Api.NetworkId
 import           Cardano.Api.Protocol
 import           Cardano.Api.Query
-import           Cardano.Api.Tx (getTxBody)
+import           Cardano.Api.Tx
 import           Cardano.Api.TxBody
 
 import qualified Cardano.Ledger.Api as L
@@ -630,7 +631,11 @@ instance ToJSON LocalTxMonitoringResult where
           ]
         where
           txId = case txInMode of
-            Just (TxInMode _ tx) -> Just $ getTxId $ getTxBody tx
+            Just (TxInMode e tx) ->
+              case e of
+                -- NB: Local tx protocol is not possible in the Byron era
+                ByronEra -> error "ToJSON LocalTxMonitoringResult: Byron era not supported"
+                _ -> Just $ getTxId $ getTxBody tx
             -- TODO: support fetching the ID of a Byron Era transaction
             _ -> Nothing
       LocalTxMonitoringMempoolSizeAndCapacity mempool slot ->

diff --git a/cardano-api/internal/Cardano/Api/ReexposeLedger.hs b/cardano-api/internal/Cardano/Api/ReexposeLedger.hs
@@ -73,6 +73,10 @@ module Cardano.Api.ReexposeLedger
   , drepDepositL
   , csCommitteeCredsL
 
+  -- Byron
+  , Annotated
+  , Byron.Tx(..)
+
   -- Babbage
   , CoinPerByte (..)
 
@@ -103,6 +107,7 @@ module Cardano.Api.ReexposeLedger
   , EpochNo(..)
   ) where
 
+import qualified Cardano.Chain.UTxO as Byron
 import           Cardano.Crypto.Hash.Class (hashFromBytes, hashToBytes)
 import           Cardano.Ledger.Alonzo.Core (CoinPerWord (..), PParamsUpdate (..))
 import           Cardano.Ledger.Alonzo.Scripts (Prices (..))
@@ -116,6 +121,7 @@ import           Cardano.Ledger.Babbage.Core (CoinPerByte (..))
 import           Cardano.Ledger.BaseTypes (DnsName, Network (..), StrictMaybe (..), Url,
                    boundRational, dnsToText, maybeToStrictMaybe, portToWord16, strictMaybeToMaybe,
                    textToDns, textToUrl, unboundRational, urlToText)
+import           Cardano.Ledger.Binary (Annotated (..))
 import           Cardano.Ledger.CertState (DRepState, csCommitteeCredsL)
 import           Cardano.Ledger.Coin (Coin (..), addDeltaCoin, toDeltaCoin)
 import           Cardano.Ledger.Conway.Core (DRepVotingThresholds (..), PoolVotingThresholds (..),

diff --git a/cardano-api/internal/Cardano/Api/Tx.hs b/cardano-api/internal/Cardano/Api/Tx.hs
@@ -25,6 +25,7 @@ module Cardano.Api.Tx (
     -- | Creating transaction witnesses one by one, or all in one go.
     Tx(.., Tx),
     getTxBody,
+    getByronTxBody,
     getTxWitnesses,
     ScriptValidity(..),
 
@@ -35,6 +36,7 @@ module Cardano.Api.Tx (
     signShelleyTransaction,
 
     -- ** Incremental signing and separate witnesses
+    makeSignedByronTransaction,
     makeSignedTransaction,
     makeSignedTransaction',
     KeyWitness(..),
@@ -433,9 +435,16 @@ pattern Tx txbody ws <- (getTxBodyAndWitnesses -> (txbody, ws))
 getTxBodyAndWitnesses :: Tx era -> (TxBody era, [KeyWitness era])
 getTxBodyAndWitnesses tx = (getTxBody tx, getTxWitnesses tx)
 
-getTxBody :: forall era. Tx era -> TxBody era
-getTxBody (ByronTx eon Byron.ATxAux { Byron.aTaTx = txbody }) =
-    ByronTxBody eon txbody
+getByronTxBody :: Tx ByronEra -> Annotated Byron.Tx ByteString
+getByronTxBody (ByronTx _eon Byron.ATxAux { Byron.aTaTx = txbody }) = txbody
+getByronTxBody (ShelleyTx sbe _) = case sbe :: ShelleyBasedEra ByronEra of {}
+
+-- NB: This is called in getTxBodyAndWitnesses which is fine as
+-- getTxBodyAndWitnesses is only called in the context of a
+-- shelley based era anyways. ByronTx will eventually be removed.
+getTxBody :: Tx era -> TxBody era
+getTxBody (ByronTx _eon Byron.ATxAux { Byron.aTaTx = _txbody }) =
+  error "getTxBody: Use getByronTxBody instead"
 
 getTxBody (ShelleyTx sbe tx) =
   caseShelleyToMaryOrAlonzoEraOnwards
@@ -501,17 +510,17 @@ makeSignedTransaction' :: ()
   -> Tx era
 makeSignedTransaction' _ = makeSignedTransaction
 
+makeSignedByronTransaction :: [KeyWitness era] -> Annotated Byron.Tx ByteString -> Byron.ATxAux ByteString
+makeSignedByronTransaction witnesses txbody =
+  Byron.annotateTxAux
+    $ Byron.mkTxAux
+        (unAnnotated txbody)
+        (Vector.fromList [ w | ByronKeyWitness w <- witnesses ])
+
 makeSignedTransaction :: forall era.
      [KeyWitness era]
   -> TxBody era
   -> Tx era
-makeSignedTransaction witnesses (ByronTxBody eon txbody) =
-    ByronTx eon
-  . Byron.annotateTxAux
-  $ Byron.mkTxAux
-      (unAnnotated txbody)
-      (Vector.fromList [ w | ByronKeyWitness w <- witnesses ])
-
 makeSignedTransaction witnesses (ShelleyTxBody sbe txbody
                                                txscripts
                                                txscriptdata
@@ -574,11 +583,10 @@ makeSignedTransaction witnesses (ShelleyTxBody sbe txbody
 makeByronKeyWitness :: forall key.
                        IsByronKey key
                     => NetworkId
-                    -> TxBody ByronEra
+                    -> Annotated Byron.Tx ByteString
                     -> SigningKey key
                     -> KeyWitness ByronEra
-makeByronKeyWitness _ (ShelleyTxBody sbe _ _ _ _ _) = case sbe of {}
-makeByronKeyWitness nw (ByronTxBody _ txbody) =
+makeByronKeyWitness nw txbody =
     let txhash :: Byron.Hash Byron.Tx
         txhash = Byron.hashDecoded txbody
 
@@ -627,7 +635,6 @@ makeShelleyBootstrapWitness :: forall era. ()
   -> KeyWitness era
 makeShelleyBootstrapWitness sbe nwOrAddr txBody sk =
   case txBody of
-    ByronTxBody ByronEraOnlyByron _ -> case sbe of {}
     ShelleyTxBody _ txbody _ _ _ _ -> makeShelleyBasedBootstrapWitness sbe nwOrAddr txbody sk
 
 makeShelleyBasedBootstrapWitness :: forall era. ()
@@ -744,7 +751,6 @@ makeShelleyKeyWitness sbe = \case
               signature = makeShelleySignature txhash sk
           in ShelleyKeyWitness sbe $
                 L.WitVKey vk signature
-  ByronTxBody ByronEraOnlyByron _ -> case sbe of {}
 
 
 -- | We support making key witnesses with both normal and extended signing keys.
@@ -838,11 +844,11 @@ makeShelleySignature tosign (ShelleyExtendedSigningKey sk) =
 
 -- order of signing keys must match txins
 signByronTransaction :: NetworkId
-                     -> TxBody ByronEra
+                     -> Annotated Byron.Tx ByteString
                      -> [SigningKey ByronKey]
                      -> Tx ByronEra
 signByronTransaction nw txbody sks =
-    makeSignedTransaction witnesses txbody
+    ByronTx ByronEraOnlyByron $ makeSignedByronTransaction witnesses txbody
   where
     witnesses = map (makeByronKeyWitness nw txbody) sks