diff --git a/CHANGELOG.md b/CHANGELOG.md index 77cc2e944..8ffe9a3fa 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,20 @@ pre: "6. " math: true --- +### [6.7.0] - 2024-09-13 + +#### Added + +- Automatically upgrade transactions from previous era (up until Alonzo) on submission. + +#### Changed + +- N/A + +#### Removed + +- N/A + ### [6.6.2] - 2024-09-10 #### Added diff --git a/server/src/Ogmios/App/Protocol/TxSubmission.hs b/server/src/Ogmios/App/Protocol/TxSubmission.hs index aa33ed62f..1bbdae030 100644 --- a/server/src/Ogmios/App/Protocol/TxSubmission.hs +++ b/server/src/Ogmios/App/Protocol/TxSubmission.hs @@ -53,6 +53,7 @@ import Cardano.Ledger.BaseTypes import Cardano.Ledger.Core ( EraTx (..) , EraTxBody (..) + , eraName ) import Control.Monad.Trans.Except ( Except @@ -85,8 +86,10 @@ import Ogmios.Control.MonadSTM , takeTMVar ) import Ogmios.Data.EraTranslation - ( MultiEraUTxO (..) + ( MostRecentEra + , MultiEraUTxO (..) , Upgrade (..) + , upgradeGenTx ) import Ogmios.Data.Json ( Json @@ -128,10 +131,14 @@ import Ouroboros.Consensus.Cardano.Block , CardanoBlock , CardanoQueryResult , GenTx (..) + , HardForkApplyTxErr (..) ) import Ouroboros.Consensus.HardFork.Combinator ( HardForkBlock ) +import Ouroboros.Consensus.HardFork.Combinator.AcrossEras + ( EraMismatch (..) + ) import Ouroboros.Consensus.HardFork.Combinator.Ledger.Query ( QueryHardFork (..) ) @@ -180,6 +187,7 @@ import Type.Reflection import qualified Codec.Json.Rpc as Rpc import qualified Data.Aeson as Json import qualified Data.Map.Strict as Map +import qualified Data.Text as T import qualified Ouroboros.Consensus.HardFork.Combinator as HF import qualified Ouroboros.Consensus.Ledger.Query as Ledger import qualified Ouroboros.Network.Protocol.LocalStateQuery.Client as LSQ @@ -212,6 +220,16 @@ mkTxSubmissionClient tr defaultWithInternalError TxSubmissionCodecs{..} Executio await :: m (TxSubmissionMessage block) await = atomically (readTQueue queue) + isMostRecentEra era = + T.toLower (toText era) == T.toLower (toText (eraName @(MostRecentEra block))) + + -- NOTE: On successful submission, clear our cached + -- mempool to ensure we always use the latest available + -- mempool snapshot during evaluation. + clearMempoolOnSuccess = \case + SubmitSuccess -> clearMempoolM + _ -> pure () + clientStIdle :: m (LocalTxClientStIdle (SerializedTransaction block) (SubmitTransactionError block) m ()) clientStIdle = await >>= \case @@ -219,17 +237,34 @@ mkTxSubmissionClient tr defaultWithInternalError TxSubmissionCodecs{..} Executio defaultWithInternalError clientStIdle yield toResponse $ case request of MultiEraDecoderSuccess transaction -> do pure $ SendMsgSubmitTx transaction $ \result -> do - -- NOTE: On successful submission, clear our cached - -- mempool to ensure we always use the latest available - -- mempool snapshot during evaluation. case result of - SubmitSuccess -> clearMempoolM - SubmitFail{} -> pure () - mkSubmitTransactionResponse transaction result - & toResponse - & encodeSubmitTransactionResponse - & yield - clientStIdle + SubmitFail (ApplyTxErrWrongEra eraMismatch) | isMostRecentEra (ledgerEraName eraMismatch) -> do + case upgradeGenTx transaction of + Left hint -> do + SubmitTransactionFailedToUpgrade hint + & toResponse + & encodeSubmitTransactionResponse + & yield + clientStIdle + Right upgradedTx -> + pure $ SendMsgSubmitTx upgradedTx $ \result' -> do + clearMempoolOnSuccess result' + mkSubmitTransactionResponse transaction result' + & toResponse + & encodeSubmitTransactionResponse + & yield + clientStIdle + _ -> do + -- NOTE: On successful submission, clear our cached + -- mempool to ensure we always use the latest available + -- mempool snapshot during evaluation. + clearMempoolOnSuccess result + mkSubmitTransactionResponse transaction result + & toResponse + & encodeSubmitTransactionResponse + & yield + clientStIdle + MultiEraDecoderErrors errs -> do SubmitTransactionDeserialisationFailure errs & toResponse diff --git a/server/src/Ogmios/Data/EraTranslation.hs b/server/src/Ogmios/Data/EraTranslation.hs index 1af9e44fd..fafa1afa1 100644 --- a/server/src/Ogmios/Data/EraTranslation.hs +++ b/server/src/Ogmios/Data/EraTranslation.hs @@ -16,6 +16,7 @@ module Ogmios.Data.EraTranslation -- * Translations , Upgrade (..) + , upgradeGenTx ) where import Ogmios.Prelude @@ -51,13 +52,20 @@ import Data.Maybe.Strict import Ouroboros.Consensus.Cardano ( CardanoBlock ) +import Ouroboros.Consensus.Cardano.Block + ( GenTx (..) + ) import Ouroboros.Consensus.Shelley.Ledger ( ShelleyBlock ) +import Ouroboros.Consensus.Shelley.Ledger.Mempool + ( GenTx (..) + ) import qualified Cardano.Ledger.Alonzo.Tx as Alonzo import qualified Cardano.Ledger.Babbage.TxBody as Babbage import qualified Cardano.Ledger.Conway.Core as Conway +import qualified Cardano.Ledger.Core as Core import qualified Cardano.Ledger.Crypto as Ledger type family MostRecentEra block :: Type where @@ -106,6 +114,35 @@ instance let isValid = Alonzo.isValid tx pure $ AlonzoTx{body,wits,auxiliaryData,isValid} +---------- +-- GenTx +---------- + +upgradeGenTx + :: forall crypto. + ( Crypto crypto + ) + => GenTx (CardanoBlock crypto) + -> Either Text (GenTx (CardanoBlock crypto)) +upgradeGenTx = \case + GenTxByron _ -> + Left "cannot upgrade from Byron transaction: too old, use a more recent transaction builder." + GenTxShelley _ -> + Left "cannot upgrade from Shelley transaction: too old, use a more recent transaction builder." + GenTxAllegra _ -> + Left "cannot upgrade from Allegra transaction: too old, use a more recent transaction builder." + GenTxMary _ -> + Left "cannot upgrade from Mary transaction: too old, use a more recent transaction builder." + GenTxAlonzo (ShelleyTx hash txInAlonzo) -> do + txInBabbage <- left show $ Core.upgradeTx @(BabbageEra crypto) txInAlonzo + txInConway <- left show $ Core.upgradeTx @(ConwayEra crypto) txInBabbage + pure $ GenTxConway $ ShelleyTx hash txInConway + GenTxBabbage (ShelleyTx hash txInBabbage) -> do + txInConway <- left show $ Core.upgradeTx @(ConwayEra crypto) txInBabbage + pure $ GenTxConway $ ShelleyTx hash txInConway + latest@(GenTxConway(_))-> + Right latest + unsafeFromRight :: (HasCallStack) => Either Text a -> a unsafeFromRight = either error id diff --git a/server/src/Ogmios/Data/Protocol/TxSubmission.hs b/server/src/Ogmios/Data/Protocol/TxSubmission.hs index 33b36b211..75b8dee26 100644 --- a/server/src/Ogmios/Data/Protocol/TxSubmission.hs +++ b/server/src/Ogmios/Data/Protocol/TxSubmission.hs @@ -254,6 +254,7 @@ _decodeSubmitTransaction = data SubmitTransactionResponse block = SubmitTransactionSuccess (GenTxId block) | SubmitTransactionFailure (SubmitTransactionError block) + | SubmitTransactionFailedToUpgrade Text | SubmitTransactionDeserialisationFailure [(SomeShelleyEra, Binary.DecoderError, Word)] deriving (Generic) deriving instance @@ -281,6 +282,16 @@ _encodeSubmitTransactionResponse _proxy resolve $ encodeObject ("transaction" .= encodeTransactionId i) SubmitTransactionFailure e -> encodeSubmitTransactionError reject e + SubmitTransactionFailedToUpgrade hint -> + reject Rpc.FaultInvalidParams + "Non-upgradable transaction; it seems that you're trying to submit a \ + \transaction in a format that presents incompatibility with the current \ + \ledger era. The field \"data.hint\" contains possible useful information \ + \about what went wrong." + (pure $ encodeObject + ( "hint" .= encodeText hint + ) + ) SubmitTransactionDeserialisationFailure errs -> encodeDeserialisationFailure reject errs