diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index e259629d2b..77fac9ddc2 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -1550,8 +1550,8 @@ processChatCommand' vr = \case let chatV = agentToChatVersion agentV dm <- encodeConnInfoPQ pqSup' chatV $ XInfo profileToSend connId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup' - conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnJoined (incognitoProfile $> profileToSend) subMode chatV pqSup' - void . withAgent $ \a -> joinConnection a (aUserId user) (Just connId) True cReq dm pqSup' subMode + conn@PendingContactConnection {pccConnId} <- withStore' $ \db -> createDirectConnection db user connId cReq ConnJoined (incognitoProfile $> profileToSend) subMode chatV pqSup' + joinPreparedAgentConnection user pccConnId connId cReq dm pqSup' subMode pure $ CRSentConfirmation user conn APIConnect userId incognito (Just (ACR SCMContact cReq)) -> withUserId userId $ \user -> connectViaContact user incognito cReq APIConnect _ _ Nothing -> throwChatError CEInvalidConnReq @@ -1806,12 +1806,20 @@ processChatCommand' vr = \case dm <- encodeConnInfo $ XGrpAcpt membershipMemId agentConnId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True connRequest PQSupportOff let chatV = vr `peerConnChatVersion` peerChatVRange - withStore' $ \db -> do - createMemberConnection db userId fromMember agentConnId chatV peerChatVRange subMode + cId <- withStore' $ \db -> do + Connection {connId = cId} <- createMemberConnection db userId fromMember agentConnId chatV peerChatVRange subMode updateGroupMemberStatus db userId fromMember GSMemAccepted updateGroupMemberStatus db userId membership GSMemAccepted - void . withAgent $ \a -> joinConnection a (aUserId user) (Just agentConnId) True connRequest dm PQSupportOff subMode - updateCIGroupInvitationStatus user g CIGISAccepted `catchChatError` \_ -> pure () + pure cId + void (withAgent $ \a -> joinConnection a (aUserId user) (Just agentConnId) True connRequest dm PQSupportOff subMode) + `catchChatError` \e -> do + withStore' $ \db -> do + deleteConnectionRecord db user cId + updateGroupMemberStatus db userId fromMember GSMemInvited + updateGroupMemberStatus db userId membership GSMemInvited + withAgent $ \a -> deleteConnectionAsync a False agentConnId + throwError e + updateCIGroupInvitationStatus user g CIGISAccepted `catchChatError` (toView . CRChatError (Just user)) pure $ CRUserAcceptedGroupSent user g {membership = membership {memberStatus = GSMemAccepted}} Nothing Nothing -> throwChatError $ CEContactNotActive ct APIMemberRole groupId memberId memRole -> withUser $ \user -> do @@ -2338,8 +2346,8 @@ processChatCommand' vr = \case -- [incognito] generate profile to send incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing subMode <- chatReadVar subscriptionMode - conn <- withStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId incognitoProfile groupLinkId subMode chatV pqSup - joinContact user connId cReq incognitoProfile xContactId inGroup pqSup chatV + conn@PendingContactConnection {pccConnId} <- withStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId incognitoProfile groupLinkId subMode chatV pqSup + joinContact user pccConnId connId cReq incognitoProfile xContactId inGroup pqSup chatV pure $ CRSentInvitation user conn incognitoProfile connectContactViaAddress :: User -> IncognitoEnabled -> Contact -> ConnectionRequestUri 'CMContact -> CM ChatResponse connectContactViaAddress user incognito ct cReq = @@ -2351,8 +2359,8 @@ processChatCommand' vr = \case -- [incognito] generate profile to send incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing subMode <- chatReadVar subscriptionMode - ct' <- withStore $ \db -> createAddressContactConnection db vr user ct connId cReqHash newXContactId incognitoProfile subMode chatV pqSup - joinContact user connId cReq incognitoProfile newXContactId False pqSup chatV + (pccConnId, ct') <- withStore $ \db -> createAddressContactConnection db vr user ct connId cReqHash newXContactId incognitoProfile subMode chatV pqSup + joinContact user pccConnId connId cReq incognitoProfile newXContactId False pqSup chatV pure $ CRSentInvitationToContact user ct' incognitoProfile prepareContact :: User -> ConnectionRequestUri 'CMContact -> PQSupport -> CM (ConnId, VersionChat) prepareContact user cReq pqSup = do @@ -2365,12 +2373,19 @@ processChatCommand' vr = \case let chatV = agentToChatVersion agentV connId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup pure (connId, chatV) - joinContact :: User -> ConnId -> ConnectionRequestUri 'CMContact -> Maybe Profile -> XContactId -> Bool -> PQSupport -> VersionChat -> CM () - joinContact user connId cReq incognitoProfile xContactId inGroup pqSup chatV = do + joinContact :: User -> Int64 -> ConnId -> ConnectionRequestUri 'CMContact -> Maybe Profile -> XContactId -> Bool -> PQSupport -> VersionChat -> CM () + joinContact user pccConnId connId cReq incognitoProfile xContactId inGroup pqSup chatV = do let profileToSend = userProfileToSend user incognitoProfile Nothing inGroup dm <- encodeConnInfoPQ pqSup chatV (XContact profileToSend $ Just xContactId) subMode <- chatReadVar subscriptionMode - void . withAgent $ \a -> joinConnection a (aUserId user) (Just connId) True cReq dm pqSup subMode + joinPreparedAgentConnection user pccConnId connId cReq dm pqSup subMode + joinPreparedAgentConnection :: User -> Int64 -> ConnId -> ConnectionRequestUri m -> ByteString -> PQSupport -> SubscriptionMode -> CM () + joinPreparedAgentConnection user pccConnId connId cReq connInfo pqSup subMode = do + void (withAgent $ \a -> joinConnection a (aUserId user) (Just connId) True cReq connInfo pqSup subMode) + `catchChatError` \e -> do + withStore' $ \db -> deleteConnectionRecord db user pccConnId + withAgent $ \a -> deleteConnectionAsync a False connId + throwError e contactMember :: Contact -> [GroupMember] -> Maybe GroupMember contactMember Contact {contactId} = find $ \GroupMember {memberContactId = cId, memberStatus = s} -> diff --git a/src/Simplex/Chat/Store/Connections.hs b/src/Simplex/Chat/Store/Connections.hs index 1c3e949562..0d085d216c 100644 --- a/src/Simplex/Chat/Store/Connections.hs +++ b/src/Simplex/Chat/Store/Connections.hs @@ -14,6 +14,7 @@ module Simplex.Chat.Store.Connections getContactConnEntityByConnReqHash, getConnectionsToSubscribe, unsetConnectionToSubscribe, + deleteConnectionRecord, ) where @@ -225,3 +226,7 @@ getConnectionsToSubscribe db vr = do unsetConnectionToSubscribe :: DB.Connection -> IO () unsetConnectionToSubscribe db = DB.execute_ db "UPDATE connections SET to_subscribe = 0 WHERE to_subscribe = 1" + +deleteConnectionRecord :: DB.Connection -> User -> Int64 -> IO () +deleteConnectionRecord db User {userId} cId = do + DB.execute db "DELETE FROM connections WHERE user_id = ? AND connection_id = ?" (userId, cId) diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index ecba9be7fa..afbd3f7960 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -130,11 +130,11 @@ deletePendingContactConnection db userId connId = |] (userId, connId, ConnContact) -createAddressContactConnection :: DB.Connection -> VersionRangeChat -> User -> Contact -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> SubscriptionMode -> VersionChat -> PQSupport -> ExceptT StoreError IO Contact +createAddressContactConnection :: DB.Connection -> VersionRangeChat -> User -> Contact -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> SubscriptionMode -> VersionChat -> PQSupport -> ExceptT StoreError IO (Int64, Contact) createAddressContactConnection db vr user@User {userId} Contact {contactId} acId cReqHash xContactId incognitoProfile subMode chatV pqSup = do PendingContactConnection {pccConnId} <- liftIO $ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile Nothing subMode chatV pqSup liftIO $ DB.execute db "UPDATE connections SET contact_id = ? WHERE connection_id = ?" (contactId, pccConnId) - getContact db vr user contactId + (pccConnId,) <$> getContact db vr user contactId createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> SubscriptionMode -> VersionChat -> PQSupport -> IO PendingContactConnection createConnReqConnection db userId acId cReqHash xContactId incognitoProfile groupLinkId subMode chatV pqSup = do diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 5e603a40c9..5efc915066 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -944,10 +944,10 @@ getMemberInvitation db User {userId} groupMemberId = fmap join . maybeFirstRow fromOnly $ DB.query db "SELECT sent_inv_queue_info FROM group_members WHERE group_member_id = ? AND user_id = ?" (groupMemberId, userId) -createMemberConnection :: DB.Connection -> UserId -> GroupMember -> ConnId -> VersionChat -> VersionRangeChat -> SubscriptionMode -> IO () +createMemberConnection :: DB.Connection -> UserId -> GroupMember -> ConnId -> VersionChat -> VersionRangeChat -> SubscriptionMode -> IO Connection createMemberConnection db userId GroupMember {groupMemberId} agentConnId chatV peerChatVRange subMode = do currentTs <- getCurrentTime - void $ createMemberConnection_ db userId groupMemberId agentConnId chatV peerChatVRange Nothing 0 currentTs subMode + createMemberConnection_ db userId groupMemberId agentConnId chatV peerChatVRange Nothing 0 currentTs subMode createMemberConnectionAsync :: DB.Connection -> User -> GroupMemberId -> (CommandId, ConnId) -> VersionChat -> VersionRangeChat -> SubscriptionMode -> IO () createMemberConnectionAsync db user@User {userId} groupMemberId (cmdId, agentConnId) chatV peerChatVRange subMode = do diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 08980f21d2..671706c5f2 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -388,9 +388,9 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe CRAgentConnDeleted acId -> ["completed deleting connection, agent connection id: " <> sShow acId | logLevel <= CLLInfo] CRAgentUserDeleted auId -> ["completed deleting user" <> if logLevel <= CLLInfo then ", agent user id: " <> sShow auId else ""] CRMessageError u prefix err -> ttyUser u [plain prefix <> ": " <> plain err | prefix == "error" || logLevel <= CLLWarning] - CRChatCmdError u e -> ttyUserPrefix' u $ viewChatError logLevel testView e - CRChatError u e -> ttyUser' u $ viewChatError logLevel testView e - CRChatErrors u errs -> ttyUser' u $ concatMap (viewChatError logLevel testView) errs + CRChatCmdError u e -> ttyUserPrefix' u $ viewChatError True logLevel testView e + CRChatError u e -> ttyUser' u $ viewChatError False logLevel testView e + CRChatErrors u errs -> ttyUser' u $ concatMap (viewChatError False logLevel testView) errs CRArchiveImported archiveErrs -> if null archiveErrs then ["ok"] else ["archive import errors: " <> plain (show archiveErrs)] CRAppSettings as -> ["app settings: " <> plain (LB.unpack $ J.encode as)] CRTimedAction _ _ -> [] @@ -1894,8 +1894,8 @@ viewRemoteCtrl CtrlAppInfo {deviceName, appVersionRange = AppVersionRange _ (App | otherwise = "" showCompatible = if compatible then "" else ", " <> bold' "not compatible" -viewChatError :: ChatLogLevel -> Bool -> ChatError -> [StyledString] -viewChatError logLevel testView = \case +viewChatError :: Bool -> ChatLogLevel -> Bool -> ChatError -> [StyledString] +viewChatError isCmd logLevel testView = \case ChatError err -> case err of CENoActiveUser -> ["error: active user is required"] CENoConnectionUser agentConnId -> ["error: message user not found, conn id: " <> sShow agentConnId | logLevel <= CLLError] @@ -2034,14 +2034,14 @@ viewChatError logLevel testView = \case <> "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" ] - BROKER _ NETWORK -> [] - BROKER _ TIMEOUT -> [] - AGENT A_DUPLICATE -> [withConnEntity <> "error: AGENT A_DUPLICATE" | logLevel == CLLDebug] - AGENT (A_PROHIBITED e) -> [withConnEntity <> "error: AGENT A_PROHIBITED, " <> plain e | logLevel <= CLLWarning] - CONN NOT_FOUND -> [withConnEntity <> "error: CONN NOT_FOUND" | logLevel <= CLLWarning] + BROKER _ NETWORK | not isCmd -> [] + BROKER _ TIMEOUT | not isCmd -> [] + AGENT A_DUPLICATE -> [withConnEntity <> "error: AGENT A_DUPLICATE" | logLevel == CLLDebug || isCmd] + AGENT (A_PROHIBITED e) -> [withConnEntity <> "error: AGENT A_PROHIBITED, " <> plain e | logLevel <= CLLWarning || isCmd] + CONN NOT_FOUND -> [withConnEntity <> "error: CONN NOT_FOUND" | logLevel <= CLLWarning || isCmd] CRITICAL restart e -> [plain $ "critical error: " <> e] <> ["please restart the app" | restart] INTERNAL e -> [plain $ "internal error: " <> e] - e -> [withConnEntity <> "smp agent error: " <> sShow e | logLevel <= CLLWarning] + e -> [withConnEntity <> "smp agent error: " <> sShow e | logLevel <= CLLWarning || isCmd] where withConnEntity = case entity_ of Just entity@(RcvDirectMsgConnection conn contact_) -> case contact_ of