From dc306dfcd0621decec6b726d688c1bbf62f8cca1 Mon Sep 17 00:00:00 2001 From: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com> Date: Mon, 14 Feb 2022 14:59:11 +0400 Subject: [PATCH] option to auto-accept contact requests (#296) --- src/Simplex/Chat.hs | 30 ++++++++----- src/Simplex/Chat/Controller.hs | 4 +- .../M20220210_deduplicate_contact_requests.hs | 2 + src/Simplex/Chat/Store.hs | 39 ++++++++++++---- src/Simplex/Chat/View.hs | 3 +- tests/ChatTests.hs | 45 +++++++++++++++++++ 6 files changed, 102 insertions(+), 21 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 1130fb594..035b1701e 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -179,13 +179,9 @@ processChatCommand = \case gs -> throwChatError $ CEContactGroups ct gs CTGroup -> pure $ chatCmdError "not implemented" CTContactRequest -> pure $ chatCmdError "not supported" - APIAcceptContact connReqId -> withUser $ \User {userId, profile} -> withChatLock $ do - UserContactRequest {agentInvitationId = AgentInvId invId, localDisplayName = cName, profileId, profile = p, xContactId} <- - withStore $ \st -> getContactRequest st userId connReqId - procCmd $ do - connId <- withAgent $ \a -> acceptContact a invId . directMessage $ XInfo profile - acceptedContact <- withStore $ \st -> createAcceptedContact st userId connId cName profileId p xContactId - pure $ CRAcceptingContactRequest acceptedContact + APIAcceptContact connReqId -> withUser $ \user@User {userId} -> withChatLock $ do + cReq <- withStore $ \st -> getContactRequest st userId connReqId + procCmd $ CRAcceptingContactRequest <$> acceptContactRequest user cReq APIRejectContact connReqId -> withUser $ \User {userId} -> withChatLock $ do cReq@UserContactRequest {agentContactConnId = AgentConnId connId, agentInvitationId = AgentInvId invId} <- withStore $ \st -> @@ -223,7 +219,10 @@ processChatCommand = \case deleteConnection a (aConnId conn) `catchError` \(_ :: AgentErrorType) -> pure () withStore $ \st -> deleteUserContactLink st userId pure CRUserContactLinkDeleted - ShowMyAddress -> CRUserContactLink <$> withUser (\User {userId} -> withStore (`getUserContactLink` userId)) + ShowMyAddress -> withUser $ \User {userId} -> + uncurry CRUserContactLink <$> withStore (`getUserContactLink` userId) + AddressAutoAccept onOff -> withUser $ \User {userId} -> do + uncurry CRUserContactLinkUpdated <$> withStore (\st -> updateUserContactLinkAutoAccept st userId onOff) AcceptContact cName -> withUser $ \User {userId} -> do connReqId <- withStore $ \st -> getContactRequestIdByName st userId cName processChatCommand $ APIAcceptContact connReqId @@ -445,6 +444,11 @@ processChatCommand = \case f = filePath `combine` (name <> suffix <> ext) in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f) +acceptContactRequest :: ChatMonad m => User -> UserContactRequest -> m Contact +acceptContactRequest User {userId, profile} UserContactRequest {agentInvitationId = AgentInvId invId, localDisplayName = cName, profileId, profile = p, xContactId} = do + connId <- withAgent $ \a -> acceptContact a invId . directMessage $ XInfo profile + withStore $ \st -> createAcceptedContact st userId connId cName profileId p xContactId + agentSubscriber :: (MonadUnliftIO m, MonadReader ChatController m) => User -> m () agentSubscriber user = do q <- asks $ subQ . smpAgent @@ -833,8 +837,12 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage withStore (\st -> createOrUpdateContactRequest st userId userContactLinkId invId p xContactId_) >>= \case Left contact -> toView $ CRContactRequestAlreadyAccepted contact Right cReq@UserContactRequest {localDisplayName} -> do - toView $ CRReceivedContactRequest cReq - showToast (localDisplayName <> "> ") "wants to connect to you" + (_, autoAccept) <- withStore $ \st -> getUserContactLink st userId + if autoAccept + then acceptContactRequest user cReq >>= toView . CRAcceptingContactRequest + else do + toView $ CRReceivedContactRequest cReq + showToast (localDisplayName <> "> ") "wants to connect to you" withAckMessage :: ConnId -> MsgMeta -> m () -> m () withAckMessage cId MsgMeta {recipient = (msgId, _)} action = @@ -1440,6 +1448,7 @@ chatCommandP = <|> ("/address" <|> "/ad") $> CreateMyAddress <|> ("/delete_address" <|> "/da") $> DeleteMyAddress <|> ("/show_address" <|> "/sa") $> ShowMyAddress + <|> "/auto_accept " *> (AddressAutoAccept <$> onOffP) <|> ("/accept @" <|> "/accept " <|> "/ac @" <|> "/ac ") *> (AcceptContact <$> displayName) <|> ("/reject @" <|> "/reject " <|> "/rc @" <|> "/rc ") *> (RejectContact <$> displayName) <|> ("/markdown" <|> "/m") $> ChatHelp HSMarkdown @@ -1457,6 +1466,7 @@ chatCommandP = msgContentP = "text " *> (MCText . safeDecodeUtf8 <$> A.takeByteString) displayName = safeDecodeUtf8 <$> (B.cons <$> A.satisfy refChar <*> A.takeTill (== ' ')) refChar c = c > ' ' && c /= '#' && c /= '@' + onOffP = ("on" $> True) <|> ("off" $> False) userProfile = do cName <- displayName fullName <- fullNameP cName diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 9fcabae5e..9d3175f1d 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -103,6 +103,7 @@ data ChatCommand | CreateMyAddress | DeleteMyAddress | ShowMyAddress + | AddressAutoAccept Bool | AcceptContact ContactName | RejectContact ContactName | SendMessage ContactName ByteString @@ -142,7 +143,8 @@ data ChatResponse | CRGroupCreated {groupInfo :: GroupInfo} | CRGroupMembers {group :: Group} | CRContactsList {contacts :: [Contact]} - | CRUserContactLink {connReqContact :: ConnReqContact} + | CRUserContactLink {connReqContact :: ConnReqContact, autoAccept :: Bool} + | CRUserContactLinkUpdated {connReqContact :: ConnReqContact, autoAccept :: Bool} | CRContactRequestRejected {contactRequest :: UserContactRequest} | CRUserAcceptedGroupSent {groupInfo :: GroupInfo} | CRUserDeletedMember {groupInfo :: GroupInfo, member :: GroupMember} diff --git a/src/Simplex/Chat/Migrations/M20220210_deduplicate_contact_requests.hs b/src/Simplex/Chat/Migrations/M20220210_deduplicate_contact_requests.hs index 0f55c9553..e2c26e35e 100644 --- a/src/Simplex/Chat/Migrations/M20220210_deduplicate_contact_requests.hs +++ b/src/Simplex/Chat/Migrations/M20220210_deduplicate_contact_requests.hs @@ -20,4 +20,6 @@ CREATE INDEX idx_contact_requests_xcontact_id ON contact_requests (xcontact_id); ALTER TABLE contacts ADD COLUMN xcontact_id BLOB; CREATE INDEX idx_contacts_xcontact_id ON contacts (xcontact_id); + +ALTER TABLE user_contact_links ADD column auto_accept INTEGER DEFAULT 0; |] diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index b857dd9f6..16f125753 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -40,6 +40,7 @@ module Simplex.Chat.Store getUserContactLinkConnections, deleteUserContactLink, getUserContactLink, + updateUserContactLinkAutoAccept, createOrUpdateContactRequest, getContactRequest, getContactRequestIdByName, @@ -555,22 +556,42 @@ deleteUserContactLink st userId = [":user_id" := userId] DB.execute db "DELETE FROM user_contact_links WHERE user_id = ? AND local_display_name = ''" (Only userId) -getUserContactLink :: StoreMonad m => SQLiteStore -> UserId -> m ConnReqContact +getUserContactLink :: StoreMonad m => SQLiteStore -> UserId -> m (ConnReqContact, Bool) getUserContactLink st userId = liftIOEither . withTransaction st $ \db -> - connReq - <$> DB.query + getUserContactLink_ db userId + +getUserContactLink_ :: DB.Connection -> UserId -> IO (Either StoreError (ConnReqContact, Bool)) +getUserContactLink_ db userId = + firstRow id SEUserContactLinkNotFound $ + DB.query + db + [sql| + SELECT conn_req_contact, auto_accept + FROM user_contact_links + WHERE user_id = ? + AND local_display_name = '' + |] + (Only userId) + +updateUserContactLinkAutoAccept :: StoreMonad m => SQLiteStore -> UserId -> Bool -> m (ConnReqContact, Bool) +updateUserContactLinkAutoAccept st userId autoAccept = do + liftIOEither . withTransaction st $ \db -> runExceptT $ do + (cReqUri, _) <- ExceptT $ getUserContactLink_ db userId + liftIO $ updateUserContactLinkAutoAccept_ db + pure (cReqUri, autoAccept) + where + updateUserContactLinkAutoAccept_ :: DB.Connection -> IO () + updateUserContactLinkAutoAccept_ db = + DB.execute db [sql| - SELECT conn_req_contact - FROM user_contact_links + UPDATE user_contact_links + SET auto_accept = ? WHERE user_id = ? AND local_display_name = '' |] - (Only userId) - where - connReq [Only cReq] = Right cReq - connReq _ = Left SEUserContactLinkNotFound + (autoAccept, userId) createOrUpdateContactRequest :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> InvitationId -> Profile -> Maybe XContactId -> m (Either Contact UserContactRequest) createOrUpdateContactRequest st userId userContactLinkId invId profile xContactId_ = diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 800b646d7..01e697dc6 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -51,7 +51,8 @@ responseToView cmd testView = \case HSMarkdown -> r markdownInfo CRWelcome user -> r $ chatWelcome user CRContactsList cs -> r $ viewContactsList cs - CRUserContactLink cReq -> r $ connReqContact_ "Your chat address:" cReq + CRUserContactLink cReqUri _ -> r $ connReqContact_ "Your chat address:" cReqUri + CRUserContactLinkUpdated _ autoAccept -> r ["auto_accept " <> if autoAccept then "on" else "off"] CRContactRequestRejected UserContactRequest {localDisplayName = c} -> r [ttyContact c <> ": contact request rejected"] CRGroupCreated g -> r $ viewGroupCreated g CRGroupMembers g -> r $ viewGroupMembers g diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index 6fbc627aa..9e7ecb140 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -52,6 +52,7 @@ chatTests = do it "send and receive file to group" testGroupFileTransfer describe "user contact link" $ do it "should create and connect via contact link" testUserContactLink + it "should auto accept contact requests" testUserContactLinkAutoAccept it "should deduplicate contact requests" testDeduplicateContactRequests it "should deduplicate contact requests with profile change" testDeduplicateContactRequestsProfileChange it "should reject contact and delete contact link" testRejectContactAndDeleteUserContact @@ -720,6 +721,50 @@ testUserContactLink = testChat3 aliceProfile bobProfile cathProfile $ alice #$$> ("/_get chats", [("@cath", ""), ("@bob", "hey")]) alice <##> cath +testUserContactLinkAutoAccept :: IO () +testUserContactLinkAutoAccept = + testChat4 aliceProfile bobProfile cathProfile danProfile $ + \alice bob cath dan -> do + alice ##> "/ad" + cLink <- getContactLink alice True + + bob ##> ("/c " <> cLink) + alice <#? bob + alice #$$> ("/_get chats", [("<@bob", "")]) + alice ##> "/ac bob" + alice <## "bob (Bob): accepting contact request..." + concurrently_ + (bob <## "alice (Alice): contact is connected") + (alice <## "bob (Bob): contact is connected") + alice #$$> ("/_get chats", [("@bob", "")]) + alice <##> bob + + alice ##> "/auto_accept on" + alice <## "auto_accept on" + + cath ##> ("/c " <> cLink) + cath <## "connection request sent!" + alice <## "cath (Catherine): accepting contact request..." + concurrently_ + (cath <## "alice (Alice): contact is connected") + (alice <## "cath (Catherine): contact is connected") + alice #$$> ("/_get chats", [("@cath", ""), ("@bob", "hey")]) + alice <##> cath + + alice ##> "/auto_accept off" + alice <## "auto_accept off" + + dan ##> ("/c " <> cLink) + alice <#? dan + alice #$$> ("/_get chats", [("<@dan", ""), ("@cath", "hey"), ("@bob", "hey")]) + alice ##> "/ac dan" + alice <## "dan (Daniel): accepting contact request..." + concurrently_ + (dan <## "alice (Alice): contact is connected") + (alice <## "dan (Daniel): contact is connected") + alice #$$> ("/_get chats", [("@dan", ""), ("@cath", "hey"), ("@bob", "hey")]) + alice <##> dan + testDeduplicateContactRequests :: IO () testDeduplicateContactRequests = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do