option to auto-accept contact requests (#296)

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

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}

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

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

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