contact requests api (#244)

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

src/Simplex/Chat/Controller.hs

@@ -82,7 +82,8 @@ data ChatCommand
   | APIGetChat ChatType Int64
   | APIGetChatItems Int
   | APISendMessage ChatType Int64 MsgContent
-  | APIDeleteContact Int64
+  | APIDeleteChat ChatType Int64
+  | APIAcceptContact Int64
   | ChatHelp HelpSection
   | Welcome
   | AddContact
@@ -128,7 +129,7 @@ data ChatResponse
   | CRGroupMembers {group :: Group}
   | CRContactsList {contacts :: [Contact]}
   | CRUserContactLink {connReqContact :: ConnReqContact}
-  | CRContactRequestRejected {contactName :: ContactName} -- TODO
+  | CRContactRequestRejected {contactRequest :: UserContactRequest}
   | CRUserAcceptedGroupSent {groupInfo :: GroupInfo}
   | CRUserDeletedMember {groupInfo :: GroupInfo, member :: GroupMember}
   | CRGroupsList {groups :: [GroupInfo]}
@@ -145,8 +146,8 @@ data ChatResponse
   | CRContactDeleted {contact :: Contact}
   | CRUserContactLinkCreated {connReqContact :: ConnReqContact}
   | CRUserContactLinkDeleted
-  | CRReceivedContactRequest {contactName :: ContactName, profile :: Profile} -- TODO what is the entity here?
-  | CRAcceptingContactRequest {contactName :: ContactName} -- TODO
+  | CRReceivedContactRequest {contactRequest :: UserContactRequest}
+  | CRAcceptingContactRequest {contactRequest :: UserContactRequest}
   | CRLeftMemberUser {groupInfo :: GroupInfo}
   | CRGroupDeletedUser {groupInfo :: GroupInfo}
   | CRRcvFileAccepted {fileTransfer :: RcvFileTransfer, filePath :: FilePath}

src/Simplex/Chat/Messages.hs

@@ -36,7 +36,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, enumJSON, sumTypeJSON)
 import Simplex.Messaging.Protocol (MsgBody)
 
-data ChatType = CTDirect | CTGroup
+data ChatType = CTDirect | CTGroup | CTContactRequest
   deriving (Show, Generic)
 
 instance ToJSON ChatType where
@@ -46,12 +46,14 @@ instance ToJSON ChatType where
 data ChatInfo (c :: ChatType) where
   DirectChat :: Contact -> ChatInfo 'CTDirect
   GroupChat :: GroupInfo -> ChatInfo 'CTGroup
+  ContactRequest :: UserContactRequest -> ChatInfo 'CTContactRequest
 
 deriving instance Show (ChatInfo c)
 
 data JSONChatInfo
   = JCInfoDirect {contact :: Contact}
   | JCInfoGroup {groupInfo :: GroupInfo}
+  | JCIInfoContactRequest {contactRequest :: UserContactRequest}
   deriving (Generic)
 
 instance ToJSON JSONChatInfo where
@@ -66,6 +68,7 @@ jsonChatInfo :: ChatInfo c -> JSONChatInfo
 jsonChatInfo = \case
   DirectChat c -> JCInfoDirect c
   GroupChat g -> JCInfoGroup g
