{-# LANGUAGE CPP #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}

module Simplex.Chat.Store.ContactRequest
  ( createOrUpdateContactRequest,
    setContactAcceptedXContactId,
    setBusinessChatAcceptedXContactId,
    setRequestSharedMsgIdForContact,
    setRequestSharedMsgIdForGroup,
  )
where

import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class
import Crypto.Random (ChaChaDRG)
import Data.Int (Int64)
import Data.Time.Clock (getCurrentTime)
import Simplex.Chat.Protocol (MsgContent, businessChatsVersion)
import Simplex.Chat.Store.Direct
import Simplex.Chat.Store.Groups
import Simplex.Chat.Store.Profiles
import Simplex.Chat.Store.Shared
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Messaging.Agent.Protocol (InvitationId)
import Simplex.Messaging.Agent.Store.AgentStore (maybeFirstRow)
import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Crypto.Ratchet (PQSupport)
import Simplex.Messaging.Version
import UnliftIO.STM
#if defined(dbPostgres)
import Database.PostgreSQL.Simple ((:.) (..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
#else
import Database.SQLite.Simple ((:.) (..))
import Database.SQLite.Simple.QQ (sql)
#endif

createOrUpdateContactRequest ::
  DB.Connection ->
  TVar ChaChaDRG ->
  VersionRangeChat ->
  User ->
  Int64 ->
  UserContactLink ->
  Bool ->
  InvitationId ->
  VersionRangeChat ->
  Profile ->
  Maybe XContactId ->
  Maybe SharedMsgId ->
  Maybe (SharedMsgId, MsgContent) ->
  PQSupport ->
  ExceptT StoreError IO RequestStage
createOrUpdateContactRequest :: Connection
-> TVar ChaChaDRG
-> VersionRangeChat
-> User
-> GroupId
-> UserContactLink
-> Bool
-> InvitationId
-> VersionRangeChat
-> Profile
-> Maybe XContactId
-> Maybe SharedMsgId
-> Maybe (SharedMsgId, MsgContent)
-> PQSupport
-> ExceptT StoreError IO RequestStage
createOrUpdateContactRequest
  Connection
db
  TVar ChaChaDRG
gVar
  VersionRangeChat
vr
  user :: User
user@User {GroupId
userId :: GroupId
userId :: User -> GroupId
userId, GroupId
userContactId :: GroupId
userContactId :: User -> GroupId
userContactId}
  GroupId
uclId
  UserContactLink {addressSettings :: UserContactLink -> AddressSettings
addressSettings = AddressSettings {Bool
businessAddress :: Bool
businessAddress :: AddressSettings -> Bool
businessAddress}}
  Bool
isSimplexTeam
  InvitationId
invId
  cReqChatVRange :: VersionRangeChat
cReqChatVRange@(VersionRange Version ChatVersion
minV Version ChatVersion
maxV)
  profile :: Profile
profile@Profile {ContactName
displayName :: ContactName
displayName :: Profile -> ContactName
displayName, ContactName
fullName :: ContactName
fullName :: Profile -> ContactName
fullName, Maybe ContactName
shortDescr :: Maybe ContactName
shortDescr :: Profile -> Maybe ContactName
shortDescr, Maybe ImageData
image :: Maybe ImageData
image :: Profile -> Maybe ImageData
image, Maybe ConnLinkContact
contactLink :: Maybe ConnLinkContact
contactLink :: Profile -> Maybe ConnLinkContact
contactLink, Maybe Preferences
preferences :: Maybe Preferences
preferences :: Profile -> Maybe Preferences
preferences}
  Maybe XContactId
xContactId_
  Maybe SharedMsgId
welcomeMsgId_
  Maybe (SharedMsgId, MsgContent)
requestMsg_
  PQSupport
pqSup =
    case Maybe XContactId
xContactId_ of
      -- 0) this is very old legacy, when we didn't have xContactId at all (this should be deprecated)
      Maybe XContactId
Nothing -> ExceptT StoreError IO RequestStage
createContactRequest
      Just XContactId
xContactId ->
        -- 1) first we try to find accepted contact or business chat by xContactId
        IO (Maybe Contact) -> ExceptT StoreError IO (Maybe Contact)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (XContactId -> IO (Maybe Contact)
getAcceptedContact XContactId
xContactId) ExceptT StoreError IO (Maybe Contact)
-> (Maybe Contact -> ExceptT StoreError IO RequestStage)
-> ExceptT StoreError IO RequestStage
forall a b.
ExceptT StoreError IO a
-> (a -> ExceptT StoreError IO b) -> ExceptT StoreError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Just Contact
ct -> do
            Maybe UserContactRequest
cr <- IO (Maybe UserContactRequest)
-> ExceptT StoreError IO (Maybe UserContactRequest)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe UserContactRequest)
 -> ExceptT StoreError IO (Maybe UserContactRequest))
