WIP

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

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/SerialiseLedgerCddl.hs

@@ -26,11 +26,13 @@ module Cardano.Api.SerialiseLedgerCddl
   -- Exported for testing
   , serialiseTxLedgerCddl
   , deserialiseTxLedgerCddl
+  , deserialiseByronTxCddl
   , serialiseWitnessLedgerCddl
   , deserialiseWitnessLedgerCddl
   )
   where
 
+import           Cardano.Api.Eon.ByronEraOnly
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eras
 import           Cardano.Api.Error
@@ -49,7 +51,7 @@ import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT
 import           Data.Aeson
 import qualified Data.Aeson as Aeson
 import           Data.Aeson.Encode.Pretty (Config (..), defConfig, encodePretty', keyOrder)
-import           Data.Bifunctor (first)
+import           Data.Bifunctor (bimap, first)
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString.Base16 as Base16
 import qualified Data.ByteString.Lazy as LBS
@@ -155,21 +157,26 @@ serialiseTxLedgerCddl era tx =
       ConwayEra -> "Tx ConwayEra"
 
 deserialiseTxLedgerCddl :: ()
-  => CardanoEra era
+  => ShelleyBasedEra era
   -> TextEnvelopeCddl
   -> Either TextEnvelopeCddlError (Tx era)
 deserialiseTxLedgerCddl era tec =
   first TextEnvelopeCddlErrCBORDecodingError . deserialiseTx era $ teCddlRawCBOR tec
 
+deserialiseByronTxCddl :: TextEnvelopeCddl -> Either TextEnvelopeCddlError (Tx ByronEra)
+deserialiseByronTxCddl tec =
+  bimap TextEnvelopeCddlErrCBORDecodingError (ByronTx ByronEraOnlyByron)
+    $ CBOR.decodeFullAnnotatedBytes
+        CBOR.byronProtVer "Byron Tx"
+        CBOR.decCBOR (LBS.fromStrict $ teCddlRawCBOR tec)
+
 deserialiseTx :: ()
-  => CardanoEra era
+  => ShelleyBasedEra era
   -> ByteString
   -> Either DecoderError (Tx era)
-deserialiseTx era bs =
-  caseByronOrShelleyBasedEra
-    (\w -> ByronTx w <$> CBOR.decodeFullAnnotatedBytes CBOR.byronProtVer "Byron Tx" CBOR.decCBOR (LBS.fromStrict bs))
-    (const $ cardanoEraConstraints era $ deserialiseFromCBOR (AsTx (proxyToAsType Proxy)) bs)
-    era
+deserialiseTx sbe =
+  cardanoEraConstraints (toCardanoEra sbe)
+    $ deserialiseFromCBOR (AsTx (proxyToAsType Proxy))
 
 serialiseWitnessLedgerCddl :: forall era. ShelleyBasedEra era -> KeyWitness era -> TextEnvelopeCddl
 serialiseWitnessLedgerCddl sbe kw =
@@ -252,12 +259,12 @@ textEnvelopeCddlJSONKeyOrder = keyOrder ["type", "description", "cborHex"]
 data FromSomeTypeCDDL c b where
   FromCDDLTx
     :: Text -- ^ CDDL type that we want
-    -> (InAnyCardanoEra Tx -> b)
+    -> (InAnyShelleyBasedEra Tx -> b)
     -> FromSomeTypeCDDL TextEnvelopeCddl b
 
   FromCDDLWitness
     :: Text -- ^ CDDL type that we want
-    -> (InAnyCardanoEra KeyWitness -> b)
+    -> (InAnyShelleyBasedEra KeyWitness -> b)
     -> FromSomeTypeCDDL TextEnvelopeCddl b
 
 deserialiseFromTextEnvelopeCddlAnyOf
@@ -269,15 +276,15 @@ deserialiseFromTextEnvelopeCddlAnyOf types teCddl =
       Nothing ->
         Left (TextEnvelopeCddlTypeError expectedTypes actualType)
 
+      -- NB: Byron txs were supported
       Just (FromCDDLTx ttoken f) -> do
-        AnyCardanoEra era <- cddlTypeToEra ttoken
-        f . InAnyCardanoEra era <$> deserialiseTxLedgerCddl era teCddl
-
+        AnyShelleyBasedEra era <- cddlTypeToEra ttoken
+        f . InAnyShelleyBasedEra era <$> deserialiseTxLedgerCddl era teCddl
+      -- TODO: NB byron witnesses were never supported! So we don't
+      -- have to account for this
       Just (FromCDDLWitness ttoken f) -> do
-         AnyCardanoEra era <- cddlTypeToEra ttoken
-         forEraInEon era
-           (Left TextEnvelopeCddlErrByronKeyWitnessUnsupported)
-           (\sbe -> f . InAnyCardanoEra era <$> deserialiseWitnessLedgerCddl sbe teCddl)
+         AnyShelleyBasedEra era <- cddlTypeToEra ttoken
+         f . InAnyShelleyBasedEra era <$> deserialiseWitnessLedgerCddl era teCddl
   where
    actualType :: Text
    actualType = teCddlType teCddl
@@ -292,27 +299,25 @@ deserialiseFromTextEnvelopeCddlAnyOf types teCddl =
 -- Parse the text into types because this will increase code readability and
 -- will make it easier to keep track of the different Cddl descriptions via
 -- a single sum data type.
-cddlTypeToEra :: Text -> Either TextEnvelopeCddlError AnyCardanoEra
-cddlTypeToEra "Witnessed Tx ByronEra" = return $ AnyCardanoEra ByronEra
-cddlTypeToEra "Witnessed Tx ShelleyEra" = return $ AnyCardanoEra ShelleyEra
-cddlTypeToEra "Witnessed Tx AllegraEra" = return $ AnyCardanoEra AllegraEra
-cddlTypeToEra "Witnessed Tx MaryEra" = return $ AnyCardanoEra MaryEra
-cddlTypeToEra "Witnessed Tx AlonzoEra" = return $ AnyCardanoEra AlonzoEra
-cddlTypeToEra "Witnessed Tx BabbageEra" = return $ AnyCardanoEra BabbageEra
-cddlTypeToEra "Witnessed Tx ConwayEra" = return $ AnyCardanoEra ConwayEra
-cddlTypeToEra "Unwitnessed Tx ByronEra" = return $ AnyCardanoEra ByronEra
-cddlTypeToEra "Unwitnessed Tx ShelleyEra" = return $ AnyCardanoEra ShelleyEra
-cddlTypeToEra "Unwitnessed Tx AllegraEra" = return $ AnyCardanoEra AllegraEra
-cddlTypeToEra "Unwitnessed Tx MaryEra" = return $ AnyCardanoEra MaryEra
-cddlTypeToEra "Unwitnessed Tx AlonzoEra" = return $ AnyCardanoEra AlonzoEra
-cddlTypeToEra "Unwitnessed Tx BabbageEra" = return $ AnyCardanoEra BabbageEra
-cddlTypeToEra "Unwitnessed Tx ConwayEra" = return $ AnyCardanoEra ConwayEra
-cddlTypeToEra "TxWitness ShelleyEra" = return $ AnyCardanoEra ShelleyEra
-cddlTypeToEra "TxWitness AllegraEra" = return $ AnyCardanoEra AllegraEra
-cddlTypeToEra "TxWitness MaryEra" = return $ AnyCardanoEra MaryEra
-cddlTypeToEra "TxWitness AlonzoEra" = return $ AnyCardanoEra AlonzoEra
-cddlTypeToEra "TxWitness BabbageEra" = return $ AnyCardanoEra BabbageEra
-cddlTypeToEra "TxWitness ConwayEra" = return $ AnyCardanoEra ConwayEra
+cddlTypeToEra :: Text -> Either TextEnvelopeCddlError AnyShelleyBasedEra
+cddlTypeToEra "Witnessed Tx ShelleyEra" = return $ AnyShelleyBasedEra ShelleyBasedEraShelley
+cddlTypeToEra "Witnessed Tx AllegraEra" = return $ AnyShelleyBasedEra ShelleyBasedEraAllegra
+cddlTypeToEra "Witnessed Tx MaryEra" = return $ AnyShelleyBasedEra ShelleyBasedEraMary
+cddlTypeToEra "Witnessed Tx AlonzoEra" = return $ AnyShelleyBasedEra ShelleyBasedEraAlonzo
+cddlTypeToEra "Witnessed Tx BabbageEra" = return $ AnyShelleyBasedEra ShelleyBasedEraBabbage
+cddlTypeToEra "Witnessed Tx ConwayEra" = return $ AnyShelleyBasedEra ShelleyBasedEraConway
+cddlTypeToEra "Unwitnessed Tx ShelleyEra" = return $ AnyShelleyBasedEra ShelleyBasedEraShelley
+cddlTypeToEra "Unwitnessed Tx AllegraEra" = return $ AnyShelleyBasedEra ShelleyBasedEraAllegra
+cddlTypeToEra "Unwitnessed Tx MaryEra" = return $ AnyShelleyBasedEra ShelleyBasedEraMary
+cddlTypeToEra "Unwitnessed Tx AlonzoEra" = return $ AnyShelleyBasedEra ShelleyBasedEraAlonzo
+cddlTypeToEra "Unwitnessed Tx BabbageEra" = return $ AnyShelleyBasedEra ShelleyBasedEraBabbage
+cddlTypeToEra "Unwitnessed Tx ConwayEra" = return $ AnyShelleyBasedEra ShelleyBasedEraConway
+cddlTypeToEra "TxWitness ShelleyEra" = return $ AnyShelleyBasedEra ShelleyBasedEraShelley
+cddlTypeToEra "TxWitness AllegraEra" = return $ AnyShelleyBasedEra ShelleyBasedEraAllegra
+cddlTypeToEra "TxWitness MaryEra" = return $ AnyShelleyBasedEra ShelleyBasedEraMary
+cddlTypeToEra "TxWitness AlonzoEra" = return $ AnyShelleyBasedEra ShelleyBasedEraAlonzo
+cddlTypeToEra "TxWitness BabbageEra" = return $ AnyShelleyBasedEra ShelleyBasedEraBabbage
+cddlTypeToEra "TxWitness ConwayEra" = return $ AnyShelleyBasedEra ShelleyBasedEraConway
 cddlTypeToEra unknownCddlType = Left $ TextEnvelopeCddlErrUnknownType unknownCddlType
 
 readFileTextEnvelopeCddlAnyOf