diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index c89b448c455..cd4ba0af083 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -391,7 +391,7 @@ module Cardano.Api ( connectToLocalNode, LocalNodeConnectInfo(..), AnyConsensusMode(..), - ConsensusMode(CardanoMode), + ConsensusMode(..), consensusModeOnly, AnyConsensusModeParams(..), ConsensusModeParams(..), @@ -465,6 +465,10 @@ module Cardano.Api ( toNetworkMagic, --TODO: Remove after updating cardano-node-chairman with new IPC SomeNodeClientProtocol(..), + + AsType(..), + localConsensusMode, + SubmitResult(..), ) where import Cardano.Api.Address diff --git a/cardano-submit-api/src/Cardano/TxSubmit/Types.hs b/cardano-submit-api/src/Cardano/TxSubmit/Types.hs index 07024074f6a..bc57c1e4400 100644 --- a/cardano-submit-api/src/Cardano/TxSubmit/Types.hs +++ b/cardano-submit-api/src/Cardano/TxSubmit/Types.hs @@ -45,6 +45,7 @@ newtype EnvSocketError = CliEnvVarLookup Text deriving (Eq, Show) data TxCmdError = TxCmdSocketEnvError EnvSocketError | TxCmdEraConsensusModeMismatch !AnyConsensusMode !AnyCardanoEra + | TxCmdTxDecodeFail !DecoderError | TxCmdTxReadError !TextEnvelopeError | TxCmdTxSubmitError !Text | TxCmdTxSubmitErrorEraMismatch !EraMismatch @@ -56,6 +57,7 @@ convertJson :: TxSubmitWebApiError -> Value convertJson = String . renderTxSubmitWebApiError renderTxCmdError :: TxCmdError -> Text +renderTxCmdError (TxCmdTxDecodeFail err) = "decode failed " <> textShow err renderTxCmdError (TxCmdSocketEnvError socketError) = "socket env error " <> textShow socketError renderTxCmdError (TxCmdEraConsensusModeMismatch mode era) = "era consensus mode mismatch" <> textShow mode <> " " <> textShow era renderTxCmdError (TxCmdTxReadError envelopeError) = "transaction read error " <> textShow envelopeError diff --git a/cardano-submit-api/src/Cardano/TxSubmit/Web.hs b/cardano-submit-api/src/Cardano/TxSubmit/Web.hs index 1276bca42f7..f4d538a410a 100644 --- a/cardano-submit-api/src/Cardano/TxSubmit/Web.hs +++ b/cardano-submit-api/src/Cardano/TxSubmit/Web.hs @@ -12,24 +12,24 @@ module Cardano.TxSubmit.Web import Cardano.Api (AllegraEra, AnyCardanoEra (AnyCardanoEra), AnyConsensusMode (AnyConsensusMode), AnyConsensusModeParams (..), - AsType (AsAllegraEra, AsByronEra, AsMaryEra, AsShelleyEra, AsTx), ByronEra, - CardanoEra (AllegraEra, ByronEra, MaryEra, ShelleyEra), FromSomeType (..), - HasTextEnvelope, HasTypeProxy (AsType), InAnyCardanoEra (..), + AsType (AsAllegraEra, AsByronEra, AsByronTx, AsMaryEra, AsShelleyEra, AsShelleyTx, AsTx), + ByronEra, CardanoEra (AllegraEra, ByronEra, MaryEra, ShelleyEra), + ConsensusMode (..), EraInMode (..), FromSomeType (..), HasTextEnvelope, + HasTypeProxy (AsType), InAnyCardanoEra (..), LocalNodeConnectInfo (LocalNodeConnectInfo, localConsensusModeParams, localNodeNetworkId, localNodeSocketPath), - MaryEra, NetworkId, ShelleyEra, TextEnvelopeError (TextEnvelopeAesonDecodeError), - ToJSON, Tx, TxId (..), TxInMode (TxInMode), + MaryEra, NetworkId, ShelleyEra, SubmitResult (..), + TextEnvelopeError (TextEnvelopeAesonDecodeError), ToJSON, Tx, TxId (..), + TxInMode (TxInMode), TxValidationErrorInMode (TxValidationEraMismatch, TxValidationErrorInMode), - consensusModeOnly, deserialiseFromTextEnvelopeAnyOf, getTxBody, getTxId, - submitTxToNodeLocal, toEraInMode) + consensusModeOnly, deserialiseFromCBOR, deserialiseFromTextEnvelopeAnyOf, + getTxBody, getTxId, localConsensusMode, submitTxToNodeLocal, toEraInMode) import Cardano.BM.Trace (Trace, logInfo) import Cardano.Binary (DecoderError) import Cardano.TxSubmit.CLI.Types (SocketPath (SocketPath)) import Cardano.TxSubmit.Metrics (TxSubmitMetrics (..)) import Cardano.TxSubmit.Rest.Types (WebserverConfig (..), toWarpSettings) -import Cardano.TxSubmit.Types (EnvSocketError (..), - TxCmdError (TxCmdEraConsensusModeMismatch, TxCmdTxReadError, TxCmdTxSubmitError, TxCmdTxSubmitErrorEraMismatch), - TxSubmitApi, TxSubmitApiRecord (..), TxSubmitWebApiError (TxSubmitFail), - renderTxCmdError) +import Cardano.TxSubmit.Types (EnvSocketError (..), TxCmdError (..), TxSubmitApi, + TxSubmitApiRecord (..), TxSubmitWebApiError (TxSubmitFail), renderTxCmdError) import Cardano.TxSubmit.Util (logException) import Control.Monad.Except (ExceptT, MonadError (throwError), MonadIO (liftIO), runExceptT) @@ -135,33 +135,53 @@ txSubmitPost -> ByteString -> Handler TxId txSubmitPost trace metrics (AnyConsensusModeParams cModeParams) networkId (SocketPath socketPath) txBytes = handle $ do - InAnyCardanoEra era tx <- readByteStringTx txBytes - let cMode = AnyConsensusMode $ consensusModeOnly cModeParams - eraInMode <- hoistMaybe - (TxCmdEraConsensusModeMismatch cMode (AnyCardanoEra era)) - (toEraInMode era $ consensusModeOnly cModeParams) - let txInMode = TxInMode tx eraInMode - localNodeConnInfo = LocalNodeConnectInfo - { localConsensusModeParams = cModeParams - , localNodeNetworkId = networkId - , localNodeSocketPath = socketPath - } - - res <- liftIO $ submitTxToNodeLocal localNodeConnInfo txInMode - case res of - Net.Tx.SubmitSuccess -> do - liftIO $ T.putStrLn "Transaction successfully submitted." - return $ getTxId (getTxBody tx) - Net.Tx.SubmitFail reason -> - case reason of - TxValidationErrorInMode err _eraInMode -> left . TxCmdTxSubmitError . T.pack $ show err - TxValidationEraMismatch mismatchErr -> left $ TxCmdTxSubmitErrorEraMismatch mismatchErr + let localNodeConnInfo = LocalNodeConnectInfo + { localConsensusModeParams = cModeParams + , localNodeNetworkId = networkId + , localNodeSocketPath = socketPath + } + + case localConsensusMode localNodeConnInfo of + ByronMode{} -> do + case deserialiseFromCBOR AsByronTx txBytes of + Left err -> throwError (TxCmdTxDecodeFail err) + Right tx -> do + res <- liftIO $ submitTxToNodeLocal localNodeConnInfo (TxInMode tx ByronEraInByronMode) + handleResult tx res + + ShelleyMode{} -> do + case deserialiseFromCBOR AsShelleyTx txBytes of + Left err -> throwError (TxCmdTxDecodeFail err) + Right tx -> do + res <- liftIO $ submitTxToNodeLocal localNodeConnInfo (TxInMode tx ShelleyEraInShelleyMode) + handleResult tx res + + CardanoMode{} -> do + case deserialiseFromCBOR AsByronTx txBytes of + Left err -> case deserialiseFromCBOR AsShelleyTx txBytes of + Left _ -> throwError (TxCmdTxDecodeFail err) + Right tx -> do + res <- liftIO $ submitTxToNodeLocal localNodeConnInfo (TxInMode tx ShelleyEraInCardanoMode) + handleResult tx res + Right tx -> do + res <- liftIO $ submitTxToNodeLocal localNodeConnInfo (TxInMode tx ByronEraInCardanoMode) + handleResult tx res where handle :: ExceptT TxCmdError IO TxId -> Handler TxId handle f = do result <- liftIO $ runExceptT f handleSubmitResult result + handleResult :: Tx era -> SubmitResult (TxValidationErrorInMode mode) -> ExceptT TxCmdError IO TxId + handleResult tx res = case res of + Net.Tx.SubmitSuccess -> do + liftIO $ T.putStrLn "Transaction successfully submitted." + return $ getTxId (getTxBody tx) + Net.Tx.SubmitFail reason -> + case reason of + TxValidationErrorInMode err _eraInMode -> left . TxCmdTxSubmitError . T.pack $ show err + TxValidationEraMismatch mismatchErr -> left $ TxCmdTxSubmitErrorEraMismatch mismatchErr + errorResponse :: ToJSON e => e -> Handler a errorResponse e = throwError $ err400 { errBody = Aeson.encode e }