-> IO (Maybe UserContactRequest)
-> ExceptT StoreError IO (Maybe UserContactRequest)
forall a b. (a -> b) -> a -> b
$ XContactId -> IO (Maybe UserContactRequest)
getContactRequestByXContactId XContactId
xContactId
            RequestStage -> ExceptT StoreError IO RequestStage
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RequestStage -> ExceptT StoreError IO RequestStage)
-> RequestStage -> ExceptT StoreError IO RequestStage
forall a b. (a -> b) -> a -> b
$ Maybe UserContactRequest -> RequestEntity -> RequestStage
RSAcceptedRequest Maybe UserContactRequest
cr (Contact -> RequestEntity
REContact Contact
ct)
          Maybe Contact
Nothing ->
            IO (Maybe GroupInfo) -> ExceptT StoreError IO (Maybe GroupInfo)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (XContactId -> IO (Maybe GroupInfo)
getAcceptedBusinessChat XContactId
xContactId) ExceptT StoreError IO (Maybe GroupInfo)
-> (Maybe GroupInfo -> ExceptT StoreError IO RequestStage)
-> ExceptT StoreError IO RequestStage
forall a b.
ExceptT StoreError IO a
-> (a -> ExceptT StoreError IO b) -> ExceptT StoreError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Just gInfo :: GroupInfo
gInfo@GroupInfo {businessChat :: GroupInfo -> Maybe BusinessChatInfo
businessChat = Just BusinessChatInfo {MemberId
customerId :: MemberId
customerId :: BusinessChatInfo -> MemberId
customerId}} -> do
                GroupMember
clientMember <- Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> MemberId
-> ExceptT StoreError IO GroupMember
getGroupMemberByMemberId Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo MemberId
customerId
                Maybe UserContactRequest
cr <- IO (Maybe UserContactRequest)
-> ExceptT StoreError IO (Maybe UserContactRequest)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe UserContactRequest)
 -> ExceptT StoreError IO (Maybe UserContactRequest))
-> IO (Maybe UserContactRequest)
-> ExceptT StoreError IO (Maybe UserContactRequest)
forall a b. (a -> b) -> a -> b
$ XContactId -> IO (Maybe UserContactRequest)
getContactRequestByXContactId XContactId
xContactId
                RequestStage -> ExceptT StoreError IO RequestStage
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RequestStage -> ExceptT StoreError IO RequestStage)
-> RequestStage -> ExceptT StoreError IO RequestStage
forall a b. (a -> b) -> a -> b
$ Maybe UserContactRequest -> RequestEntity -> RequestStage
RSAcceptedRequest Maybe UserContactRequest
cr (GroupInfo -> GroupMember -> RequestEntity
REBusinessChat GroupInfo
gInfo GroupMember
clientMember)
              Just GroupInfo {businessChat :: GroupInfo -> Maybe BusinessChatInfo
businessChat = Maybe BusinessChatInfo
Nothing} -> StoreError -> ExceptT StoreError IO RequestStage
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError StoreError
SEInvalidBusinessChatContactRequest
              -- 2) if no legacy accepted contact or business chat was found, next we try to find an existing request
              Maybe GroupInfo
Nothing ->
                IO (Maybe UserContactRequest)
-> ExceptT StoreError IO (Maybe UserContactRequest)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (XContactId -> IO (Maybe UserContactRequest)
getContactRequestByXContactId XContactId
xContactId) ExceptT StoreError IO (Maybe UserContactRequest)
-> (Maybe UserContactRequest -> ExceptT StoreError IO RequestStage)
-> ExceptT StoreError IO RequestStage
forall a b.
ExceptT StoreError IO a
-> (a -> ExceptT StoreError IO b) -> ExceptT StoreError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                  -- 3a) if request was found, we update it
                  Just UserContactRequest
cr -> UserContactRequest -> ExceptT StoreError IO RequestStage
updateContactRequest UserContactRequest
cr
                  -- 3b) if no request was found, we create a new contact request
                  Maybe UserContactRequest
Nothing -> ExceptT StoreError IO RequestStage
createContactRequest
    where
      getAcceptedContact :: XContactId -> IO (Maybe Contact)
      getAcceptedContact :: XContactId -> IO (Maybe Contact)
getAcceptedContact XContactId
xContactId = do
        Maybe Contact
