delete contact api (#243)

* delete contact api * chat command
2026-05-24 04:25:43 +00:00 · 2022-01-31 15:14:56 +04:00
parent 945ed3f7cb
commit 047aa7deef
4 changed files with 40 additions and 48 deletions
@@ -141,6 +141,18 @@ processChatCommand user@User {userId, profile} = \case
      ci <- sendGroupChatItem userId group (XMsgNew mc) (CISndMsgContent mc)
      setActive $ ActiveG gName
      pure . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci
+  APIDeleteContact contactId -> do
+    ct@Contact {localDisplayName} <- withStore $ \st -> getContact st userId contactId
+    withStore (\st -> getContactGroupNames st userId ct) >>= \case
+      [] -> do
+        conns <- withStore $ \st -> getContactConnections st userId ct
+        procCmd $ do
+          withAgent $ \a -> forM_ conns $ \conn ->
+            deleteConnection a (aConnId conn) `catchError` \(_ :: AgentErrorType) -> pure ()
+          withStore $ \st -> deleteContact st userId ct
+          unsetActive $ ActiveC localDisplayName
+          pure $ CRContactDeleted ct
+      gs -> throwChatError $ CEContactGroups ct gs
  ChatHelp section -> pure $ CRChatHelp section
  Welcome -> pure $ CRWelcome user
  AddContact -> procCmd $ do
@@ -157,17 +169,9 @@ processChatCommand user@User {userId, profile} = \case
  ConnectAdmin -> procCmd $ do
    connect adminContactReq $ XContact profile Nothing
    pure CRSentInvitation
-  DeleteContact cName ->
-    withStore (\st -> getContactGroupNames st userId cName) >>= \case
-      [] -> do
-        conns <- withStore $ \st -> getContactConnections st userId cName
-        procCmd $ do
-          withAgent $ \a -> forM_ conns $ \conn ->
-            deleteConnection a (aConnId conn) `catchError` \(_ :: AgentErrorType) -> pure ()
-          withStore $ \st -> deleteContact st userId cName
-          unsetActive $ ActiveC cName
-          pure $ CRContactDeleted cName
-      gs -> throwChatError $ CEContactGroups cName gs
+  DeleteContact cName -> do
+    contactId <- withStore $ \st -> getContactIdByName st userId cName
+    processChatCommand user $ APIDeleteContact contactId
  ListContacts -> CRContactsList <$> withStore (`getUserContacts` user)
  CreateMyAddress -> procCmd $ do
    (connId, cReq) <- withAgent (`createConnection` SCMContact)
@@ -1307,6 +1311,7 @@ chatCommandP =
    <|> "/get chat " *> (APIGetChat <$> chatTypeP <*> A.decimal)
    <|> "/get chatItems count=" *> (APIGetChatItems <$> A.decimal)
    <|> "/send msg " *> (APISendMessage <$> chatTypeP <*> A.decimal <* A.space <*> msgContentP)
+    <|> "/_del @" *> (APIDeleteContact <$> A.decimal)
    <|> ("/help files" <|> "/help file" <|> "/hf") $> ChatHelp HSFiles
    <|> ("/help groups" <|> "/help group" <|> "/hg") $> ChatHelp HSGroups
    <|> ("/help address" <|> "/ha") $> ChatHelp HSMyAddress
@@ -82,6 +82,7 @@ data ChatCommand
  | APIGetChat ChatType Int64
  | APIGetChatItems Int
  | APISendMessage ChatType Int64 MsgContent
+  | APIDeleteContact Int64
  | ChatHelp HelpSection
  | Welcome
  | AddContact
@@ -141,7 +142,7 @@ data ChatResponse
  | CRSentInvitation
  | CRContactUpdated {fromContact :: Contact, toContact :: Contact}
  | CRContactsMerged {intoContact :: Contact, mergedContact :: Contact}
-  | CRContactDeleted {contactName :: ContactName} -- TODO
+  | CRContactDeleted {contact :: Contact}
  | CRUserContactLinkCreated {connReqContact :: ConnReqContact}
  | CRUserContactLinkDeleted
  | CRReceivedContactRequest {contactName :: ContactName, profile :: Profile} -- TODO what is the entity here?
@@ -207,7 +208,7 @@ instance ToJSON ChatError where
 data ChatErrorType
  = CEGroupUserRole
  | CEInvalidConnReq
-  | CEContactGroups {contactName :: ContactName, groupNames :: [GroupName]}
+  | CEContactGroups {contact :: Contact, groupNames :: [GroupName]}
  | CEGroupContactRole {contactName :: ContactName}
  | CEGroupDuplicateMember {contactName :: ContactName}
  | CEGroupDuplicateMemberId
@@ -268,8 +268,8 @@ createContact_ db userId connId Profile {displayName, fullName} viaGroup =
    DB.execute db "UPDATE connections SET contact_id = ? WHERE connection_id = ?" (contactId, connId)
    pure (ldn, contactId, profileId)

-getContactGroupNames :: MonadUnliftIO m => SQLiteStore -> UserId -> ContactName -> m [GroupName]
-getContactGroupNames st userId displayName =
+getContactGroupNames :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> m [GroupName]
+getContactGroupNames st userId Contact {contactId} =
  liftIO . withTransaction st $ \db -> do
    map fromOnly
      <$> DB.query
@@ -278,38 +278,26 @@ getContactGroupNames st userId displayName =
          SELECT DISTINCT g.local_display_name
          FROM groups g
          JOIN group_members m ON m.group_id = g.group_id
-          WHERE g.user_id = ? AND m.local_display_name = ?
+          WHERE g.user_id = ? AND m.contact_id = ?
        |]