+  ContactRequest g -> JCIInfoContactRequest g
 
 data ChatItem (c :: ChatType) (d :: MsgDirection) = ChatItem
   { chatDir :: CIDirection c d,
@@ -250,6 +253,7 @@ aciContentJSON = \case
 data SChatType (c :: ChatType) where
   SCTDirect :: SChatType 'CTDirect
   SCTGroup :: SChatType 'CTGroup
+  SCTContactRequest :: SChatType 'CTContactRequest
 
 deriving instance Show (SChatType c)
 

src/Simplex/Chat/Store.hs

@@ -39,6 +39,7 @@ module Simplex.Chat.Store
     getUserContactLink,
     createContactRequest,
     getContactRequest,
+    getContactRequestIdByName,
     deleteContactRequest,
     createAcceptedContact,
     getLiveSndFileTransfers,
@@ -468,10 +469,12 @@ getUserContactLink st userId =
     connReq [Only cReq] = Right cReq
     connReq _ = Left SEUserContactLinkNotFound
 
-createContactRequest :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> InvitationId -> Profile -> m ContactName
+createContactRequest :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> InvitationId -> Profile -> m UserContactRequest
 createContactRequest st userId userContactId invId Profile {displayName, fullName} =
   liftIOEither . withTransaction st $ \db ->
-    withLocalDisplayName db userId displayName $ \ldn -> do
+    join <$> withLocalDisplayName db userId displayName (createContactRequest' db)
+  where
+    createContactRequest' db ldn = do
       DB.execute db "INSERT INTO contact_profiles (display_name, full_name) VALUES (?, ?)" (displayName, fullName)
       profileId <- insertedRowId db
       DB.execute
@@ -481,33 +484,58 @@ createContactRequest st userId userContactId invId Profile {displayName, fullNam
           (user_contact_link_id, agent_invitation_id, contact_profile_id, local_display_name, user_id) VALUES (?,?,?,?,?)
         |]
         (userContactId, invId, profileId, ldn, userId)
-      pure ldn
+      contactRequestId <- insertedRowId db
+      getContactRequest_ db userId contactRequestId
 
-getContactRequest :: StoreMonad m => SQLiteStore -> UserId -> ContactName -> m UserContactRequest
-getContactRequest st userId localDisplayName =
+getContactRequest :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> m UserContactRequest
+getContactRequest st userId contactRequestId =
   liftIOEither . withTransaction st $ \db ->
-    contactReq
-      <$> DB.query
-        db
-        [sql|
-          SELECT cr.contact_request_id, cr.agent_invitation_id, cr.user_contact_link_id,
-            c.agent_conn_id, cr.contact_profile_id
-          FROM contact_requests cr
-          JOIN connections c USING (user_contact_link_id)
-          WHERE cr.user_id = ?
-            AND cr.local_display_name = ?
-        |]
-        (userId, localDisplayName)
-  where
-    contactReq [(contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, profileId)] =
-      Right UserContactRequest {contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, profileId, localDisplayName}
-    contactReq _ = Left $ SEContactRequestNotFound localDisplayName
+    runExceptT $
+      ExceptT $ getContactRequest_ db userId contactRequestId
 
-deleteContactRequest :: MonadUnliftIO m => SQLiteStore -> UserId -> ContactName -> m ()
-deleteContactRequest st userId localDisplayName =
+getContactRequest_ :: DB.Connection -> UserId -> Int64 -> IO (Either StoreError UserContactRequest)
+getContactRequest_ db userId contactRequestId =
+  contactReq
+    <$> DB.query
+      db
+      [sql|
+        SELECT
+          cr.local_display_name, cr.agent_invitation_id, cr.user_contact_link_id,
+          c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name
+        FROM contact_requests cr
+        JOIN connections c USING (user_contact_link_id)
+        JOIN contact_profiles p USING (contact_profile_id)
+        WHERE cr.user_id = ?
+          AND cr.contact_request_id = ?
+      |]
+      (userId, contactRequestId)
+  where
+    contactReq :: [(ContactName, AgentInvId, Int64, AgentConnId, Int64, ContactName, Text)] -> Either StoreError UserContactRequest
+    contactReq [(localDisplayName, agentInvitationId, userContactLinkId, agentContactConnId, profileId, displayName, fullName)] = do
+      let profile = Profile {displayName, fullName}
+      Right UserContactRequest {contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, localDisplayName, profileId, profile}
+    contactReq _ = Left $ SEContactRequestNotFound contactRequestId
+
+getContactRequestIdByName :: StoreMonad m => SQLiteStore -> UserId -> ContactName -> m Int64
+getContactRequestIdByName st userId cName =
+  liftIOEither . withTransaction st $ \db ->
+    firstRow fromOnly (SEContactRequestNotFoundByName cName) $
+      DB.query db "SELECT contact_request_id FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, cName)
+
+deleteContactRequest :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> m ()
+deleteContactRequest st userId contactRequestId =
   liftIO . withTransaction st $ \db -> do
-    DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
-    DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
+    DB.execute
+      db
+      [sql|
+        DELETE FROM display_names
+        WHERE user_id = ? AND local_display_name = (
+          SELECT local_display_name FROM contact_requests
+          WHERE user_id = ? AND contact_request_id = ?
+        )
+      |]
+      (userId, userId, contactRequestId)
+    DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?" (userId, contactRequestId)
 
 createAcceptedContact :: MonadUnliftIO m => SQLiteStore -> UserId -> ConnId -> ContactName -> Int64 -> m ()
 createAcceptedContact st userId agentConnId localDisplayName profileId =
@@ -2131,7 +2159,8 @@ data StoreError
   | SEContactNotReady {contactName :: ContactName}
   | SEDuplicateContactLink
   | SEUserContactLinkNotFound
-  | SEContactRequestNotFound {contactName :: ContactName}
+  | SEContactRequestNotFound {contactRequestId :: Int64}
+  | SEContactRequestNotFoundByName {contactName :: ContactName}
   | SEGroupNotFound {groupId :: Int64}
   | SEGroupNotFoundByName {groupName :: GroupName}
   | SEGroupWithoutUser

src/Simplex/Chat/Types.hs

@@ -93,13 +93,17 @@ data UserContact = UserContact
 
 data UserContactRequest = UserContactRequest
   { contactRequestId :: Int64,
-    agentInvitationId :: InvitationId,
+    agentInvitationId :: AgentInvId,
     userContactLinkId :: Int64,
-    agentContactConnId :: ConnId,
+    agentContactConnId :: AgentConnId, -- connection id of user contact
     localDisplayName :: ContactName,
-    profileId :: Int64
+    profileId :: Int64,
+    profile :: Profile
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON UserContactRequest where
+  toEncoding = J.genericToEncoding J.defaultOptions
 
 type ContactName = Text
 
@@ -517,6 +521,25 @@ instance FromField AgentConnId where fromField f = AgentConnId <$> fromField f
 
 instance ToField AgentConnId where toField (AgentConnId m) = toField m
 
+newtype AgentInvId = AgentInvId InvitationId
+  deriving (Eq, Show)
+
+instance StrEncoding AgentInvId where
+  strEncode (AgentInvId connId) = strEncode connId
+  strDecode s = AgentInvId <$> strDecode s
+  strP = AgentInvId <$> strP
+
+instance FromJSON AgentInvId where
+  parseJSON = strParseJSON "AgentInvId"
+
+instance ToJSON AgentInvId where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
+
+instance FromField AgentInvId where fromField f = AgentInvId <$> fromField f
+
+instance ToField AgentInvId where toField (AgentInvId m) = toField m
+
 data FileTransfer = FTSnd {sndFileTransfers :: [SndFileTransfer]} | FTRcv RcvFileTransfer
   deriving (Show, Generic)
 

src/Simplex/Chat/View.hs

@@ -47,7 +47,7 @@ responseToView cmd = \case
   CRWelcome user -> r $ chatWelcome user
   CRContactsList cs -> r $ viewContactsList cs
   CRUserContactLink cReq -> r $ connReqContact_ "Your chat address:" cReq
-  CRContactRequestRejected c -> r [ttyContact c <> ": contact request rejected"]
+  CRContactRequestRejected UserContactRequest {localDisplayName = c} -> r [ttyContact c <> ": contact request rejected"]
   CRGroupCreated g -> r $ viewGroupCreated g
   CRGroupMembers g -> r $ viewGroupMembers g
   CRGroupsList gs -> r $ viewGroupsList gs
@@ -61,7 +61,7 @@ responseToView cmd = \case
   CRSentConfirmation -> r' ["confirmation sent!"]
   CRSentInvitation -> r' ["connection request sent!"]
   CRContactDeleted Contact {localDisplayName} -> r' [ttyContact localDisplayName <> ": contact is deleted"]
-  CRAcceptingContactRequest c -> r' [ttyContact c <> ": accepting contact request..."]
+  CRAcceptingContactRequest UserContactRequest {localDisplayName = c} -> r' [ttyContact c <> ": accepting contact request..."]
   CRUserContactLinkCreated cReq -> r' $ connReqContact_ "Your new chat address is created!" cReq
   CRUserContactLinkDeleted -> r' viewUserContactLinkDeleted
   CRUserAcceptedGroupSent _g -> r' [] -- [ttyGroup' g <> ": joining the group..."]
@@ -76,7 +76,7 @@ responseToView cmd = \case
   CRUserProfileUpdated p p' -> r' $ viewUserProfileUpdated p p'
   CRContactUpdated c c' -> viewContactUpdated c c'
   CRContactsMerged intoCt mergedCt -> viewContactsMerged intoCt mergedCt
-  CRReceivedContactRequest c p -> viewReceivedContactRequest c p
+  CRReceivedContactRequest UserContactRequest {localDisplayName = c, profile} -> viewReceivedContactRequest c profile
   CRRcvFileStart ft -> receivingFile_ "started" ft
   CRRcvFileComplete ft -> receivingFile_ "completed" ft
   CRRcvFileSndCancelled ft -> viewRcvFileSndCancelled ft
@@ -479,7 +479,7 @@ viewChatError = \case
     SERcvFileNotFound fileId -> fileNotFound fileId
     SEDuplicateContactLink -> ["you already have chat address, to show: " <> highlight' "/sa"]
     SEUserContactLinkNotFound -> ["no chat address, to create: " <> highlight' "/ad"]
-    SEContactRequestNotFound c -> ["no contact request from " <> ttyContact c]
+    SEContactRequestNotFoundByName c -> ["no contact request from " <> ttyContact c]
     e -> ["chat db error: " <> sShow e]
   ChatErrorAgent err -> case err of
     SMP SMP.AUTH -> ["error: this connection is deleted"]