ct_ <-
          ((ContactRow :. MaybeConnectionRow) -> Contact)
-> IO [ContactRow :. MaybeConnectionRow] -> IO (Maybe Contact)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow (VersionRangeChat
-> User
-> [GroupId]
-> (ContactRow :. MaybeConnectionRow)
-> Contact
toContact VersionRangeChat
vr User
user []) (IO [ContactRow :. MaybeConnectionRow] -> IO (Maybe Contact))
-> IO [ContactRow :. MaybeConnectionRow] -> IO (Maybe Contact)
forall a b. (a -> b) -> a -> b
$
            Connection
-> Query
-> (GroupId, XContactId)
-> IO [ContactRow :. MaybeConnectionRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
              Connection
db
              [sql|
                SELECT
                  -- Contact
                  ct.contact_id, ct.contact_profile_id, ct.local_display_name, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.chat_peer_type, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
                  cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.welcome_shared_msg_id, ct.request_shared_msg_id, ct.contact_request_id,
                  ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.grp_direct_inv_link, ct.grp_direct_inv_from_group_id, ct.grp_direct_inv_from_group_member_id, ct.grp_direct_inv_from_member_conn_id, ct.grp_direct_inv_started_connection,
                  ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
                  -- Connection
                  c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
                  c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
                  c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
                FROM contacts ct
                JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
                LEFT JOIN connections c ON c.contact_id = ct.contact_id
                WHERE ct.user_id = ? AND ct.xcontact_id = ? AND ct.deleted = 0
              |]
              (GroupId
userId, XContactId
xContactId)
        (Contact -> IO Contact) -> Maybe Contact -> IO (Maybe Contact)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (Connection -> Contact -> IO Contact
addDirectChatTags Connection
db) Maybe Contact
ct_
      getAcceptedBusinessChat :: XContactId -> IO (Maybe GroupInfo)
      getAcceptedBusinessChat :: XContactId -> IO (Maybe GroupInfo)
getAcceptedBusinessChat XContactId
xContactId = do
        Maybe GroupInfo
g_ <-
          (GroupInfoRow -> GroupInfo)
-> IO [GroupInfoRow] -> IO (Maybe GroupInfo)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow (VersionRangeChat
-> GroupId -> [GroupId] -> GroupInfoRow -> GroupInfo
toGroupInfo VersionRangeChat
vr GroupId
userContactId []) (IO [GroupInfoRow] -> IO (Maybe GroupInfo))
-> IO [GroupInfoRow] -> IO (Maybe GroupInfo)
forall a b. (a -> b) -> a -> b
$
            Connection
-> Query -> (XContactId, GroupId, GroupId) -> IO [GroupInfoRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
              Connection
db
              (Query
groupInfoQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE g.business_xcontact_id = ? AND g.user_id = ? AND mu.contact_id = ?")
              (XContactId
xContactId, GroupId
userId, GroupId
userContactId)
        (GroupInfo -> IO GroupInfo)
-> Maybe GroupInfo -> IO (Maybe GroupInfo)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (Connection -> GroupInfo -> IO GroupInfo
addGroupChatTags Connection
db) Maybe GroupInfo
g_
      getContactRequestByXContactId :: XContactId -> IO (Maybe UserContactRequest)
      getContactRequestByXContactId :: XContactId -> IO (Maybe UserContactRequest)
getContactRequestByXContactId XContactId
xContactId =
        (ContactRequestRow -> UserContactRequest)
-> IO [ContactRequestRow] -> IO (Maybe UserContactRequest)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow ContactRequestRow -> UserContactRequest
toContactRequest (IO [ContactRequestRow] -> IO (Maybe UserContactRequest))
-> IO [ContactRequestRow] -> IO (Maybe UserContactRequest)
forall a b. (a -> b) -> a -> b
$
          Connection
-> Query -> (GroupId, XContactId) -> IO [ContactRequestRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
            Connection
db
            [sql|
              SELECT
                cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id,
                cr.contact_id, cr.business_group_id, cr.user_contact_link_id,
                cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, cr.xcontact_id,
                cr.pq_support, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
                cr.created_at, cr.updated_at,
                cr.peer_chat_min_version, cr.peer_chat_max_version
              FROM contact_requests cr
              JOIN contact_profiles p USING (contact_profile_id)
              WHERE cr.user_id = ?
                AND cr.xcontact_id = ?
              LIMIT 1
            |]
            (GroupId
userId, XContactId
xContactId)
      createContactRequest :: ExceptT StoreError IO RequestStage
      createContactRequest :: ExceptT StoreError IO RequestStage
createContactRequest = do
        UTCTime
currentTs <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime -> ExceptT StoreError IO UTCTime)
-> IO UTCTime -> ExceptT StoreError IO UTCTime
forall a b. (a -> b) -> a -> b
$ IO UTCTime
getCurrentTime
        IO (Either StoreError RequestStage)
-> ExceptT StoreError IO RequestStage
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError RequestStage)
 -> ExceptT StoreError IO RequestStage)
-> IO (Either StoreError RequestStage)
-> ExceptT StoreError IO RequestStage
forall a b. (a -> b) -> a -> b
$ Connection
-> GroupId
-> ContactName
-> (ContactName -> IO (Either StoreError RequestStage))
-> IO (Either StoreError RequestStage)
forall a.
Connection
-> GroupId
-> ContactName
-> (ContactName -> IO (Either StoreError a))
-> IO (Either StoreError a)
withLocalDisplayName Connection
db GroupId
userId ContactName
displayName ((ContactName -> IO (Either StoreError RequestStage))
 -> IO (Either StoreError RequestStage))
-> (ContactName -> IO (Either StoreError RequestStage))
-> IO (Either StoreError RequestStage)
forall a b. (a -> b) -> a -> b
$ \ContactName
ldn -> ExceptT StoreError IO RequestStage
-> IO (Either StoreError RequestStage)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO RequestStage
 -> IO (Either StoreError RequestStage))