-        (userId, displayName)
+        (userId, contactId)

-deleteContact :: MonadUnliftIO m => SQLiteStore -> UserId -> ContactName -> m ()
-deleteContact st userId displayName =
+deleteContact :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> m ()
+deleteContact st userId Contact {contactId, localDisplayName} =
  liftIO . withTransaction st $ \db -> do
-    DB.executeNamed
+    DB.execute
      db
      [sql|
        DELETE FROM connections WHERE connection_id IN (
          SELECT connection_id
          FROM connections c
-          JOIN contacts cs ON c.contact_id = cs.contact_id
-          WHERE cs.user_id = :user_id AND cs.local_display_name = :display_name
+          JOIN contacts ct ON ct.contact_id = c.contact_id
+          WHERE ct.user_id = ? AND ct.contact_id = ?
        )
      |]
-      [":user_id" := userId, ":display_name" := displayName]
-    DB.executeNamed
-      db
-      [sql|
-        DELETE FROM contacts
-        WHERE user_id = :user_id AND local_display_name = :display_name
-      |]
-      [":user_id" := userId, ":display_name" := displayName]
-    DB.executeNamed
-      db
-      [sql|
-        DELETE FROM display_names
-        WHERE user_id = :user_id AND local_display_name = :display_name
-      |]
-      [":user_id" := userId, ":display_name" := displayName]
+      (userId, contactId)
+    DB.execute db "DELETE FROM contacts WHERE user_id = ? AND contact_id = ?" (userId, contactId)
+    DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)

 updateUserProfile :: StoreMonad m => SQLiteStore -> User -> Profile -> m ()
 updateUserProfile st User {userId, userContactId, localDisplayName, profile = Profile {displayName}} p'@Profile {displayName = newName}
@@ -594,24 +582,22 @@ getPendingConnections st User {userId} =
        |]
        [":user_id" := userId, ":conn_type" := ConnContact]

-getContactConnections :: StoreMonad m => SQLiteStore -> UserId -> ContactName -> m [Connection]
-getContactConnections st userId displayName =
+getContactConnections :: StoreMonad m => SQLiteStore -> UserId -> Contact -> m [Connection]
+getContactConnections st userId Contact {contactId} =
  liftIOEither . withTransaction st $ \db ->
    connections
-      <$> DB.queryNamed
+      <$> DB.query
        db
        [sql|
          SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
          FROM connections c
-          JOIN contacts cs ON c.contact_id = cs.contact_id
-          WHERE c.user_id = :user_id
-            AND cs.user_id = :user_id
-            AND cs.local_display_name = :display_name
+          JOIN contacts ct ON ct.contact_id = c.contact_id
+          WHERE c.user_id = ? AND ct.user_id = ? AND ct.contact_id = ?
        |]
-        [":user_id" := userId, ":display_name" := displayName]
+        (userId, userId, contactId)
  where
-    connections [] = Left $ SEContactNotFoundByName displayName
+    connections [] = Left $ SEContactNotFound contactId
    connections rows = Right $ map toConnection rows

 type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, ConnStatus, ConnType, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, UTCTime)
@@ -60,7 +60,7 @@ responseToView cmd = \case
  CRInvitation cReq -> r' $ viewConnReqInvitation cReq
  CRSentConfirmation -> r' ["confirmation sent!"]
  CRSentInvitation -> r' ["connection request sent!"]
-  CRContactDeleted c -> r' [ttyContact c <> ": contact is deleted"]
+  CRContactDeleted Contact {localDisplayName} -> r' [ttyContact localDisplayName <> ": contact is deleted"]
  CRAcceptingContactRequest c -> r' [ttyContact c <> ": accepting contact request..."]
  CRUserContactLinkCreated cReq -> r' $ connReqContact_ "Your new chat address is created!" cReq
  CRUserContactLinkDeleted -> r' viewUserContactLinkDeleted
@@ -445,7 +445,7 @@ viewChatError :: ChatError -> [StyledString]
 viewChatError = \case
  ChatError err -> case err of
    CEInvalidConnReq -> viewInvalidConnReq
-    CEContactGroups c gNames -> [ttyContact c <> ": contact cannot be deleted, it is a member of the group(s) " <> ttyGroups gNames]
+    CEContactGroups Contact {localDisplayName} gNames -> [ttyContact localDisplayName <> ": contact cannot be deleted, it is a member of the group(s) " <> ttyGroups gNames]
    CEGroupDuplicateMember c -> ["contact " <> ttyContact c <> " is already in the group"]
    CEGroupDuplicateMemberId -> ["cannot add member - duplicate member ID"]
    CEGroupUserRole -> ["you have insufficient permissions for this group command"]