update for hosts in responses

This commit is contained in:
IC Rainbow
2024-05-06 16:47:27 +03:00
parent 1f293a05c9
commit 4b56efc6ce
2 changed files with 8 additions and 8 deletions
+5 -5
View File
@@ -3061,7 +3061,7 @@ receiveFile' user ft rcvInline_ filePath_ = do
where
processError = \case
-- TODO AChatItem in Cancelled events
ChatErrorAgent (SMP SMP.AUTH) _ -> pure $ CRRcvFileAcceptedSndCancelled user ft
ChatErrorAgent (SMP _ SMP.AUTH) _ -> pure $ CRRcvFileAcceptedSndCancelled user ft
ChatErrorAgent (CONN DUPLICATE) _ -> pure $ CRRcvFileAcceptedSndCancelled user ft
e -> throwError e
@@ -3398,7 +3398,7 @@ subscribeUserConnections vr onlyNeeded agentBatchSubscribe user = do
errorNetworkStatus :: ChatError -> String
errorNetworkStatus = \case
ChatErrorAgent (BROKER _ NETWORK) _ -> "network"
ChatErrorAgent (SMP SMP.AUTH) _ -> "contact deleted"
ChatErrorAgent (SMP _ SMP.AUTH) _ -> "contact deleted"
e -> show e
-- TODO possibly below could be replaced with less noisy events for API
contactLinkSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId UserContact -> CM ()
@@ -4555,7 +4555,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
MERR _ err -> do
cancelSndFileTransfer user ft True >>= mapM_ (deleteAgentConnectionAsync user)
case err of
SMP SMP.AUTH -> unless (fileStatus == FSCancelled) $ do
SMP _ SMP.AUTH -> unless (fileStatus == FSCancelled) $ do
ci <- withStore $ \db -> do
liftIO (lookupChatRefByFileId db user fileId) >>= \case
Just (ChatRef CTDirect _) -> liftIO $ updateFileCancelled db user fileId CIFSSndCancelled
@@ -4710,7 +4710,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
incAuthErrCounter :: ConnectionEntity -> Connection -> AgentErrorType -> CM ()
incAuthErrCounter connEntity conn err = do
case err of
SMP SMP.AUTH -> do
SMP _ SMP.AUTH -> do
authErrCounter' <- withStore' $ \db -> incConnectionAuthErrCounter db user conn
when (authErrCounter' >= authErrDisableCount) $ do
toView $ CRConnectionDisabled connEntity
@@ -4777,7 +4777,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
withStore' $ \db -> updateSndMsgDeliveryStatus db connId msgId MDSSndSent
agentErrToItemStatus :: AgentErrorType -> CIStatus 'MDSnd
agentErrToItemStatus (SMP AUTH) = CISSndErrorAuth
agentErrToItemStatus (SMP _ AUTH) = CISSndErrorAuth
agentErrToItemStatus err = CISSndError . T.unpack . safeDecodeUtf8 $ strEncode err
badRcvFileChunk :: RcvFileTransfer -> String -> CM ()
+3 -3
View File
@@ -1180,8 +1180,8 @@ viewServerTestResult :: AProtoServerWithAuth -> Maybe ProtocolTestFailure -> [St
viewServerTestResult (AProtoServerWithAuth p _) = \case
Just ProtocolTestFailure {testStep, testError} ->
result
<> [pName <> " server requires authorization to create queues, check password" | testStep == TSCreateQueue && testError == SMP SMP.AUTH]
<> [pName <> " server requires authorization to upload files, check password" | testStep == TSCreateFile && testError == XFTP XFTPTransport.AUTH]
<> [pName <> " server requires authorization to create queues, check password" | SMP _ SMP.AUTH <- [testError], testStep == TSCreateQueue]
<> [pName <> " server requires authorization to upload files, check password" | XFTP _ XFTPTransport.AUTH <- [testError], testStep == TSCreateFile]
<> ["Possibly, certificate fingerprint in " <> pName <> " server address is incorrect" | testStep == TSConnect && brokerErr]
where
result = [pName <> " server test failed at " <> plain (drop 2 $ show testStep) <> ", error: " <> plain (strEncode testError)]
@@ -2021,7 +2021,7 @@ viewChatError logLevel testView = \case
e -> ["chat database error: " <> sShow e]
ChatErrorAgent err entity_ -> case err of
CMD PROHIBITED -> [withConnEntity <> "error: command is prohibited"]
SMP SMP.AUTH ->
SMP _ SMP.AUTH ->
[ withConnEntity
<> "error: connection authorization failed - this could happen if connection was deleted,\
\ secured with different credentials, or due to a bug - please re-create the connection"