-> ExceptT StoreError IO RequestStage
-> IO (Either StoreError RequestStage)
forall a b. (a -> b) -> a -> b
$ do
          IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
            Connection
-> Query
-> (ContactName, ContactName, Maybe ContactName, Maybe ImageData,
    Maybe ConnLinkContact, GroupId, Maybe Preferences, UTCTime,
    UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
              Connection
db
              Query
"INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
              (ContactName
displayName, ContactName
fullName, Maybe ContactName
shortDescr, Maybe ImageData
image, Maybe ConnLinkContact
contactLink, GroupId
userId, Maybe Preferences
preferences, UTCTime
currentTs, UTCTime
currentTs)
          GroupId
profileId <- IO GroupId -> ExceptT StoreError IO GroupId
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GroupId -> ExceptT StoreError IO GroupId)
-> IO GroupId -> ExceptT StoreError IO GroupId
forall a b. (a -> b) -> a -> b
$ Connection -> IO GroupId
insertedRowId Connection
db
          IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
            Connection
-> Query
-> ((GroupId, Binary InvitationId, Version ChatVersion,
     Version ChatVersion, GroupId, ContactName, GroupId)
    :. (UTCTime, UTCTime, Maybe XContactId, Maybe SharedMsgId,
        Maybe SharedMsgId, PQSupport))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
              Connection
db
              [sql|
              INSERT INTO contact_requests
                (user_contact_link_id, agent_invitation_id, peer_chat_min_version, peer_chat_max_version, contact_profile_id, local_display_name, user_id,
                  created_at, updated_at, xcontact_id, welcome_shared_msg_id, request_shared_msg_id, pq_support)
              VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
            |]
              ( (GroupId
uclId, InvitationId -> Binary InvitationId
forall a. a -> Binary a
Binary InvitationId
invId, Version ChatVersion
minV, Version ChatVersion
maxV, GroupId
profileId, ContactName
ldn, GroupId
userId)
                  (GroupId, Binary InvitationId, Version ChatVersion,
 Version ChatVersion, GroupId, ContactName, GroupId)
-> (UTCTime, UTCTime, Maybe XContactId, Maybe SharedMsgId,
    Maybe SharedMsgId, PQSupport)
-> (GroupId, Binary InvitationId, Version ChatVersion,
    Version ChatVersion, GroupId, ContactName, GroupId)
   :. (UTCTime, UTCTime, Maybe XContactId, Maybe SharedMsgId,
       Maybe SharedMsgId, PQSupport)
forall h t. h -> t -> h :. t
:. (UTCTime
currentTs, UTCTime
currentTs, Maybe XContactId
xContactId_, Maybe SharedMsgId
welcomeMsgId_, (SharedMsgId, MsgContent) -> SharedMsgId
forall a b. (a, b) -> a
fst ((SharedMsgId, MsgContent) -> SharedMsgId)
-> Maybe (SharedMsgId, MsgContent) -> Maybe SharedMsgId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (SharedMsgId, MsgContent)
requestMsg_, PQSupport
pqSup)
              )
          GroupId
contactRequestId <- IO GroupId -> ExceptT StoreError IO GroupId
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GroupId -> ExceptT StoreError IO GroupId)
-> IO GroupId -> ExceptT StoreError IO GroupId
forall a b. (a -> b) -> a -> b
$ Connection -> IO GroupId
insertedRowId Connection
db
          ContactName
