dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-08-07 01:50:05 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: process ERR response to async command (#1061)

Browse Source
This commit is contained in:
JRoberts
2022-09-16 19:30:02 +04:00
committed by GitHub
parent d5b9f4014e
commit e8c14896aa
5 changed files with 39 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat.hs
+27 -10
View File
@@ -1385,7 +1385,9 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM
withCompletedCommand conn agentMsg $ \CommandData {cmdFunction, cmdId} ->
when (cmdFunction == CFAckMessage) $ ackMsgDeliveryEvent conn cmdId
MERR _ err -> toView . CRChatError $ ChatErrorAgent err -- ? updateDirectChatItemStatus
ERR err -> toView . CRChatError $ ChatErrorAgent err
ERR err -> do
toView . CRChatError $ ChatErrorAgent err
when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
-- TODO add debugging output
_ -> pure ()
Just ct@Contact {localDisplayName = c, contactId} -> case agentMsg of
@@ -1485,7 +1487,9 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM
forM_ chatItemId_ $ \chatItemId -> do
chatItem <- withStore $ \db -> updateDirectChatItemStatus db userId contactId chatItemId (agentErrToItemStatus err)
toView $ CRChatItemStatusUpdated (AChatItem SCTDirect SMDSnd (DirectChat ct) chatItem)
ERR err -> toView . CRChatError $ ChatErrorAgent err
ERR err -> do
toView . CRChatError $ ChatErrorAgent err
when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
-- TODO add debugging output
_ -> pure ()
@@ -1599,7 +1603,9 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM
withCompletedCommand conn agentMsg $ \CommandData {cmdFunction, cmdId} ->
when (cmdFunction == CFAckMessage) $ ackMsgDeliveryEvent conn cmdId
MERR _ err -> toView . CRChatError $ ChatErrorAgent err
ERR err -> toView . CRChatError $ ChatErrorAgent err
ERR err -> do
toView . CRChatError $ ChatErrorAgent err
when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
-- TODO add debugging output
_ -> pure ()
@@ -1641,7 +1647,9 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM
OK ->
-- [async agent commands] continuation on receiving OK
withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
ERR err -> toView . CRChatError $ ChatErrorAgent err
ERR err -> do
toView . CRChatError $ ChatErrorAgent err
when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
-- TODO add debugging output
_ -> pure ()
@@ -1701,12 +1709,14 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM
-- [async agent commands] continuation on receiving OK
withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
MERR _ err -> toView . CRChatError $ ChatErrorAgent err
ERR err -> toView . CRChatError $ ChatErrorAgent err
ERR err -> do
toView . CRChatError $ ChatErrorAgent err
when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
-- TODO add debugging output
_ -> pure ()
processUserContactRequest :: ACommand 'Agent -> Connection -> UserContact -> m ()
processUserContactRequest agentMsg _conn UserContact {userContactLinkId} = case agentMsg of
processUserContactRequest agentMsg conn UserContact {userContactLinkId} = case agentMsg of
REQ invId _ connInfo -> do
ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage connInfo
case chatMsgEvent of
@@ -1715,7 +1725,9 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM
-- TODO show/log error, other events in contact request
_ -> pure ()
MERR _ err -> toView . CRChatError $ ChatErrorAgent err
ERR err -> toView . CRChatError $ ChatErrorAgent err
ERR err -> do
toView . CRChatError $ ChatErrorAgent err
when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
-- TODO add debugging output
_ -> pure ()
where
@@ -1738,10 +1750,15 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM
case cmdData_ of
Just cmdData@CommandData {cmdId, cmdConnId = Just cmdConnId', cmdFunction}
| connId == cmdConnId' && agentMsgTag == commandExpectedResponse cmdFunction -> do
withStore' $ \db -> updateCommandStatus db user cmdId CSCompleted
withStore' $ \db -> deleteCommand db user cmdId
action cmdData
| otherwise -> throwChatError . CEAgentCommandError $ "not matching connection id or unexpected response, details - connId = " <> show connId <> ", agentMsgTag = " <> show agentMsgTag <> ", cmdData " <> show cmdData
_ -> throwChatError . CEAgentCommandError $ "no connection or connection id, details - connId = " <> show connId <> ", agentMsgTag = " <> show agentMsgTag <> ", corrId = " <> commandId corrId
| otherwise -> err cmdId $ "not matching connection id or unexpected response, corrId = " <> show corrId
Just CommandData {cmdId, cmdConnId = Nothing} -> err cmdId $ "no command connection id, corrId = " <> show corrId
Nothing -> throwChatError . CEAgentCommandError $ "command not found, corrId = " <> show corrId
where
err cmdId msg = do
withStore' $ \db -> updateCommandStatus db user cmdId CSError
throwChatError . CEAgentCommandError $ msg
createAckCmd :: Connection -> m CommandId
createAckCmd Connection {connId} = do
src/Simplex/Chat/Migrations/M20220909_commands.hs
+1 -1
View File
@@ -9,7 +9,7 @@ m20220909_commands :: Query
m20220909_commands =
[sql|
CREATE TABLE commands (
command_id INTEGER PRIMARY KEY, -- used as ACorrId
command_id INTEGER PRIMARY KEY AUTOINCREMENT, -- used as ACorrId
connection_id INTEGER REFERENCES connections ON DELETE CASCADE,
command_function TEXT NOT NULL,
command_status TEXT NOT NULL,
src/Simplex/Chat/Migrations/chat_schema.sql
+2 -1
View File
@@ -403,7 +403,7 @@ CREATE INDEX idx_chat_items_contacts ON chat_items(
chat_item_id
);
CREATE TABLE commands(
command_id INTEGER PRIMARY KEY, -- used as ACorrId
command_id INTEGER PRIMARY KEY AUTOINCREMENT, -- used as ACorrId
connection_id INTEGER REFERENCES connections ON DELETE CASCADE,
command_function TEXT NOT NULL,
command_status TEXT NOT NULL,
@@ -411,3 +411,4 @@ CREATE TABLE commands(
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
);
CREATE TABLE sqlite_sequence(name,seq);
src/Simplex/Chat/Store.hs
+5
View File
@@ -179,6 +179,7 @@ module Simplex.Chat.Store
getCalls,
createCommand,
setCommandConnId,
deleteCommand,
updateCommandStatus,
getCommandDataByCorrId,
setConnConnReqInv,
@@ -3919,6 +3920,10 @@ setCommandConnId db User {userId} cmdId connId = do
|]
(connId, updatedAt, userId, cmdId)
deleteCommand :: DB.Connection -> User -> CommandId -> IO ()
deleteCommand db User {userId} cmdId =
DB.execute db "DELETE FROM commands WHERE user_id = ? AND command_id = ?" (userId, cmdId)
updateCommandStatus :: DB.Connection -> User -> CommandId -> CommandStatus -> IO ()
updateCommandStatus db User {userId} cmdId status = do
updatedAt <- getCurrentTime
src/Simplex/Chat/Types.hs
+4 -1
View File
@@ -926,7 +926,8 @@ commandId = unpack
data CommandStatus
= CSCreated
| CSCompleted
| CSCompleted -- unused - was replaced with deleteCommand
| CSError -- internal command error, e.g. not matching connection id or unexpected response, not related to agent message ERR
deriving (Show, Generic)
instance FromField CommandStatus where fromField = fromTextField_ textDecode
@@ -937,10 +938,12 @@ instance TextEncoding CommandStatus where
textDecode = \case
"created" -> Just CSCreated
"completed" -> Just CSCompleted
"error" -> Just CSError
_ -> Nothing
textEncode = \case
CSCreated -> "created"
CSCompleted -> "completed"
CSError -> "error"
data CommandFunction
= CFCreateConn