diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs index 88afea56b..8698643eb 100644 --- a/src/Simplex/Messaging/Client.hs +++ b/src/Simplex/Messaging/Client.hs @@ -484,16 +484,15 @@ temporaryClientError = \case _ -> False {-# INLINE temporaryClientError #-} --- TODO keep error params smpProxyError :: SMPClientError -> ErrorType smpProxyError = \case - PCEProtocolError _ -> PROXY PROTOCOL - PCEResponseError _ -> PROXY RESPONSE - PCEUnexpectedResponse _ -> PROXY UNEXPECTED + PCEProtocolError et -> PROXY (PROTOCOL et) + PCEResponseError et -> PROXY (RESPONSE et) + PCEUnexpectedResponse bs -> PROXY (UNEXPECTED $ B.unpack bs) PCEResponseTimeout -> PROXY TIMEOUT PCENetworkError -> PROXY NETWORK PCEIncompatibleHost -> PROXY BAD_HOST - PCETransportError _ -> PROXY TRANSPORT + PCETransportError t -> PROXY (TRANSPORT t) PCECryptoError _ -> INTERNAL PCEIOError _ -> INTERNAL diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs index 3ad510481..c548fb053 100644 --- a/src/Simplex/Messaging/Protocol.hs +++ b/src/Simplex/Messaging/Protocol.hs @@ -1194,16 +1194,16 @@ data CommandError data ProxyError = -- | Correctly parsed SMP server ERR response. -- This error is forwarded to the agent client as `ERR SMP err`. - PROTOCOL -- {protocolErr :: String} + PROTOCOL {protocolErr :: ErrorType} | -- | Invalid server response that failed to parse. -- Forwarded to the agent client as `ERR BROKER RESPONSE`. - RESPONSE -- {responseErr :: String} - | UNEXPECTED + RESPONSE {responseErr :: ErrorType} + | UNEXPECTED {unexpectedResponse :: String} -- 'String' for using derived JSON and Arbitrary instances | TIMEOUT | NETWORK | BAD_HOST | NO_SESSION - | TRANSPORT -- {transportErr :: TransportError} + | TRANSPORT {transportErr :: TransportError} deriving (Eq, Read, Show) -- | SMP transmission parser. @@ -1473,24 +1473,24 @@ instance Encoding CommandError where instance Encoding ProxyError where smpEncode e = case e of - PROTOCOL -> "PROTOCOL" - RESPONSE -> "RESPONSE" - UNEXPECTED -> "UNEXPECTED" + PROTOCOL et -> "PROTOCOL " <> smpEncode et + RESPONSE et -> "RESPONSE " <> smpEncode et + UNEXPECTED s -> "UNEXPECTED " <> smpEncode (B.pack s) TIMEOUT -> "TIMEOUT" NETWORK -> "NETWORK" BAD_HOST -> "BAD_HOST" NO_SESSION -> "NO_SESSION" - TRANSPORT -> "TRANSPORT" + TRANSPORT t -> "TRANSPORT " <> serializeTransportError t smpP = A.takeTill (== ' ') >>= \case - "PROTOCOL" -> pure PROTOCOL - "RESPONSE" -> pure RESPONSE - "UNEXPECTED" -> pure UNEXPECTED + "PROTOCOL" -> PROTOCOL <$> _smpP + "RESPONSE" -> RESPONSE <$> _smpP + "UNEXPECTED" -> UNEXPECTED . B.unpack <$> _smpP "TIMEOUT" -> pure TIMEOUT "NETWORK" -> pure NETWORK "BAD_HOST" -> pure BAD_HOST "NO_SESSION" -> pure NO_SESSION - "TRANSPORT" -> pure TRANSPORT + "TRANSPORT" -> TRANSPORT <$> (A.space *> transportErrorP) _ -> fail "bad command error type" -- | Send signed SMP transmission to TCP transport. @@ -1630,6 +1630,5 @@ $(J.deriveJSON defaultJSON ''MsgFlags) $(J.deriveJSON (sumTypeJSON id) ''CommandError) -$(J.deriveJSON (sumTypeJSON id) ''ProxyError) - -$(J.deriveJSON (sumTypeJSON id) ''ErrorType) +-- run deriveJSON in one TH splice to allow mutual instance +$(concat <$> mapM @[] (J.deriveJSON (sumTypeJSON id)) [''ProxyError, ''ErrorType]) diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index 959339fad..b4c9722f7 100644 --- a/src/Simplex/Messaging/Server.hs +++ b/src/Simplex/Messaging/Server.hs @@ -632,7 +632,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi vr = supportedServerSMPRelayVRange in case thAuth of Just THAuthClient {serverCertKey} -> PKEY srvSessId vr serverCertKey - Nothing -> ERR $ PROXY TRANSPORT -- TODO different error? + Nothing -> ERR $ PROXY (TRANSPORT TENoServerAuth) Left err -> ERR $ smpProxyError err PFWD pubKey encBlock -> do ProxyAgent {smpAgent} <- asks proxyAgent