-> GroupId
-> GroupId
-> UTCTime
-> ExceptT StoreError IO RequestStage
forall {p}.
ToField p =>
ContactName
-> GroupId -> GroupId -> p -> ExceptT StoreError IO RequestStage
createRequestEntity ContactName
ldn GroupId
profileId GroupId
contactRequestId UTCTime
currentTs
        where
          createRequestEntity :: ContactName
-> GroupId -> GroupId -> p -> ExceptT StoreError IO RequestStage
createRequestEntity ContactName
ldn GroupId
profileId GroupId
contactRequestId p
currentTs
            | Bool
businessAddress =
                if Bool
isSimplexTeam Bool -> Bool -> Bool
&& Version ChatVersion
maxV Version ChatVersion -> Version ChatVersion -> Bool
forall a. Ord a => a -> a -> Bool
< Version ChatVersion
businessChatsVersion
                  then ExceptT StoreError IO RequestStage
createContact'
                  else ExceptT StoreError IO RequestStage
createBusinessChat
            | Bool
otherwise = ExceptT StoreError IO RequestStage
createContact'
            where
              createContact' :: ExceptT StoreError IO RequestStage
createContact' = do
                let ctUserPreferences :: Preferences
ctUserPreferences = User -> Profile -> Preferences
newContactUserPrefs User
user Profile
profile
                IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
                  Connection
-> Query
-> (GroupId, Preferences, ContactName, GroupId, p, p, p, BoolInt,
    GroupId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
                    Connection
db
                    Query
"INSERT INTO contacts (contact_profile_id, user_preferences, local_display_name, user_id, created_at, updated_at, chat_ts, contact_used, contact_request_id) VALUES (?,?,?,?,?,?,?,?,?)"
                    (GroupId
profileId, Preferences
ctUserPreferences, ContactName
ldn, GroupId
userId, p
currentTs, p
currentTs, p
currentTs, Bool -> BoolInt
BI Bool
True, GroupId
contactRequestId)
                GroupId
contactId <- IO GroupId -> ExceptT StoreError IO GroupId
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GroupId -> ExceptT StoreError IO GroupId)
-> IO GroupId -> ExceptT StoreError IO GroupId
forall a b. (a -> b) -> a -> b
$ Connection -> IO GroupId
insertedRowId Connection
db
                IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
                  Connection -> Query -> (GroupId, GroupId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
                    Connection
db
                    Query
"UPDATE contact_requests SET contact_id = ? WHERE contact_request_id = ?"
                    (GroupId
contactId, GroupId
contactRequestId)
                UserContactRequest
ucr <- Connection
-> User -> GroupId -> ExceptT StoreError IO UserContactRequest
getContactRequest Connection
db User
user GroupId
contactRequestId
                Contact
ct <- Connection
-> VersionRangeChat
-> User
-> GroupId
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user GroupId
contactId
                RequestStage -> ExceptT StoreError IO RequestStage
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RequestStage -> ExceptT StoreError IO RequestStage)
-> RequestStage -> ExceptT StoreError IO RequestStage
forall a b. (a -> b) -> a -> b
$ Maybe UserContactRequest
-> UserContactRequest -> Maybe RequestEntity -> RequestStage
RSCurrentRequest Maybe UserContactRequest
forall a. Maybe a
Nothing UserContactRequest
ucr (RequestEntity -> Maybe RequestEntity
forall a. a -> Maybe a
Just (RequestEntity -> Maybe RequestEntity)
-> RequestEntity -> Maybe RequestEntity
forall a b. (a -> b) -> a -> b
$ Contact -> RequestEntity
REContact Contact
ct)
              createBusinessChat :: ExceptT StoreError IO RequestStage
createBusinessChat = do
                let groupPreferences :: GroupPreferences
groupPreferences = GroupPreferences
-> (Preferences -> GroupPreferences)
-> Maybe Preferences
-> GroupPreferences
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GroupPreferences
defaultBusinessGroupPrefs Preferences -> GroupPreferences
businessGroupPrefs (Maybe Preferences -> GroupPreferences)
-> Maybe Preferences -> GroupPreferences
forall a b. (a -> b) -> a -> b
$ User -> Maybe Preferences
forall a. IsContact a => a -> Maybe Preferences
preferences' User
user
                (gInfo :: GroupInfo
gInfo@GroupInfo {GroupId
groupId :: GroupId
groupId :: GroupInfo -> GroupId
groupId}, GroupMember
clientMember) <-
                  Connection
