diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index a790e66b8e..360b10fdb2 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -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 diff --git a/src/Simplex/Chat/Migrations/M20220909_commands.hs b/src/Simplex/Chat/Migrations/M20220909_commands.hs index 73e5d5bc6e..745dff4165 100644 --- a/src/Simplex/Chat/Migrations/M20220909_commands.hs +++ b/src/Simplex/Chat/Migrations/M20220909_commands.hs @@ -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, diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index f1e589bc9f..69d7e84eb1 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -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); diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index e9e8c826ea..4326b9b6cc 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -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 diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 3e1df4464c..8ddf06feae 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -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