proxy: reporting errors (#1108)

* smp-proxy: iron out errors * treat proxy timeouts as temporary * update errors * proxy errors (missing encoding) * update * enable tests * update * update * fix * fix * simplify * test --------- Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
2026-10-22 15:22:18 +00:00 · 2024-05-06 22:00:42 +01:00
1 parent f22daf5cb6
commit c85f6a2f0e
@@ -64,6 +64,7 @@ module Simplex.Messaging.Client
    -- * Supporting types and client configuration
    ProtocolClientError (..),
    SMPClientError,
+    ProxyClientError (..),
    ProtocolClientConfig (..),
    NetworkConfig (..),
    TransportSessionMode (..),
@@ -97,6 +98,7 @@ import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson.TH as J
+import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
@@ -534,16 +536,17 @@ temporaryClientError = \case
  _ -> False
 {-# INLINE temporaryClientError #-}

+-- converts error of client running on proxy to the error sent to client connected to proxy
 smpProxyError :: SMPClientError -> ErrorType
 smpProxyError = \case
-  PCEProtocolError et -> PROXY (PROTOCOL et)
-  PCEResponseError et -> PROXY (RESPONSE et)
-  PCEUnexpectedResponse bs -> PROXY (UNEXPECTED $ B.unpack $ B.take 32 bs)
-  PCEResponseTimeout -> PROXY TIMEOUT
-  PCENetworkError -> PROXY NETWORK
-  PCEIncompatibleHost -> PROXY BAD_HOST
-  PCETransportError t -> PROXY (TRANSPORT t)
-  PCECryptoError _ -> INTERNAL
+  PCEProtocolError e -> PROXY $ PROTOCOL e
+  PCEResponseError e -> PROXY $ BROKER $ RESPONSE $ B.unpack $ strEncode e
+  PCEUnexpectedResponse s -> PROXY $ BROKER $ UNEXPECTED $ B.unpack $ B.take 32 s
+  PCEResponseTimeout -> PROXY $ BROKER TIMEOUT
+  PCENetworkError -> PROXY $ BROKER NETWORK
+  PCEIncompatibleHost -> PROXY $ BROKER HOST
+  PCETransportError t -> PROXY $ BROKER $ TRANSPORT t
+  PCECryptoError _ -> CRYPTO
  PCEIOError _ -> INTERNAL

 -- | Create a new SMP queue.
@@ -699,21 +702,18 @@ deleteSMPQueues :: SMPClient -> NonEmpty (RcvPrivateAuthKey, RecipientId) -> IO
 deleteSMPQueues = okSMPCommands DEL
 {-# INLINE deleteSMPQueues #-}

-- TODO picture
-
 -- send PRXY :: SMPServer -> Maybe BasicAuth -> Command Sender
 -- receives PKEY :: SessionId -> X.CertificateChain -> X.SignedExact X.PubKey -> BrokerMsg
 connectSMPProxiedRelay :: SMPClient -> SMPServer -> Maybe BasicAuth -> ExceptT SMPClientError IO ProxiedRelay
 connectSMPProxiedRelay c relayServ@ProtocolServer {keyHash = C.KeyHash kh} proxyAuth =
  sendSMPCommand c Nothing "" (PRXY relayServ proxyAuth) >>= \case
-    PKEY sId vr (chain, key) -> do
+    PKEY sId vr (chain, key) ->
      case supportedClientSMPRelayVRange `compatibleVersion` vr of
-        Nothing -> throwE PCEIncompatibleHost -- TODO different error
-        Just (Compatible v) -> liftEitherWith x509Error $ ProxiedRelay sId v <$> validateRelay chain key
+        Nothing -> throwE $ relayErr VERSION
+        Just (Compatible v) -> liftEitherWith (const $ relayErr IDENTITY) $ ProxiedRelay sId v <$> validateRelay chain key
    r -> throwE . PCEUnexpectedResponse $ bshow r
  where
-    x509Error :: String -> SMPClientError
-    x509Error _msg = PCEResponseError $ error "TODO: x509 error" -- TODO different error
+    relayErr = PCEProtocolError . PROXY . BROKER . TRANSPORT . TEHandshake
    validateRelay :: X.CertificateChain -> X.SignedExact X.PubKey -> Either String C.PublicKeyX25519
    validateRelay (X.CertificateChain cert) exact = do
      serverKey <- case cert of
@@ -730,10 +730,53 @@ data ProxiedRelay = ProxiedRelay
    prServerKey :: C.PublicKeyX25519
  }

+data ProxyClientError
+  = -- | protocol error response from proxy
+    ProxyProtocolError ErrorType
+  | -- | unexpexted response
+    ProxyUnexpectedResponse String
+  | -- | error between proxy and server
+    ProxyResponseError ErrorType
+  deriving (Eq, Show, Exception)
+
+instance StrEncoding ProxyClientError where
+  strEncode = \case
+    ProxyProtocolError e -> "PROTOCOL " <> strEncode e
+    ProxyUnexpectedResponse s -> "UNEXPECTED " <> B.pack s
+    ProxyResponseError e -> "SYNTAX " <> strEncode e
+  strP =
+    A.takeTill (== ' ') >>= \case
+      "PROTOCOL" -> ProxyProtocolError <$> _strP
+      "UNEXPECTED" -> ProxyUnexpectedResponse . B.unpack <$> (A.space *> A.takeByteString)
+      "SYNTAX" -> ProxyResponseError <$> _strP
+      _ -> fail "bad ProxyClientError"
+
 -- consider how to process slow responses - is it handled somehow locally or delegated to the caller
 -- this method is used in the client
 -- sends PFWD :: C.PublicKeyX25519 -> EncTransmission -> Command Sender
 -- receives PRES :: EncResponse -> BrokerMsg -- proxy to client
+
+-- When client sends message via proxy, there may be one successful scenario and 9 error scenarios
+-- as shown below (WTF stands for unexpected response, ??? for response that failed to parse).
+--    client        proxy   relay   proxy        client
+-- 0) PFWD(SEND) -> RFWD -> RRES -> PRES(OK)  -> ok
+-- 1) PFWD(SEND) -> RFWD -> RRES -> PRES(ERR) -> PCEProtocolError - business logic error for client
+-- 2) PFWD(SEND) -> RFWD -> RRES -> PRES(WTF) -> PCEUnexpectedReponse - relay/client protocol logic error
+-- 3) PFWD(SEND) -> RFWD -> RRES -> PRES(???) -> PCEResponseError - relay/client syntax error
+-- 4) PFWD(SEND) -> RFWD -> ERR ->  ERR PROXY PROTOCOL -> ProxyProtocolError - proxy/relay business logic error
+-- 5) PFWD(SEND) -> RFWD -> WTF ->  ERR PROXY $ BROKER (UNEXPECTED s) -> ProxyProtocolError - proxy/relay protocol logic
+-- 6) PFWD(SEND) -> RFWD -> ??? ->  ERR PROXY $ BROKER (RESPONSE s) -> ProxyProtocolError - - proxy/relay syntax
+-- 7) PFWD(SEND) -> ERR  -> ProxyProtocolError - client/proxy business logic
+-- 8) PFWD(SEND) -> WTF  -> ProxyUnexpectedResponse - client/proxy protocol logic
+-- 9) PFWD(SEND) -> ???  -> ProxyResponseError - client/proxy syntax
+--
+-- We report as proxySMPMessage error (ExceptT error) the errors of two kinds:
+-- - protocol errors from the destination relay wrapped in PRES - to simplify processing of AUTH and QUOTA errors, in this case proxy is "transparent" for such errors (PCEProtocolError, PCEUnexpectedResponse, PCEResponseError)
+-- - other response/transport/connection errors from the client connected to proxy itself
+-- Other errors are reported in the function result as `Either ProxiedRelayError ()`, including
+-- - protocol  errors from the client connected to proxy in ProxyClientError (PCEProtocolError, PCEUnexpectedResponse, PCEResponseError)
+-- - other errors from the client running on proxy and connected to relay in PREProxiedRelayError
+
 proxySMPMessage ::
  SMPClient ->
  -- proxy session from PKEY