-> VersionRangeChat
-> TVar ChaChaDRG
-> User
-> VersionRangeChat
-> Profile
-> GroupId
-> ContactName
-> GroupPreferences
-> ExceptT StoreError IO (GroupInfo, GroupMember)
createBusinessRequestGroup Connection
db VersionRangeChat
vr TVar ChaChaDRG
gVar User
user VersionRangeChat
cReqChatVRange Profile
profile GroupId
profileId ContactName
ldn GroupPreferences
groupPreferences
                IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
                  Connection -> Query -> (GroupId, GroupId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
                    Connection
db
                    Query
"UPDATE contact_requests SET business_group_id = ? WHERE contact_request_id = ?"
                    (GroupId
groupId, GroupId
contactRequestId)
                UserContactRequest
ucr <- Connection
-> User -> GroupId -> ExceptT StoreError IO UserContactRequest
getContactRequest Connection
db User
user GroupId
contactRequestId
                RequestStage -> ExceptT StoreError IO RequestStage
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RequestStage -> ExceptT StoreError IO RequestStage)
-> RequestStage -> ExceptT StoreError IO RequestStage
forall a b. (a -> b) -> a -> b
$ Maybe UserContactRequest
-> UserContactRequest -> Maybe RequestEntity -> RequestStage
RSCurrentRequest Maybe UserContactRequest
forall a. Maybe a
Nothing UserContactRequest
ucr (RequestEntity -> Maybe RequestEntity
forall a. a -> Maybe a
Just (RequestEntity -> Maybe RequestEntity)
-> RequestEntity -> Maybe RequestEntity
forall a b. (a -> b) -> a -> b
$ GroupInfo -> GroupMember -> RequestEntity
REBusinessChat GroupInfo
gInfo GroupMember
clientMember)
      updateContactRequest :: UserContactRequest -> ExceptT StoreError IO RequestStage
      updateContactRequest :: UserContactRequest -> ExceptT StoreError IO RequestStage
updateContactRequest ucr :: UserContactRequest
ucr@UserContactRequest {GroupId
contactRequestId :: GroupId
contactRequestId :: UserContactRequest -> GroupId
contactRequestId, Maybe GroupId
contactId_ :: Maybe GroupId
contactId_ :: UserContactRequest -> Maybe GroupId
contactId_, localDisplayName :: UserContactRequest -> ContactName
localDisplayName = ContactName
oldLdn, profile :: UserContactRequest -> Profile
profile = Profile {displayName :: Profile -> ContactName
displayName = ContactName
oldDisplayName}} = do
        UTCTime
currentTs <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
        IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ UTCTime -> IO ()
forall {f}. ToField f => f -> IO ()
updateProfile UTCTime
currentTs
        UTCTime -> ExceptT StoreError IO ()
forall {b}. ToField b => b -> ExceptT StoreError IO ()
updateRequest UTCTime
currentTs
        UserContactRequest
ucr' <- Connection
-> User -> GroupId -> ExceptT StoreError IO UserContactRequest
getContactRequest Connection
db User
user GroupId
contactRequestId
        Maybe RequestEntity
re_ <- UserContactRequest -> ExceptT StoreError IO (Maybe RequestEntity)
getRequestEntity UserContactRequest
ucr'
        RequestStage -> ExceptT StoreError IO RequestStage
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RequestStage -> ExceptT StoreError IO RequestStage)
-> RequestStage -> ExceptT StoreError IO RequestStage
forall a b. (a -> b) -> a -> b
$ Maybe UserContactRequest
-> UserContactRequest -> Maybe RequestEntity -> RequestStage
RSCurrentRequest (UserContactRequest -> Maybe UserContactRequest
forall a. a -> Maybe a
Just UserContactRequest
ucr) UserContactRequest
ucr' Maybe RequestEntity
re_
        where
          updateProfile :: f -> IO ()
updateProfile f
currentTs =
            Connection
