Merge pull request #1126 from IntersectMBO/jordan/1102-submittxtonodelocal-leaky-exception

Fix submitTxToNodeLocal leaky exception

Author: Jimbo4350

cardano-api/src/Cardano/Api/Network/IPC.hs

@@ -172,12 +172,13 @@ module Cardano.Api.Network.IPC
     -- result <- Api.submitTxToNodeLocal connectionInfo (Api.TxInMode sbe signedTx)
     -- @
     --
-    -- The result is a 'SubmitResult' value, which can be inspected as follows:
+    -- The result is a 'TxSubmitResult' value, which can be inspected as follows:
     --
     -- @
     -- case result of
-    --   Api.SubmitSuccess -> putStrLn "Transaction submitted successfully!"
-    --   Api.SubmitFail reason -> error $ "Error submitting transaction: " ++ show reason
+    --   Api.TxSubmitSuccess -> putStrLn "Transaction submitted successfully!"
+    --   Api.TxSubmitFail reason -> error $ "Validation error: " ++ show reason
+    --   Api.TxSubmitError err -> error $ "Error: " ++ show err
     -- @
     --
     -- If the command succeeds, the transaction gets into the node's mempool, ready
@@ -206,6 +207,7 @@ module Cardano.Api.Network.IPC
   , TxValidationErrorInCardanoMode
   , TxValidationError
   , submitTxToNodeLocal
+  , TxSubmitResult (..)
   , SubmitResult (..)
 
     -- *** Local state query

cardano-api/src/Cardano/Api/Network/IPC/Internal.hs

@@ -35,6 +35,7 @@ module Cardano.Api.Network.IPC.Internal
   , TxValidationErrorInCardanoMode
   , TxValidationError
   , submitTxToNodeLocal
+  , TxSubmitResult (..)
   , SubmitResult (..)
 
     -- *** Local state query
@@ -122,15 +123,18 @@ import Control.Concurrent.STM
   , putTMVar
   , takeTMVar
   , tryPutTMVar
+  , tryTakeTMVar
   )
-import Control.Exception (throwIO)
+import Control.Exception (SomeException, throwIO)
+import Control.Exception.Safe (tryAny)
 import Control.Monad (void)
 import Control.Monad.IO.Class
 import Control.Tracer (nullTracer)
 import Data.Aeson (ToJSON, object, toJSON, (.=))
 import Data.ByteString.Lazy qualified as LBS
 import Data.Void (Void)
 import GHC.Exts (IsList (..))
+import GHC.Stack (HasCallStack)
 import Network.Mux qualified as Net
 import Network.Mux.Trace (nullTracers)
 
@@ -621,22 +625,56 @@ queryNodeLocalState connctInfo mpoint query = do
                 pure $ Net.Query.SendMsgDone ()
             }
 
+-- | The result of submitting a transaction via 'submitTxToNodeLocal'.
+data TxSubmitResult
+  = -- | The transaction was accepted into the node's mempool.
+    TxSubmitSuccess
+  | -- | The node rejected the transaction due to a validation error.
+    TxSubmitFail TxValidationErrorInCardanoMode
+  | -- | An exception escaped the underlying connection machinery. This covers
+    -- network-level errors (e.g. socket missing, bearer closed mid-protocol,
+    -- handshake failure) but may also include unexpected exceptions from the
+    -- protocol handlers.
+    --
+    -- Note: if the protocol handler wrote a result to the internal TMVar before
+    -- the exception was thrown (e.g. the node responded but the bearer then
+    -- closed), that result takes precedence and 'TxSubmitSuccess' or
+    -- 'TxSubmitFail' is returned instead.
+    TxSubmitError SomeException
+  deriving Show
+
 submitTxToNodeLocal
-  :: MonadIO m
+  :: (HasCallStack, MonadIO m)
   => LocalNodeConnectInfo
   -> TxInMode
-  -> m (Net.Tx.SubmitResult TxValidationErrorInCardanoMode)
-submitTxToNodeLocal connctInfo tx = do
-  resultVar <- liftIO newEmptyTMVarIO
-  connectToLocalNode
-    connctInfo
-    LocalNodeClientProtocols
-      { localChainSyncClient = NoLocalChainSyncClient
-      , localTxSubmissionClient = Just (localTxSubmissionClientSingle resultVar)
-      , localStateQueryClient = Nothing
-      , localTxMonitoringClient = Nothing
-      }
-  liftIO $ atomically (takeTMVar resultVar)
+  -> m TxSubmitResult
+submitTxToNodeLocal connctInfo tx = liftIO $ do
+  resultVar <- newEmptyTMVarIO
+  result <-
+    tryAny $
+      connectToLocalNode
+        connctInfo
+        LocalNodeClientProtocols
+          { localChainSyncClient = NoLocalChainSyncClient
+          , localTxSubmissionClient = Just (localTxSubmissionClientSingle resultVar)
+          , localStateQueryClient = Nothing
+          , localTxMonitoringClient = Nothing
+          }
+  case result of
+    Left e -> do
+      -- The connection threw an exception, but the protocol handler may have
+      -- already written a result (e.g. node responded then bearer closed).
+      -- Prefer the protocol result if available; fall back to the exception.
+      mResult <- atomically (tryTakeTMVar resultVar)
+      pure $ case mResult of
+        Just Net.Tx.SubmitSuccess -> TxSubmitSuccess
+        Just (Net.Tx.SubmitFail reason) -> TxSubmitFail reason
+        Nothing -> TxSubmitError e
+    Right () -> do
+      submitResult <- atomically (takeTMVar resultVar)
+      pure $ case submitResult of
+        Net.Tx.SubmitSuccess -> TxSubmitSuccess
+        Net.Tx.SubmitFail reason -> TxSubmitFail reason
  where
   localTxSubmissionClientSingle
     :: ()

cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Submit.hs

@@ -14,7 +14,6 @@ module Cardano.Rpc.Server.Internal.UtxoRpc.Submit
 where
 
 import Cardano.Api
-import Cardano.Api.Network.IPC qualified as Net.Tx
 import Cardano.Rpc.Proto.Api.UtxoRpc.Submit qualified as U5c
 import Cardano.Rpc.Proto.Api.UtxoRpc.Submit qualified as UtxoRpc
 import Cardano.Rpc.Server.Internal.Error
@@ -58,12 +57,12 @@ submitTxMethod req = do
     -> m TxId
   submitTx sbe tx = do
     nodeConnInfo <- grab
-    putTraceThrowEither . join . first TraceRpcSubmitN2cConnectionError
-      =<< tryAny
-        ( submitTxToNodeLocal nodeConnInfo (TxInMode sbe tx) >>= \case
-            Net.Tx.SubmitFail reason -> pure . Left $ TraceRpcSubmitTxValidationError reason
-            Net.Tx.SubmitSuccess -> pure . Right $ getTxId $ getTxBody tx
-        )
+    result <-
+      submitTxToNodeLocal nodeConnInfo (TxInMode sbe tx) <&> \case
+        TxSubmitError e -> Left $ TraceRpcSubmitN2cConnectionError e
+        TxSubmitFail reason -> Left $ TraceRpcSubmitTxValidationError reason
+        TxSubmitSuccess -> Right $ getTxId $ getTxBody tx
+    putTraceThrowEither result
 
   putTraceThrowEither v = withFrozenCallStack $ do
     -- See Cardano.Node.Tracing.Tracers.Rpc in cardano-node for details how this is logged