Parameterize createAndValidateTransactionBody on ShelleyBasedEra era

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) deserialiseByronTxCddl
 
 
 prop_byron_roundtrip_tx_CBOR :: Property
@@ -42,7 +43,7 @@ prop_byron_roundtrip_Tx_Cddl :: Property
 prop_byron_roundtrip_Tx_Cddl = property $ do
   let byron = ByronEra
   x <- forAll genTxByron
-  tripping x (serialiseTxLedgerCddl byron) (deserialiseTxLedgerCddl byron)
+  tripping x (serialiseTxLedgerCddl byron) deserialiseByronTxCddl
 
 tests :: TestTree
 tests = testGroup "Test.Gen.Cardano.Api.Byron"

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
@@ -718,10 +719,11 @@ 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

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

cardano-api/internal/Cardano/Api/Governance/Poll.hs

@@ -36,6 +36,7 @@ module Cardano.Api.Governance.Poll(
     verifyPollAnswer,
   ) where
 
+import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eras
 import           Cardano.Api.Hash
 import           Cardano.Api.HasTypeProxy
@@ -326,9 +327,9 @@ renderGovernancePollError err =
 -- (the existence of the transaction in the ledger provides this guarantee).
 verifyPollAnswer
   :: GovernancePoll
-  -> InAnyCardanoEra Tx
+  -> InAnyShelleyBasedEra Tx
   -> Either GovernancePollError [Hash PaymentKey]
-verifyPollAnswer poll (InAnyCardanoEra _era (getTxBody -> TxBody body)) = do
+verifyPollAnswer poll (InAnyShelleyBasedEra _era (getTxBody -> TxBody body)) = do
   answer <- extractPollAnswer (txMetadata body)
   answer `hasMatchingHash` hashGovernancePoll poll
   answer `isAmongAcceptableChoices` govPollAnswers poll

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 ->

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 (..),

cardano-api/internal/Cardano/Api/Script.hs

@@ -578,45 +578,45 @@ instance HasTypeProxy era => HasTypeProxy (ScriptInEra era) where
 -- | Check if a given script language is supported in a given era, and if so
 -- return the evidence.
 --
-scriptLanguageSupportedInEra :: CardanoEra era
+scriptLanguageSupportedInEra :: ShelleyBasedEra era
                              -> ScriptLanguage lang
                              -> Maybe (ScriptLanguageInEra lang era)
 scriptLanguageSupportedInEra era lang =
     case (era, lang) of
-      (ShelleyEra, SimpleScriptLanguage) ->
+      (ShelleyBasedEraShelley, SimpleScriptLanguage) ->
         Just SimpleScriptInShelley
 
-      (AllegraEra, SimpleScriptLanguage) ->
+      (ShelleyBasedEraAllegra, SimpleScriptLanguage) ->
         Just SimpleScriptInAllegra
 
-      (MaryEra, SimpleScriptLanguage) ->
+      (ShelleyBasedEraMary, SimpleScriptLanguage) ->
         Just SimpleScriptInMary
 
-      (AlonzoEra, SimpleScriptLanguage) ->
+      (ShelleyBasedEraAlonzo, SimpleScriptLanguage) ->
         Just SimpleScriptInAlonzo
 
-      (BabbageEra, SimpleScriptLanguage) ->
+      (ShelleyBasedEraBabbage, SimpleScriptLanguage) ->
         Just SimpleScriptInBabbage
 
-      (ConwayEra, SimpleScriptLanguage) ->
+      (ShelleyBasedEraConway, SimpleScriptLanguage) ->
         Just SimpleScriptInConway
 
-      (AlonzoEra, PlutusScriptLanguage PlutusScriptV1) ->
+      (ShelleyBasedEraAlonzo, PlutusScriptLanguage PlutusScriptV1) ->
         Just PlutusScriptV1InAlonzo
 
-      (BabbageEra, PlutusScriptLanguage PlutusScriptV1) ->
+      (ShelleyBasedEraBabbage, PlutusScriptLanguage PlutusScriptV1) ->
         Just PlutusScriptV1InBabbage
 
-      (BabbageEra, PlutusScriptLanguage PlutusScriptV2) ->
+      (ShelleyBasedEraBabbage, PlutusScriptLanguage PlutusScriptV2) ->
         Just PlutusScriptV2InBabbage
 
-      (ConwayEra, PlutusScriptLanguage PlutusScriptV1) ->
+      (ShelleyBasedEraConway, PlutusScriptLanguage PlutusScriptV1) ->
         Just PlutusScriptV1InConway
 
-      (ConwayEra, PlutusScriptLanguage PlutusScriptV2) ->
+      (ShelleyBasedEraConway, PlutusScriptLanguage PlutusScriptV2) ->
         Just PlutusScriptV2InConway
 
-      (ConwayEra, PlutusScriptLanguage PlutusScriptV3) ->
+      (ShelleyBasedEraConway, PlutusScriptLanguage PlutusScriptV3) ->
         Just PlutusScriptV3InConway
 
       _ -> Nothing
@@ -664,7 +664,7 @@ eraOfScriptLanguageInEra langInEra =
 -- | Given a target era and a script in some language, check if the language is
 -- supported in that era, and if so return a 'ScriptInEra'.
 --
-toScriptInEra :: CardanoEra era -> ScriptInAnyLang -> Maybe (ScriptInEra era)
+toScriptInEra :: ShelleyBasedEra era -> ScriptInAnyLang -> Maybe (ScriptInEra era)
 toScriptInEra era (ScriptInAnyLang lang s) = do
     lang' <- scriptLanguageSupportedInEra era lang
     return (ScriptInEra lang' s)
@@ -1405,7 +1405,7 @@ instance IsCardanoEra era => FromJSON (ReferenceScript era) where
       (cardanoEra :: CardanoEra era)
 
 refScriptToShelleyScript
-  :: CardanoEra era
+  :: ShelleyBasedEra era
   -> ReferenceScript era
   -> StrictMaybe (Ledger.Script (ShelleyLedgerEra era))
 refScriptToShelleyScript era (ReferenceScript _ s) =