-> Query
-> (ContactName, ContactName, Maybe ContactName, Maybe ImageData,
    Maybe ConnLinkContact, f, GroupId, GroupId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
              Connection
db
              [sql|
              UPDATE contact_profiles
              SET display_name = ?,
                  full_name = ?,
                  short_descr = ?,
                  image = ?,
                  contact_link = ?,
                  updated_at = ?
              WHERE contact_profile_id IN (
                SELECT contact_profile_id
                FROM contact_requests
                WHERE user_id = ?
                  AND contact_request_id = ?
              )
            |]
              (ContactName
displayName, ContactName
fullName, Maybe ContactName
shortDescr, Maybe ImageData
image, Maybe ConnLinkContact
contactLink, f
currentTs, GroupId
userId, GroupId
contactRequestId)
          updateRequest :: b -> ExceptT StoreError IO ()
updateRequest b
currentTs =
            if ContactName
displayName ContactName -> ContactName -> Bool
forall a. Eq a => a -> a -> Bool
== ContactName
oldDisplayName
              then
                IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
                  Connection
-> Query
-> (Binary InvitationId, PQSupport, Version ChatVersion,
    Version ChatVersion, b, GroupId, GroupId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
                    Connection
db
                    [sql|
                    UPDATE contact_requests
                    SET agent_invitation_id = ?, pq_support = ?, peer_chat_min_version = ?, peer_chat_max_version = ?, updated_at = ?
                    WHERE user_id = ? AND contact_request_id = ?
                  |]
                    (InvitationId -> Binary InvitationId
forall a. a -> Binary a
Binary InvitationId
invId, PQSupport
pqSup, Version ChatVersion
minV, Version ChatVersion
maxV, b
currentTs, GroupId
userId, GroupId
contactRequestId)
              else IO (Either StoreError ()) -> ExceptT StoreError IO ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError ()) -> ExceptT StoreError IO ())
-> IO (Either StoreError ()) -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> GroupId
-> ContactName
-> (ContactName -> IO (Either StoreError ()))
-> IO (Either StoreError ())
forall a.
Connection
-> GroupId
-> ContactName
-> (ContactName -> IO (Either StoreError a))
-> IO (Either StoreError a)
withLocalDisplayName Connection
db GroupId
userId ContactName
displayName ((ContactName -> IO (Either StoreError ()))
 -> IO (Either StoreError ()))
-> (ContactName -> IO (Either StoreError ()))
-> IO (Either StoreError ())
forall a b. (a -> b) -> a -> b
$ \ContactName
ldn -> ExceptT StoreError IO () -> IO (Either StoreError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO () -> IO (Either StoreError ()))
-> ExceptT StoreError IO () -> IO (Either StoreError ())
forall a b. (a -> b) -> a -> b
$ do
                IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ do
                  Connection
