IntenseFinance/simplex-chat
3
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

option to auto-accept contact requests (#296)

Browse Source
This commit is contained in:
Efim Poberezkin 2022-02-14 14:59:11 +04:00 committed by GitHub
parent e90520a5ec
commit dc306dfcd0
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
6 changed files with 102 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
src/Simplex/Chat.hs
View File

@ -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

4
src/Simplex/Chat/Controller.hs
View File

@ -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}

2
src/Simplex/Chat/Migrations/M20220210_deduplicate_contact_requests.hs
View File

@ -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;
|]

39
src/Simplex/Chat/Store.hs
View File

@ -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_ =

3
src/Simplex/Chat/View.hs
View File

@ -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

45
tests/ChatTests.hs
View File

@ -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