option to auto-accept contact requests (#296)

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