core: fix createOrUpdateContactRequest logic (#650)

* core: fix createOrUpdateContactRequest logic

* remove do

* fix logic

* rename

* refactor

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>

src/Simplex/Chat.hs

@@ -1337,8 +1337,8 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
         profileContactRequest :: InvitationId -> Profile -> Maybe XContactId -> m ()
         profileContactRequest invId p xContactId_ = do
           withStore (\st -> createOrUpdateContactRequest st userId userContactLinkId invId p xContactId_) >>= \case
-            Left contact -> toView $ CRContactRequestAlreadyAccepted contact
-            Right cReq@UserContactRequest {localDisplayName} -> do
+            CORContact contact -> toView $ CRContactRequestAlreadyAccepted contact
+            CORRequest cReq@UserContactRequest {localDisplayName} -> do
               (_, autoAccept) <- withStore $ \st -> getUserContactLink st userId
               if autoAccept
                 then acceptContactRequest user cReq >>= toView . CRAcceptingContactRequest

src/Simplex/Chat/Store.hs

@@ -659,28 +659,30 @@ updateUserContactLinkAutoAccept st userId autoAccept = do
         |]
         (autoAccept, userId)
 
-createOrUpdateContactRequest :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> InvitationId -> Profile -> Maybe XContactId -> m (Either Contact UserContactRequest)
+createOrUpdateContactRequest :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> InvitationId -> Profile -> Maybe XContactId -> m ContactOrRequest
 createOrUpdateContactRequest st userId userContactLinkId invId profile xContactId_ =
   liftIOEither . withTransaction st $ \db ->
     createOrUpdateContactRequest_ db userId userContactLinkId invId profile xContactId_
 
-createOrUpdateContactRequest_ :: DB.Connection -> UserId -> Int64 -> InvitationId -> Profile -> Maybe XContactId -> IO (Either StoreError (Either Contact UserContactRequest))
+createOrUpdateContactRequest_ :: DB.Connection -> UserId -> Int64 -> InvitationId -> Profile -> Maybe XContactId -> IO (Either StoreError ContactOrRequest)
 createOrUpdateContactRequest_ db userId userContactLinkId invId Profile {displayName, fullName, image} xContactId_ =
   maybeM getContact' xContactId_ >>= \case
-    Just contact -> pure . Right $ Left contact
-    Nothing -> Right <$$> createOrUpdate_
+    Just contact -> pure . Right $ CORContact contact
+    Nothing -> CORRequest <$$> createOrUpdate_
   where
     maybeM = maybe (pure Nothing)
     createOrUpdate_ :: IO (Either StoreError UserContactRequest)
-    createOrUpdate_ =
-      maybeM getContactRequest' xContactId_ >>= \case
-        Nothing -> createContactRequest
-        Just UserContactRequest {contactRequestId, profile = oldProfile} ->
-          updateContactRequest contactRequestId oldProfile
-    createContactRequest :: IO (Either StoreError UserContactRequest)
+    createOrUpdate_ = runExceptT $ do
+      cReqId <-
+        ExceptT $
+          maybeM getContactRequest' xContactId_ >>= \case
+            Nothing -> createContactRequest
+            Just cr -> updateContactRequest cr $> Right (contactRequestId (cr :: UserContactRequest))
+      ExceptT $ getContactRequest_ db userId cReqId
+    createContactRequest :: IO (Either StoreError Int64)
     createContactRequest = do
       currentTs <- getCurrentTime
-      join <$> withLocalDisplayName db userId displayName (createContactRequest_ currentTs)
+      withLocalDisplayName db userId displayName (createContactRequest_ currentTs)
       where
         createContactRequest_ currentTs ldn = do
           DB.execute
@@ -696,8 +698,7 @@ createOrUpdateContactRequest_ db userId userContactLinkId invId Profile {display
               VALUES (?,?,?,?,?,?,?,?)
             |]
             (userContactLinkId, invId, profileId, ldn, userId, currentTs, currentTs, xContactId_)
-          contactRequestId <- insertedRowId db
-          getContactRequest_ db userId contactRequestId
+          insertedRowId db
     getContact' :: XContactId -> IO (Maybe Contact)
     getContact' xContactId =
       fmap toContact . listToMaybe
@@ -735,14 +736,17 @@ createOrUpdateContactRequest_ db userId userContactLinkId invId Profile {display
             LIMIT 1
           |]
           (userId, xContactId)
-    updateContactRequest :: Int64 -> Profile -> IO (Either StoreError UserContactRequest)
-    updateContactRequest cReqId Profile {displayName = oldDisplayName} = do
+    updateContactRequest :: UserContactRequest -> IO (Either StoreError ())
+    updateContactRequest UserContactRequest {contactRequestId = cReqId, localDisplayName = oldLdn, profile = Profile {displayName = oldDisplayName}} = do
       currentTs <- liftIO getCurrentTime
+      updateProfile currentTs
       if displayName == oldDisplayName
-        then updateContactRequest_ currentTs displayName
-        else join <$> withLocalDisplayName db userId displayName (updateContactRequest_ currentTs)
+        then Right <$> DB.execute db "UPDATE contact_requests SET agent_invitation_id = ?, updated_at = ? WHERE user_id = ? AND contact_request_id = ?" (invId, currentTs, userId, cReqId)
+        else withLocalDisplayName db userId displayName $ \ldn -> do
+          DB.execute db "UPDATE contact_requests SET agent_invitation_id = ?, local_display_name = ?, updated_at = ? WHERE user_id = ? AND contact_request_id = ?" (invId, ldn, currentTs, userId, cReqId)
+          DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (oldLdn, userId)
       where
-        updateContactRequest_ updatedAt ldn = do
+        updateProfile currentTs =
           DB.execute
             db
             [sql|
@@ -758,19 +762,7 @@ createOrUpdateContactRequest_ db userId userContactLinkId invId Profile {display
                   AND contact_request_id = ?
               )
             |]
-            (ldn, fullName, image, updatedAt, userId, cReqId)
-          DB.execute
-            db
-            [sql|
-              UPDATE contact_requests
-              SET agent_invitation_id = ?,
-                  local_display_name = ?,
-                  updated_at = ?
-              WHERE user_id = ?
-                AND contact_request_id = ?
-            |]
-            (invId, ldn, updatedAt, userId, cReqId)
-          getContactRequest_ db userId cReqId
+            (displayName, fullName, image, currentTs, userId, cReqId)
 
 getContactRequest :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> m UserContactRequest
 getContactRequest st userId contactRequestId =

src/Simplex/Chat/Types.hs

@@ -155,6 +155,8 @@ instance ToJSON ConnReqUriHash where
   toJSON = strToJSON
   toEncoding = strToJEncoding
 
+data ContactOrRequest = CORContact Contact | CORRequest UserContactRequest
+
 type ContactName = Text
 
 type GroupName = Text