Modify submit-api to accept cbor transactions instead

IntersectMBO · Mar 16, 2021 · 67bacb5 · 67bacb5
1 parent 7f137e3
commit 67bacb5
Show file tree

Hide file tree

Showing 3 changed files with 59 additions and 33 deletions.
diff --git 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
@@ -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
@@ -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 }