@@ -743,7 +786,7 @@ proxySMPMessage ::
  SenderId ->
  MsgFlags ->
  MsgBody ->
-  ExceptT SMPClientError IO ()
+  ExceptT SMPClientError IO (Either ProxyClientError ())
 -- TODO use version
 proxySMPMessage c@ProtocolClient {thParams = proxyThParams, client_ = PClient {clientCorrId = g}} (ProxiedRelay sessionId _v serverKey) spKey sId flags msg = do
  -- prepare params
@@ -756,24 +799,32 @@ proxySMPMessage c@ProtocolClient {thParams = proxyThParams, client_ = PClient {c
  let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth serverThParams (CorrId corrId, sId, Cmd SSender $ SEND flags msg)
  auth <- liftEitherWith PCETransportError $ authTransmission serverThAuth spKey nonce tForAuth
  b <- case batchTransmissions (batch serverThParams) (blockSize serverThParams) [Right (auth, tToSend)] of
-    [] -> throwE $ PCETransportError TELargeMsg -- some other error. Internal?
-    TBError e _ : _ -> throwE $ PCETransportError e -- large message error?
+    [] -> throwE $ PCETransportError TELargeMsg
+    TBError e _ : _ -> throwE $ PCETransportError e
    TBTransmission s _ : _ -> pure s
    TBTransmissions s _ _ : _ -> pure s
  et <- liftEitherWith PCECryptoError $ EncTransmission <$> C.cbEncrypt cmdSecret nonce b paddedProxiedMsgLength
-  sendProtocolCommand_ c (Just nonce) Nothing sessionId (Cmd SProxiedClient (PFWD cmdPubKey et)) >>= \case
-    -- TODO support PKEY + resend?
-    PRES (EncResponse er) -> do
-      t' <- liftEitherWith PCECryptoError $ C.cbDecrypt cmdSecret (C.reverseNonce nonce) er
-      case tParse proxyThParams t' of
-        t'' :| [] -> case tDecodeParseValidate proxyThParams t'' of
-          (_auth, _signed, (_c, _e, r)) -> case r of -- TODO: verify
-            Left e -> throwE $ PCEResponseError e
-            Right OK -> pure ()
-            Right (ERR e) -> throwE $ PCEProtocolError e
-            Right u -> throwE . PCEUnexpectedResponse $ bshow u -- possibly differentiate unexpected response from server/proxy
-        _ -> throwE $ PCETransportError TEBadBlock
-    r -> throwE . PCEUnexpectedResponse $ bshow r -- from proxy
+  -- proxy interaction errors are wrapped
+  tryE (sendProtocolCommand_ c (Just nonce) Nothing sessionId (Cmd SProxiedClient (PFWD cmdPubKey et))) >>= \case
+    Right r -> case r of
+      PRES (EncResponse er) -> do
+        -- server interaction errors are thrown directly
+        t' <- liftEitherWith PCECryptoError $ C.cbDecrypt cmdSecret (C.reverseNonce nonce) er
+        case tParse proxyThParams t' of
+          t'' :| [] -> case tDecodeParseValidate proxyThParams t'' of
+            (_auth, _signed, (_c, _e, cmd)) -> case cmd of
+              Right OK -> pure $ Right ()
+              Right (ERR e) -> throwE $ PCEProtocolError e -- this is the error from the destination relay
+              Right e -> throwE $ PCEUnexpectedResponse $ B.take 32 $ bshow e
+              Left e -> throwE $ PCEResponseError e
+          _ -> throwE $ PCETransportError TEBadBlock
+      ERR e -> pure . Left $ ProxyProtocolError e -- this will not happen, this error is returned via Left
+      _ -> pure . Left $ ProxyUnexpectedResponse $ take 32 $ show r
+    Left e -> case e of
+      PCEProtocolError e' -> pure . Left $ ProxyProtocolError e'
+      PCEUnexpectedResponse r -> pure . Left $ ProxyUnexpectedResponse $ B.unpack r
+      PCEResponseError e' -> pure . Left $ ProxyResponseError e'
+      _ -> throwE e

 -- this method is used in the proxy
 -- sends RFWD :: EncFwdTransmission -> Command Sender
@@ -783,8 +834,8 @@ forwardSMPMessage :: SMPClient -> CorrId -> C.PublicKeyX25519 -> EncTransmission
 forwardSMPMessage c@ProtocolClient {thParams, client_ = PClient {clientCorrId = g}} fwdCorrId fwdKey fwdTransmission = do
  -- prepare params
  sessSecret <- case thAuth thParams of
-    Nothing -> throwError $ PCEProtocolError INTERNAL -- different error - proxy didn't pass key?
-    Just THAuthClient {sessSecret} -> maybe (throwError $ PCEProtocolError INTERNAL) pure sessSecret
+    Nothing -> throwError $ PCETransportError TENoServerAuth
+    Just THAuthClient {sessSecret} -> maybe (throwError $ PCETransportError TENoServerAuth) pure sessSecret
  nonce <- liftIO . atomically $ C.randomCbNonce g
  -- wrap
  let fwdT = FwdTransmission {fwdCorrId, fwdKey, fwdTransmission}
@@ -796,7 +847,7 @@ forwardSMPMessage c@ProtocolClient {thParams, client_ = PClient {clientCorrId =
      r' <- liftEitherWith PCECryptoError $ C.cbDecryptNoPad sessSecret (C.reverseNonce nonce) efr
      FwdResponse {fwdCorrId = _, fwdResponse} <- liftEitherWith (const $ PCEResponseError BLOCK) $ smpDecode r'
      pure fwdResponse
-    r -> throwE . PCEUnexpectedResponse $ bshow r
+    r -> throwE . PCEUnexpectedResponse $ B.take 32 $ bshow r

 okSMPCommand :: PartyI p => Command p -> SMPClient -> C.APrivateAuthKey -> QueueId -> ExceptT SMPClientError IO ()
 okSMPCommand cmd c pKey qId =
@@ -933,3 +984,5 @@ $(J.deriveJSON (enumJSON $ dropPrefix "TSM") ''TransportSessionMode)
 $(J.deriveJSON (enumJSON $ dropPrefix "SPM") ''SMPProxyMode)

 $(J.deriveJSON defaultJSON ''NetworkConfig)
+
+$(J.deriveJSON (enumJSON $ dropPrefix "Proxy") ''ProxyClientError)