-> Query
-> (Binary InvitationId, PQSupport, Version ChatVersion,
    Version ChatVersion, ContactName, b, GroupId, GroupId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
                    Connection
db
                    [sql|
                      UPDATE contact_requests
                      SET agent_invitation_id = ?, pq_support = ?, peer_chat_min_version = ?, peer_chat_max_version = ?, local_display_name = ?, updated_at = ?
                      WHERE user_id = ? AND contact_request_id = ?
                    |]
                    (InvitationId -> Binary InvitationId
forall a. a -> Binary a
Binary InvitationId
invId, PQSupport
pqSup, Version ChatVersion
minV, Version ChatVersion
maxV, ContactName
ldn, b
currentTs, GroupId
userId, GroupId
contactRequestId)
                  -- Here we could also update business chat, but is always synchronously auto-accepted so it's less of an issue
                  Maybe GroupId -> (GroupId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe GroupId
contactId_ ((GroupId -> IO ()) -> IO ()) -> (GroupId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \GroupId
contactId ->
                    Connection -> Query -> (ContactName, b, GroupId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
                      Connection
db
                      [sql|
                        UPDATE contacts
                        SET local_display_name = ?, updated_at = ?
                        WHERE contact_id = ?
                      |]
                      (ContactName
ldn, b
currentTs, GroupId
contactId)
                  Connection -> User -> ContactName -> IO ()
safeDeleteLDN Connection
db User
user ContactName
oldLdn
      getRequestEntity :: UserContactRequest -> ExceptT StoreError IO (Maybe RequestEntity)
      getRequestEntity :: UserContactRequest -> ExceptT StoreError IO (Maybe RequestEntity)
getRequestEntity UserContactRequest {GroupId
contactRequestId :: UserContactRequest -> GroupId
contactRequestId :: GroupId
contactRequestId, Maybe GroupId
contactId_ :: UserContactRequest -> Maybe GroupId
contactId_ :: Maybe GroupId
contactId_, Maybe GroupId
businessGroupId_ :: Maybe GroupId
businessGroupId_ :: UserContactRequest -> Maybe GroupId
businessGroupId_} =
        case (Maybe GroupId
contactId_, Maybe GroupId
businessGroupId_) of
          (Just GroupId
contactId, Maybe GroupId
Nothing) -> do
            Contact
ct <- Connection
-> VersionRangeChat
-> User
-> GroupId
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user GroupId
contactId
            Maybe RequestEntity -> ExceptT StoreError IO (Maybe RequestEntity)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe RequestEntity
 -> ExceptT StoreError IO (Maybe RequestEntity))
-> Maybe RequestEntity
-> ExceptT StoreError IO (Maybe RequestEntity)
forall a b. (a -> b) -> a -> b
$ RequestEntity -> Maybe RequestEntity
forall a. a -> Maybe a
Just (Contact -> RequestEntity
REContact Contact
ct)
          (Maybe GroupId
Nothing, Just GroupId
businessGroupId) -> do
            GroupInfo
gInfo <- Connection
-> VersionRangeChat
-> User
-> GroupId
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user GroupId
businessGroupId
            case GroupInfo
gInfo of
              GroupInfo {businessChat :: GroupInfo -> Maybe BusinessChatInfo
businessChat = Just BusinessChatInfo {MemberId
customerId :: BusinessChatInfo -> MemberId
customerId :: MemberId
customerId}} -> do
                GroupMember
clientMember <- Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> MemberId
-> ExceptT StoreError IO GroupMember
getGroupMemberByMemberId Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo MemberId
customerId
                Maybe RequestEntity -> ExceptT StoreError IO (Maybe RequestEntity)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe RequestEntity
 -> ExceptT StoreError IO (Maybe RequestEntity))
-> Maybe RequestEntity
-> ExceptT StoreError IO (Maybe RequestEntity)
forall a b. (a -> b) -> a -> b
$ RequestEntity -> Maybe RequestEntity
forall a. a -> Maybe a
Just (GroupInfo -> GroupMember -> RequestEntity
REBusinessChat GroupInfo
gInfo GroupMember
clientMember)
              GroupInfo
_ -> StoreError -> ExceptT StoreError IO (Maybe RequestEntity)
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError StoreError
SEInvalidBusinessChatContactRequest
          (Maybe GroupId
Nothing, Maybe GroupId
Nothing) -> Maybe RequestEntity -> ExceptT StoreError IO (Maybe RequestEntity)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe RequestEntity
forall a. Maybe a
Nothing
          (Maybe GroupId, Maybe GroupId)
_ -> StoreError -> ExceptT StoreError IO (Maybe RequestEntity)
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO (Maybe RequestEntity))
-> StoreError -> ExceptT StoreError IO (Maybe RequestEntity)
forall a b. (a -> b) -> a -> b
$ GroupId -> StoreError
SEInvalidContactRequestEntity GroupId
contactRequestId

setContactAcceptedXContactId :: DB.Connection -> Contact -> XContactId -> IO ()
setContactAcceptedXContactId :: Connection -> Contact -> XContactId -> IO ()
setContactAcceptedXContactId Connection
db Contact {GroupId
contactId :: GroupId
contactId :: Contact -> GroupId
contactId} XContactId
xContactId =
  Connection -> Query -> (XContactId, GroupId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE contacts SET xcontact_id = ? WHERE contact_id = ?" (XContactId
xContactId, GroupId
contactId)

setBusinessChatAcceptedXContactId :: DB.Connection -> GroupInfo -> XContactId -> IO ()
setBusinessChatAcceptedXContactId :: Connection -> GroupInfo -> XContactId -> IO ()
setBusinessChatAcceptedXContactId Connection
db GroupInfo {GroupId
groupId :: GroupInfo -> GroupId
groupId :: GroupId
groupId} XContactId
xContactId =
  Connection -> Query -> (XContactId, GroupId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE groups SET business_xcontact_id = ? WHERE group_id = ?" (XContactId
xContactId, GroupId
groupId)

setRequestSharedMsgIdForContact :: DB.Connection -> ContactId -> SharedMsgId -> IO ()
setRequestSharedMsgIdForContact :: Connection -> GroupId -> SharedMsgId -> IO ()
setRequestSharedMsgIdForContact Connection
db GroupId
contactId SharedMsgId
sharedMsgId = do
  Connection -> Query -> (SharedMsgId, GroupId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE contacts SET request_shared_msg_id = ? WHERE contact_id = ?" (SharedMsgId
sharedMsgId, GroupId
contactId)

setRequestSharedMsgIdForGroup :: DB.Connection -> GroupId -> SharedMsgId -> IO ()
setRequestSharedMsgIdForGroup :: Connection -> GroupId -> SharedMsgId -> IO ()
setRequestSharedMsgIdForGroup Connection
db GroupId
groupId SharedMsgId
sharedMsgId = do
  Connection -> Query -> (SharedMsgId, GroupId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE groups SET request_shared_msg_id = ? WHERE group_id = ?" (SharedMsgId
sharedMsgId, GroupId
groupId)