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

module Simplex.Chat.Store.Direct
  ( updateContactLDN_,
    updateContactProfile_,
    updateContactProfile_',
    updateMemberContactProfileReset_',
    updateMemberContactProfileReset_,
    updateMemberContactProfile_,
    updateMemberContactProfile_',
    deleteContactProfile_,
    deleteUnusedProfile_,

    -- * Contacts and connections functions
    getPendingContactConnection,
    deletePendingContactConnection,
    createDirectConnection',
    createDirectConnection,
    createIncognitoProfile,
    createConnReqConnection,
    setPreparedGroupStartedConnection,
    getProfileById,
    getConnReqContactXContactId,
    createPreparedContact,
    updatePreparedContactUser,
    createDirectContact,
    deleteContactConnections,
    deleteContactFiles,
    deleteContact,
    deleteContactWithoutGroups,
    getDeletedContacts,
    getContactByName,
    getContact,
    getContactViaShortLinkToConnect,
    getContactIdByName,
    updateContactProfile,
    updateContactUserPreferences,
    updateContactAlias,
    updateContactConnectionAlias,
    updatePCCIncognito,
    deletePCCIncognitoProfile,
    updateContactUnreadChat,
    setUserChatsRead,
    updateContactStatus,
    updateGroupUnreadChat,
    setConnectionVerified,
    incAuthErrCounter,
    setAuthErrCounter,
    incQuotaErrCounter,
    setQuotaErrCounter,
    getUserContacts,
    getUserContactLinkIdByCReq,
    getContactRequest,
    getContactRequest',
    getBusinessContactRequest,
    getContactRequestIdByName,
    deleteContactRequest,
    createContactFromRequest,
    createAcceptedContactConn,
    updateContactAccepted,
    getUserByContactRequestId,
    getContactConnections,
    getConnectionById,
    getConnectionsContacts,
    updateConnectionStatus,
    updateConnectionStatusFromTo,
    updateContactSettings,
    setConnConnReqInv,
    resetContactConnInitiated,
    setContactCustomData,
    setContactUIThemes,
    setContactChatDeleted,
    getDirectChatTags,
    addDirectChatTags,
    updateDirectChatTags,
    setDirectChatTTL,
    getDirectChatTTL,
    getUserContactsToExpire
  )
where

import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class
import Data.Either (rights)
import Data.Functor (($>))
import Data.Int (Int64)
import Data.Maybe (fromMaybe, isJust, isNothing)
import Data.Text (Text)
import Data.Time.Clock (UTCTime (..), getCurrentTime)
import Data.Type.Equality
import Simplex.Chat.Messages
import Simplex.Chat.Store.Shared
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.UITheme
import Simplex.Messaging.Agent.Protocol (AConnectionRequestUri (..), ACreatedConnLink (..), ConnId, ConnShortLink, ConnectionModeI (..), ConnectionRequestUri, CreatedConnLink (..), UserId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, maybeFirstRow)
import Simplex.Messaging.Agent.Store.DB (BoolInt (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Crypto.Ratchet (PQSupport)
import qualified Simplex.Messaging.Crypto.Ratchet as CR
import Simplex.Messaging.Protocol (SubscriptionMode (..))
#if defined(dbPostgres)
import Database.PostgreSQL.Simple (Only (..), Query, (:.) (..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
#else
import Database.SQLite.Simple (Only (..), Query, (:.) (..))
import Database.SQLite.Simple.QQ (sql)
#endif

getPendingContactConnection :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO PendingContactConnection
getPendingContactConnection :: Connection
-> Int64 -> Int64 -> ExceptT StoreError IO PendingContactConnection
getPendingContactConnection Connection
db Int64
userId Int64
connId = do
  IO (Either StoreError PendingContactConnection)
-> ExceptT StoreError IO PendingContactConnection
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError PendingContactConnection)
 -> ExceptT StoreError IO PendingContactConnection)
-> (IO
      [(Int64, ConnId, ConnStatus, Maybe ConnId, Maybe Int64,
        Maybe GroupLinkId, Maybe Int64, Maybe ConnReqInvitation,
        Maybe ShortLinkInvitation, ContactName, UTCTime, UTCTime)]
    -> IO (Either StoreError PendingContactConnection))
-> IO
     [(Int64, ConnId, ConnStatus, Maybe ConnId, Maybe Int64,
       Maybe GroupLinkId, Maybe Int64, Maybe ConnReqInvitation,
       Maybe ShortLinkInvitation, ContactName, UTCTime, UTCTime)]
-> ExceptT StoreError IO PendingContactConnection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int64, ConnId, ConnStatus, Maybe ConnId, Maybe Int64,
  Maybe GroupLinkId, Maybe Int64, Maybe ConnReqInvitation,
  Maybe ShortLinkInvitation, ContactName, UTCTime, UTCTime)
 -> PendingContactConnection)
-> StoreError
-> IO
     [(Int64, ConnId, ConnStatus, Maybe ConnId, Maybe Int64,
       Maybe GroupLinkId, Maybe Int64, Maybe ConnReqInvitation,
       Maybe ShortLinkInvitation, ContactName, UTCTime, UTCTime)]
-> IO (Either StoreError PendingContactConnection)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (Int64, ConnId, ConnStatus, Maybe ConnId, Maybe Int64,
 Maybe GroupLinkId, Maybe Int64, Maybe ConnReqInvitation,
 Maybe ShortLinkInvitation, ContactName, UTCTime, UTCTime)
-> PendingContactConnection
toPendingContactConnection (Int64 -> StoreError
SEPendingConnectionNotFound Int64
connId) (IO
   [(Int64, ConnId, ConnStatus, Maybe ConnId, Maybe Int64,
     Maybe GroupLinkId, Maybe Int64, Maybe ConnReqInvitation,
     Maybe ShortLinkInvitation, ContactName, UTCTime, UTCTime)]
 -> ExceptT StoreError IO PendingContactConnection)
-> IO
     [(Int64, ConnId, ConnStatus, Maybe ConnId, Maybe Int64,
       Maybe GroupLinkId, Maybe Int64, Maybe ConnReqInvitation,
       Maybe ShortLinkInvitation, ContactName, UTCTime, UTCTime)]
-> ExceptT StoreError IO PendingContactConnection
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (Int64, Int64, ConnType)
-> IO
     [(Int64, ConnId, ConnStatus, Maybe ConnId, Maybe Int64,
       Maybe GroupLinkId, Maybe Int64, Maybe ConnReqInvitation,
       Maybe ShortLinkInvitation, ContactName, UTCTime, UTCTime)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT connection_id, agent_conn_id, conn_status, via_contact_uri_hash, via_user_contact_link, group_link_id, custom_user_profile_id, conn_req_inv, short_link_inv, local_alias, created_at, updated_at
        FROM connections
        WHERE user_id = ?
          AND connection_id = ?
          AND conn_type = ?
          AND contact_id IS NULL
          AND conn_level = 0
          AND via_contact IS NULL
      |]
      (Int64
userId, Int64
connId, ConnType
ConnContact)

deletePendingContactConnection :: DB.Connection -> UserId -> Int64 -> IO ()
deletePendingContactConnection :: Connection -> Int64 -> Int64 -> IO ()
deletePendingContactConnection Connection
db Int64
userId Int64
connId =
  Connection -> Query -> (Int64, Int64, ConnType) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      DELETE FROM connections
        WHERE user_id = ?
          AND connection_id = ?
          AND conn_type = ?
          AND contact_id IS NULL
          AND conn_level = 0
          AND via_contact IS NULL
    |]
    (Int64
userId, Int64
connId, ConnType
ConnContact)

createConnReqConnection :: DB.Connection -> UserId -> ConnId -> Maybe PreparedChatEntity -> ConnReqContact -> ConnReqUriHash -> Maybe ShortLinkContact -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> SubscriptionMode -> VersionChat -> PQSupport -> IO Connection
createConnReqConnection :: Connection
-> Int64
-> ConnId
-> Maybe PreparedChatEntity
-> ConnReqContact
-> ConnReqUriHash
-> Maybe ShortLinkContact
-> XContactId
-> Maybe Profile
-> Maybe GroupLinkId
-> SubscriptionMode
-> VersionChat
-> PQSupport
-> IO Connection
createConnReqConnection Connection
db Int64
userId ConnId
acId Maybe PreparedChatEntity
preparedEntity_ ConnReqContact
cReq ConnReqUriHash
cReqHash Maybe ShortLinkContact
sLnk XContactId
xContactId Maybe Profile
incognitoProfile Maybe GroupLinkId
groupLinkId SubscriptionMode
subMode VersionChat
chatV PQSupport
pqSup = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Maybe Int64
customUserProfileId <- (Profile -> IO Int64) -> Maybe Profile -> IO (Maybe Int64)
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 -> Int64 -> UTCTime -> Profile -> IO Int64
createIncognitoProfile_ Connection
db Int64
userId UTCTime
currentTs) Maybe Profile
incognitoProfile
  let connStatus :: ConnStatus
connStatus = ConnStatus
ConnPrepared
  Connection
-> Query
-> ((Int64, ConnId, ConnStatus, ConnType, BoolInt)
    :. ((ConnReqContact, ConnReqUriHash, Maybe ShortLinkContact,
         Maybe Int64, Maybe Int64)
        :. ((XContactId, Maybe Int64, BoolInt, Maybe GroupLinkId)
            :. (UTCTime, UTCTime, BoolInt, VersionChat, PQSupport,
                PQSupport))))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      INSERT INTO connections (
        user_id, agent_conn_id, conn_status, conn_type, contact_conn_initiated,
        via_contact_uri, via_contact_uri_hash, via_short_link_contact, contact_id, group_member_id,
        xcontact_id, custom_user_profile_id, via_group_link, group_link_id,
        created_at, updated_at, to_subscribe, conn_chat_version, pq_support, pq_encryption
      ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
    |]
    ( (Int64
userId, ConnId
acId, ConnStatus
connStatus, ConnType
connType, Bool -> BoolInt
BI Bool
True)
        (Int64, ConnId, ConnStatus, ConnType, BoolInt)
-> ((ConnReqContact, ConnReqUriHash, Maybe ShortLinkContact,
     Maybe Int64, Maybe Int64)
    :. ((XContactId, Maybe Int64, BoolInt, Maybe GroupLinkId)
        :. (UTCTime, UTCTime, BoolInt, VersionChat, PQSupport, PQSupport)))
-> (Int64, ConnId, ConnStatus, ConnType, BoolInt)
   :. ((ConnReqContact, ConnReqUriHash, Maybe ShortLinkContact,
        Maybe Int64, Maybe Int64)
       :. ((XContactId, Maybe Int64, BoolInt, Maybe GroupLinkId)
           :. (UTCTime, UTCTime, BoolInt, VersionChat, PQSupport, PQSupport)))
forall h t. h -> t -> h :. t
:. (ConnReqContact
cReq, ConnReqUriHash
cReqHash, Maybe ShortLinkContact
sLnk, Maybe Int64
contactId_, Maybe Int64
groupMemberId_)
        (ConnReqContact, ConnReqUriHash, Maybe ShortLinkContact,
 Maybe Int64, Maybe Int64)
-> ((XContactId, Maybe Int64, BoolInt, Maybe GroupLinkId)
    :. (UTCTime, UTCTime, BoolInt, VersionChat, PQSupport, PQSupport))
-> (ConnReqContact, ConnReqUriHash, Maybe ShortLinkContact,
    Maybe Int64, Maybe Int64)
   :. ((XContactId, Maybe Int64, BoolInt, Maybe GroupLinkId)
       :. (UTCTime, UTCTime, BoolInt, VersionChat, PQSupport, PQSupport))
forall h t. h -> t -> h :. t
:. (XContactId
xContactId, Maybe Int64
customUserProfileId, Bool -> BoolInt
BI (Maybe GroupLinkId -> Bool
forall a. Maybe a -> Bool
isJust Maybe GroupLinkId
groupLinkId), Maybe GroupLinkId
groupLinkId)
        (XContactId, Maybe Int64, BoolInt, Maybe GroupLinkId)
-> (UTCTime, UTCTime, BoolInt, VersionChat, PQSupport, PQSupport)
-> (XContactId, Maybe Int64, BoolInt, Maybe GroupLinkId)
   :. (UTCTime, UTCTime, BoolInt, VersionChat, PQSupport, PQSupport)
forall h t. h -> t -> h :. t
:. (UTCTime
currentTs, UTCTime
currentTs, Bool -> BoolInt
BI (SubscriptionMode
subMode SubscriptionMode -> SubscriptionMode -> Bool
forall a. Eq a => a -> a -> Bool
== SubscriptionMode
SMOnlyCreate), VersionChat
chatV, PQSupport
pqSup, PQSupport
pqSup)
    )
  Int64
connId <- Connection -> IO Int64
insertedRowId Connection
db
  case Maybe PreparedChatEntity
preparedEntity_ of
    Just (PCEGroup GroupInfo
gInfo GroupMember
_) -> GroupInfo -> Maybe Int64 -> UTCTime -> IO ()
updatePreparedGroup GroupInfo
gInfo Maybe Int64
customUserProfileId UTCTime
currentTs
    Maybe PreparedChatEntity
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  Connection -> IO Connection
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Connection
      { Int64
connId :: Int64
connId :: Int64
connId,
        agentConnId :: AgentConnId
agentConnId = ConnId -> AgentConnId
AgentConnId ConnId
acId,
        connChatVersion :: VersionChat
connChatVersion = VersionChat
chatV,
        -- TODO (proposed):
        -- - add agent version 8 for short links
        -- - update agentToChatVersion to convert 8 to 16
        -- - return and correctly set peer's range from link (via connRequestPQSupport)
        peerChatVRange :: VersionRangeChat
peerChatVRange = VersionRangeChat
chatInitialVRange, -- this is 1-1
        connLevel :: Int
connLevel = Int
0,
        viaContact :: Maybe Int64
viaContact = Maybe Int64
forall a. Maybe a
Nothing,
        viaUserContactLink :: Maybe Int64
viaUserContactLink = Maybe Int64
forall a. Maybe a
Nothing,
        viaGroupLink :: Bool
viaGroupLink = Maybe GroupLinkId -> Bool
forall a. Maybe a -> Bool
isJust Maybe GroupLinkId
groupLinkId,
        Maybe GroupLinkId
groupLinkId :: Maybe GroupLinkId
groupLinkId :: Maybe GroupLinkId
groupLinkId,
        xContactId :: Maybe XContactId
xContactId = XContactId -> Maybe XContactId
forall a. a -> Maybe a
Just XContactId
xContactId,
        Maybe Int64
customUserProfileId :: Maybe Int64
customUserProfileId :: Maybe Int64
customUserProfileId,
        ConnType
connType :: ConnType
connType :: ConnType
connType,
        ConnStatus
connStatus :: ConnStatus
connStatus :: ConnStatus
connStatus,
        contactConnInitiated :: Bool
contactConnInitiated = Bool
True,
        localAlias :: ContactName
localAlias = ContactName
"",
        Maybe Int64
entityId :: Maybe Int64
entityId :: Maybe Int64
entityId,
        connectionCode :: Maybe SecurityCode
connectionCode = Maybe SecurityCode
forall a. Maybe a
Nothing,
        pqSupport :: PQSupport
pqSupport = PQSupport
pqSup,
        pqEncryption :: PQEncryption
pqEncryption = PQSupport -> PQEncryption
CR.pqSupportToEnc PQSupport
pqSup,
        pqSndEnabled :: Maybe PQEncryption
pqSndEnabled = Maybe PQEncryption
forall a. Maybe a
Nothing,
        pqRcvEnabled :: Maybe PQEncryption
pqRcvEnabled = Maybe PQEncryption
forall a. Maybe a
Nothing,
        authErrCounter :: Int
authErrCounter = Int
0,
        quotaErrCounter :: Int
quotaErrCounter = Int
0,
        createdAt :: UTCTime
createdAt = UTCTime
currentTs
      }
  where
    (ConnType
connType, Maybe Int64
contactId_, Maybe Int64
groupMemberId_, Maybe Int64
entityId) = case Maybe PreparedChatEntity
preparedEntity_ of
      Just (PCEContact Contact {Int64
contactId :: Int64
contactId :: Contact -> Int64
contactId}) -> (ConnType
ConnContact, Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
contactId, Maybe Int64
forall a. Maybe a
Nothing, Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
contactId)
      Just (PCEGroup GroupInfo
_ GroupMember {Int64
groupMemberId :: Int64
groupMemberId :: GroupMember -> Int64
groupMemberId}) -> (ConnType
ConnMember, Maybe Int64
forall a. Maybe a
Nothing, Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
groupMemberId, Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
groupMemberId)
      Maybe PreparedChatEntity
Nothing -> (ConnType
ConnContact, Maybe Int64
forall a. Maybe a
Nothing, Maybe Int64
forall a. Maybe a
Nothing, Maybe Int64
forall a. Maybe a
Nothing)
    updatePreparedGroup :: GroupInfo -> Maybe Int64 -> UTCTime -> IO ()
updatePreparedGroup GroupInfo {Int64
groupId :: Int64
groupId :: GroupInfo -> Int64
groupId, GroupMember
membership :: GroupMember
membership :: GroupInfo -> GroupMember
membership} Maybe Int64
customUserProfileId UTCTime
currentTs = do
      Connection
-> Query
-> (ConnReqContact, ConnReqUriHash, BoolInt, UTCTime, Int64)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        Query
"UPDATE groups SET via_group_link_uri = ?, via_group_link_uri_hash = ?, conn_link_prepared_connection = ?, updated_at = ? WHERE group_id = ?"
        (ConnReqContact
cReq, ConnReqUriHash
cReqHash, Bool -> BoolInt
BI Bool
True, UTCTime
currentTs, Int64
groupId)
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Int64 -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int64
customUserProfileId) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Connection -> Query -> (Maybe Int64, UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
          Connection
db
          Query
"UPDATE group_members SET member_profile_id = ?, updated_at = ? WHERE group_member_id = ?"
          (Maybe Int64
customUserProfileId, UTCTime
currentTs, GroupMember -> Int64
groupMemberId' GroupMember
membership)

setPreparedGroupStartedConnection :: DB.Connection -> GroupId -> IO ()
setPreparedGroupStartedConnection :: Connection -> Int64 -> IO ()
setPreparedGroupStartedConnection Connection
db Int64
groupId = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection -> Query -> (BoolInt, UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"UPDATE groups SET conn_link_started_connection = ?, updated_at = ? WHERE group_id = ?"
    (Bool -> BoolInt
BI Bool
True, UTCTime
currentTs, Int64
groupId)

getConnReqContactXContactId :: DB.Connection -> VersionRangeChat -> User -> ConnReqUriHash -> ConnReqUriHash -> IO (Either (Maybe Connection) Contact)
getConnReqContactXContactId :: Connection
-> VersionRangeChat
-> User
-> ConnReqUriHash
-> ConnReqUriHash
-> IO (Either (Maybe Connection) Contact)
getConnReqContactXContactId Connection
db VersionRangeChat
vr user :: User
user@User {Int64
userId :: Int64
userId :: User -> Int64
userId} ConnReqUriHash
cReqHash1 ConnReqUriHash
cReqHash2 =
  Connection
-> VersionRangeChat
-> User
-> ConnReqUriHash
-> ConnReqUriHash
-> IO (Maybe Contact)
getContactByConnReqHash Connection
db VersionRangeChat
vr User
user ConnReqUriHash
cReqHash1 ConnReqUriHash
cReqHash2 IO (Maybe Contact)
-> (Maybe Contact -> IO (Either (Maybe Connection) Contact))
-> IO (Either (Maybe Connection) Contact)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Either (Maybe Connection) Contact)
-> (Contact -> IO (Either (Maybe Connection) Contact))
-> Maybe Contact
-> IO (Either (Maybe Connection) Contact)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Connection -> Either (Maybe Connection) Contact
forall a b. a -> Either a b
Left (Maybe Connection -> Either (Maybe Connection) Contact)
-> IO (Maybe Connection) -> IO (Either (Maybe Connection) Contact)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe Connection)
getConnection) (Either (Maybe Connection) Contact
-> IO (Either (Maybe Connection) Contact)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Maybe Connection) Contact
 -> IO (Either (Maybe Connection) Contact))
-> (Contact -> Either (Maybe Connection) Contact)
-> Contact
-> IO (Either (Maybe Connection) Contact)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contact -> Either (Maybe Connection) Contact
forall a b. b -> Either a b
Right)
  where
    getConnection :: IO (Maybe Connection)
    getConnection :: IO (Maybe Connection)
getConnection =
      (ConnectionRow -> Connection)
-> IO [ConnectionRow] -> IO (Maybe Connection)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow (VersionRangeChat -> ConnectionRow -> Connection
toConnection VersionRangeChat
vr) (IO [ConnectionRow] -> IO (Maybe Connection))
-> IO [ConnectionRow] -> IO (Maybe Connection)
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> (Int64, ConnReqUriHash, Int64, ConnReqUriHash)
-> IO [ConnectionRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT connection_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, group_link_id, xcontact_id, custom_user_profile_id, conn_status, conn_type, contact_conn_initiated, local_alias,
              contact_id, group_member_id, user_contact_link_id, created_at, security_code, security_code_verified_at, pq_support, pq_encryption, pq_snd_enabled, pq_rcv_enabled, auth_err_counter, quota_err_counter,
              conn_chat_version, peer_chat_min_version, peer_chat_max_version
            FROM connections
            WHERE (user_id = ? AND via_contact_uri_hash = ?)
               OR (user_id = ? AND via_contact_uri_hash = ?)
            LIMIT 1
          |]
          (Int64
userId, ConnReqUriHash
cReqHash1, Int64
userId, ConnReqUriHash
cReqHash2)

getContactByConnReqHash :: DB.Connection -> VersionRangeChat -> User -> ConnReqUriHash -> ConnReqUriHash -> IO (Maybe Contact)
getContactByConnReqHash :: Connection
-> VersionRangeChat
-> User
-> ConnReqUriHash
-> ConnReqUriHash
-> IO (Maybe Contact)
getContactByConnReqHash Connection
db VersionRangeChat
vr user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} ConnReqUriHash
cReqHash1 ConnReqUriHash
cReqHash2 = 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 -> [Int64] -> (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
-> (Int64, ConnReqUriHash, Int64, ConnReqUriHash, ContactStatus)
-> 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
          JOIN connections c ON c.contact_id = ct.contact_id
          WHERE
            ( (c.user_id = ? AND c.via_contact_uri_hash = ?) OR
              (c.user_id = ? AND c.via_contact_uri_hash = ?)
            ) AND ct.contact_status = ? AND ct.deleted = 0
        |]
        (Int64
userId, ConnReqUriHash
cReqHash1, Int64
userId, ConnReqUriHash
cReqHash2, ContactStatus
CSActive)
  (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

createDirectConnection' :: DB.Connection -> UserId -> ConnId -> CreatedLinkInvitation -> Maybe ContactId -> ConnStatus -> Maybe Profile -> SubscriptionMode -> VersionChat -> PQSupport -> IO Connection
createDirectConnection' :: Connection
-> Int64
-> ConnId
-> CreatedLinkInvitation
-> Maybe Int64
-> ConnStatus
-> Maybe Profile
-> SubscriptionMode
-> VersionChat
-> PQSupport
-> IO Connection
createDirectConnection' Connection
db Int64
userId ConnId
acId CreatedLinkInvitation
ccLink Maybe Int64
contactId_ ConnStatus
connStatus Maybe Profile
incognitoProfile SubscriptionMode
subMode VersionChat
chatV PQSupport
pqSup = do
  UTCTime
createdAt <- IO UTCTime
getCurrentTime
  (Int64
connId, Maybe Int64
customUserProfileId, Bool
contactConnInitiated) <- Connection
-> Int64
-> ConnId
-> CreatedLinkInvitation
-> Maybe Int64
-> ConnStatus
-> Maybe Profile
-> SubscriptionMode
-> VersionChat
-> PQSupport
-> UTCTime
-> IO (Int64, Maybe Int64, Bool)
createDirectConnection_ Connection
db Int64
userId ConnId
acId CreatedLinkInvitation
ccLink Maybe Int64
contactId_ ConnStatus
connStatus Maybe Profile
incognitoProfile SubscriptionMode
subMode VersionChat
chatV PQSupport
pqSup UTCTime
createdAt
  Connection -> IO Connection
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Connection
      { Int64
connId :: Int64
connId :: Int64
connId,
        agentConnId :: AgentConnId
agentConnId  = ConnId -> AgentConnId
AgentConnId ConnId
acId,
        connChatVersion :: VersionChat
connChatVersion = VersionChat
chatV,
        peerChatVRange :: VersionRangeChat
peerChatVRange = VersionRangeChat
chatInitialVRange, -- see comment in createConnReqConnection
        connLevel :: Int
connLevel = Int
0,
        viaContact :: Maybe Int64
viaContact = Maybe Int64
forall a. Maybe a
Nothing,
        viaUserContactLink :: Maybe Int64
viaUserContactLink = Maybe Int64
forall a. Maybe a
Nothing,
        viaGroupLink :: Bool
viaGroupLink = Bool
False,
        groupLinkId :: Maybe GroupLinkId
groupLinkId = Maybe GroupLinkId
forall a. Maybe a
Nothing,
        xContactId :: Maybe XContactId
xContactId = Maybe XContactId
forall a. Maybe a
Nothing,
        Maybe Int64
customUserProfileId :: Maybe Int64
customUserProfileId :: Maybe Int64
customUserProfileId,
        connType :: ConnType
connType = ConnType
ConnContact,
        ConnStatus
connStatus :: ConnStatus
connStatus :: ConnStatus
connStatus,
        Bool
contactConnInitiated :: Bool
contactConnInitiated :: Bool
contactConnInitiated,
        localAlias :: ContactName
localAlias = ContactName
"",
        entityId :: Maybe Int64
entityId = Maybe Int64
contactId_,
        connectionCode :: Maybe SecurityCode
connectionCode = Maybe SecurityCode
forall a. Maybe a
Nothing,
        pqSupport :: PQSupport
pqSupport = PQSupport
pqSup,
        pqEncryption :: PQEncryption
pqEncryption = PQSupport -> PQEncryption
CR.pqSupportToEnc PQSupport
pqSup,
        pqSndEnabled :: Maybe PQEncryption
pqSndEnabled = Maybe PQEncryption
forall a. Maybe a
Nothing,
        pqRcvEnabled :: Maybe PQEncryption
pqRcvEnabled = Maybe PQEncryption
forall a. Maybe a
Nothing,
        authErrCounter :: Int
authErrCounter = Int
0,
        quotaErrCounter :: Int
quotaErrCounter = Int
0,
        UTCTime
createdAt :: UTCTime
createdAt :: UTCTime
createdAt
      }

createDirectConnection :: DB.Connection -> User -> ConnId -> CreatedLinkInvitation -> Maybe ContactId -> ConnStatus -> Maybe Profile -> SubscriptionMode -> VersionChat -> PQSupport -> IO PendingContactConnection
createDirectConnection :: Connection
-> User
-> ConnId
-> CreatedLinkInvitation
-> Maybe Int64
-> ConnStatus
-> Maybe Profile
-> SubscriptionMode
-> VersionChat
-> PQSupport
-> IO PendingContactConnection
createDirectConnection Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} ConnId
acId CreatedLinkInvitation
ccLink Maybe Int64
contactId_ ConnStatus
pccConnStatus Maybe Profile
incognitoProfile SubscriptionMode
subMode VersionChat
chatV PQSupport
pqSup = do
  UTCTime
createdAt <- IO UTCTime
getCurrentTime
  (Int64
pccConnId, Maybe Int64
customUserProfileId, Bool
_) <- Connection
-> Int64
-> ConnId
-> CreatedLinkInvitation
-> Maybe Int64
-> ConnStatus
-> Maybe Profile
-> SubscriptionMode
-> VersionChat
-> PQSupport
-> UTCTime
-> IO (Int64, Maybe Int64, Bool)
createDirectConnection_ Connection
db Int64
userId ConnId
acId CreatedLinkInvitation
ccLink Maybe Int64
contactId_ ConnStatus
pccConnStatus Maybe Profile
incognitoProfile SubscriptionMode
subMode VersionChat
chatV PQSupport
pqSup UTCTime
createdAt
  PendingContactConnection -> IO PendingContactConnection
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PendingContactConnection {Int64
pccConnId :: Int64
pccConnId :: Int64
pccConnId, pccAgentConnId :: AgentConnId
pccAgentConnId = ConnId -> AgentConnId
AgentConnId ConnId
acId, ConnStatus
pccConnStatus :: ConnStatus
pccConnStatus :: ConnStatus
pccConnStatus, viaContactUri :: Bool
viaContactUri = Bool
False, viaUserContactLink :: Maybe Int64
viaUserContactLink = Maybe Int64
forall a. Maybe a
Nothing, groupLinkId :: Maybe GroupLinkId
groupLinkId = Maybe GroupLinkId
forall a. Maybe a
Nothing, Maybe Int64
customUserProfileId :: Maybe Int64
customUserProfileId :: Maybe Int64
customUserProfileId, connLinkInv :: Maybe CreatedLinkInvitation
connLinkInv = CreatedLinkInvitation -> Maybe CreatedLinkInvitation
forall a. a -> Maybe a
Just CreatedLinkInvitation
ccLink, localAlias :: ContactName
localAlias = ContactName
"", UTCTime
createdAt :: UTCTime
createdAt :: UTCTime
createdAt, updatedAt :: UTCTime
updatedAt = UTCTime
createdAt}

createDirectConnection_ :: DB.Connection -> UserId -> ConnId -> CreatedLinkInvitation -> Maybe ContactId -> ConnStatus -> Maybe Profile -> SubscriptionMode -> VersionChat -> PQSupport -> UTCTime -> IO (Int64, Maybe Int64, Bool)
createDirectConnection_ :: Connection
-> Int64
-> ConnId
-> CreatedLinkInvitation
-> Maybe Int64
-> ConnStatus
-> Maybe Profile
-> SubscriptionMode
-> VersionChat
-> PQSupport
-> UTCTime
-> IO (Int64, Maybe Int64, Bool)
createDirectConnection_ Connection
db Int64
userId ConnId
acId (CCLink ConnReqInvitation
cReq Maybe ShortLinkInvitation
shortLinkInv) Maybe Int64
contactId_ ConnStatus
pccConnStatus Maybe Profile
incognitoProfile SubscriptionMode
subMode VersionChat
chatV PQSupport
pqSup UTCTime
createdAt = do
  Maybe Int64
customUserProfileId <- (Profile -> IO Int64) -> Maybe Profile -> IO (Maybe Int64)
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 -> Int64 -> UTCTime -> Profile -> IO Int64
createIncognitoProfile_ Connection
db Int64
userId UTCTime
createdAt) Maybe Profile
incognitoProfile
  let contactConnInitiated :: Bool
contactConnInitiated = ConnStatus
pccConnStatus ConnStatus -> ConnStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ConnStatus
ConnNew
  Connection
-> Query
-> ((Int64, ConnId, ConnReqInvitation, Maybe ShortLinkInvitation,
     ConnStatus, ConnType, Maybe Int64, BoolInt, Maybe Int64)
    :. (UTCTime, UTCTime, BoolInt, VersionChat, PQSupport, PQSupport))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      INSERT INTO connections
        (user_id, agent_conn_id, conn_req_inv, short_link_inv, conn_status, conn_type, contact_id, contact_conn_initiated, custom_user_profile_id,
         created_at, updated_at, to_subscribe, conn_chat_version, pq_support, pq_encryption)
      VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
    |]
    ( (Int64
userId, ConnId
acId, ConnReqInvitation
cReq, Maybe ShortLinkInvitation
shortLinkInv, ConnStatus
pccConnStatus, ConnType
ConnContact, Maybe Int64
contactId_, Bool -> BoolInt
BI Bool
contactConnInitiated, Maybe Int64
customUserProfileId)
        (Int64, ConnId, ConnReqInvitation, Maybe ShortLinkInvitation,
 ConnStatus, ConnType, Maybe Int64, BoolInt, Maybe Int64)
-> (UTCTime, UTCTime, BoolInt, VersionChat, PQSupport, PQSupport)
-> (Int64, ConnId, ConnReqInvitation, Maybe ShortLinkInvitation,
    ConnStatus, ConnType, Maybe Int64, BoolInt, Maybe Int64)
   :. (UTCTime, UTCTime, BoolInt, VersionChat, PQSupport, PQSupport)
forall h t. h -> t -> h :. t
:. (UTCTime
createdAt, UTCTime
createdAt, Bool -> BoolInt
BI (SubscriptionMode
subMode SubscriptionMode -> SubscriptionMode -> Bool
forall a. Eq a => a -> a -> Bool
== SubscriptionMode
SMOnlyCreate), VersionChat
chatV, PQSupport
pqSup, PQSupport
pqSup)
    )
  Int64
connId <- Connection -> IO Int64
insertedRowId Connection
db
  (Int64, Maybe Int64, Bool) -> IO (Int64, Maybe Int64, Bool)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64
connId, Maybe Int64
customUserProfileId, Bool
contactConnInitiated)

createIncognitoProfile :: DB.Connection -> User -> Profile -> IO Int64
createIncognitoProfile :: Connection -> User -> Profile -> IO Int64
createIncognitoProfile Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} Profile
p = do
  UTCTime
createdAt <- IO UTCTime
getCurrentTime
  Connection -> Int64 -> UTCTime -> Profile -> IO Int64
createIncognitoProfile_ Connection
db Int64
userId UTCTime
createdAt Profile
p

createPreparedContact :: DB.Connection -> VersionRangeChat -> User -> Profile -> ACreatedConnLink -> Maybe SharedMsgId -> ExceptT StoreError IO Contact
createPreparedContact :: Connection
-> VersionRangeChat
-> User
-> Profile
-> ACreatedConnLink
-> Maybe SharedMsgId
-> ExceptT StoreError IO Contact
createPreparedContact Connection
db VersionRangeChat
vr User
user Profile
p ACreatedConnLink
connLinkToConnect Maybe SharedMsgId
welcomeSharedMsgId = 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
  let prepared :: Maybe (ACreatedConnLink, Maybe SharedMsgId)
prepared = (ACreatedConnLink, Maybe SharedMsgId)
-> Maybe (ACreatedConnLink, Maybe SharedMsgId)
forall a. a -> Maybe a
Just (ACreatedConnLink
connLinkToConnect, Maybe SharedMsgId
welcomeSharedMsgId)
      ctUserPreferences :: Preferences
ctUserPreferences = User -> Profile -> Preferences
newContactUserPrefs User
user Profile
p
  Int64
contactId <- Connection
-> User
-> Profile
-> Preferences
-> Maybe (ACreatedConnLink, Maybe SharedMsgId)
-> ContactName
-> UTCTime
-> ExceptT StoreError IO Int64
createContact_ Connection
db User
user Profile
p Preferences
ctUserPreferences Maybe (ACreatedConnLink, Maybe SharedMsgId)
prepared ContactName
"" UTCTime
currentTs
  Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId

updatePreparedContactUser :: DB.Connection -> VersionRangeChat -> User -> Contact -> User -> ExceptT StoreError IO Contact
updatePreparedContactUser :: Connection
-> VersionRangeChat
-> User
-> Contact
-> User
-> ExceptT StoreError IO Contact
updatePreparedContactUser
  Connection
db
  VersionRangeChat
vr
  User
user
  Contact {Int64
contactId :: Contact -> Int64
contactId :: Int64
contactId, localDisplayName :: Contact -> ContactName
localDisplayName = ContactName
oldLDN, profile :: Contact -> LocalProfile
profile = profile :: LocalProfile
profile@LocalProfile {Int64
profileId :: Int64
profileId :: LocalProfile -> Int64
profileId, ContactName
displayName :: ContactName
displayName :: LocalProfile -> ContactName
displayName}}
  newUser :: User
newUser@User {userId :: User -> Int64
userId = Int64
newUserId} = do
    IO (Either StoreError Contact) -> ExceptT StoreError IO Contact
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError Contact) -> ExceptT StoreError IO Contact)
-> ((ContactName -> IO (Either StoreError Contact))
    -> IO (Either StoreError Contact))
-> (ContactName -> IO (Either StoreError Contact))
-> ExceptT StoreError IO Contact
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> Int64
-> ContactName
-> (ContactName -> IO (Either StoreError Contact))
-> IO (Either StoreError Contact)
forall a.
Connection
-> Int64
-> ContactName
-> (ContactName -> IO (Either StoreError a))
-> IO (Either StoreError a)
withLocalDisplayName Connection
db Int64
newUserId ContactName
displayName ((ContactName -> IO (Either StoreError Contact))
 -> ExceptT StoreError IO Contact)
-> (ContactName -> IO (Either StoreError Contact))
-> ExceptT StoreError IO Contact
forall a b. (a -> b) -> a -> b
$ \ContactName
newLDN -> ExceptT StoreError IO Contact -> IO (Either StoreError Contact)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO Contact -> IO (Either StoreError Contact))
-> ExceptT StoreError IO Contact -> IO (Either StoreError Contact)
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
        UTCTime
currentTs <- IO UTCTime
getCurrentTime
        let ctUserPreferences :: Preferences
ctUserPreferences = User -> Profile -> Preferences
newContactUserPrefs User
newUser (LocalProfile -> Profile
fromLocalProfile LocalProfile
profile)
        Connection
-> Query
-> (Int64, ContactName, Preferences, UTCTime, Int64)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
          Connection
db
          [sql|
            UPDATE contacts
            SET user_id = ?, local_display_name = ?, user_preferences = ?, updated_at = ?
            WHERE contact_id = ?
          |]
          (Int64
newUserId, ContactName
newLDN, Preferences
ctUserPreferences, UTCTime
currentTs, Int64
contactId)
        Connection -> Query -> (Int64, UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
          Connection
db
          [sql|
            UPDATE contact_profiles
            SET user_id = ?, updated_at = ?
            WHERE contact_profile_id = ?
          |]
          (Int64
newUserId, UTCTime
currentTs, Int64
profileId)
        Connection -> User -> ContactName -> IO ()
safeDeleteLDN Connection
db User
user ContactName
oldLDN
      Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
newUser Int64
contactId

createDirectContact :: DB.Connection -> VersionRangeChat -> User -> Connection -> Profile -> ExceptT StoreError IO Contact
createDirectContact :: Connection
-> VersionRangeChat
-> User
-> Connection
-> Profile
-> ExceptT StoreError IO Contact
createDirectContact Connection
db VersionRangeChat
vr User
user Connection {Int64
connId :: Connection -> Int64
connId :: Int64
connId, ContactName
localAlias :: Connection -> ContactName
localAlias :: ContactName
localAlias} Profile
p = 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
  let ctUserPreferences :: Preferences
ctUserPreferences = User -> Profile -> Preferences
newContactUserPrefs User
user Profile
p
  Int64
contactId <- Connection
-> User
-> Profile
-> Preferences
-> Maybe (ACreatedConnLink, Maybe SharedMsgId)
-> ContactName
-> UTCTime
-> ExceptT StoreError IO Int64
createContact_ Connection
db User
user Profile
p Preferences
ctUserPreferences Maybe (ACreatedConnLink, Maybe SharedMsgId)
forall a. Maybe a
Nothing ContactName
localAlias UTCTime
currentTs
  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 -> (Int64, UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (Int64
contactId, UTCTime
currentTs, Int64
connId)
  Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId

deleteContactConnections :: DB.Connection -> User -> Contact -> IO ()
deleteContactConnections :: Connection -> User -> Contact -> IO ()
deleteContactConnections Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} Contact {Int64
contactId :: Contact -> Int64
contactId :: Int64
contactId} = do
  Connection -> Query -> (Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      DELETE FROM connections WHERE connection_id IN (
        SELECT connection_id
        FROM connections c
        JOIN contacts ct ON ct.contact_id = c.contact_id
        WHERE ct.user_id = ? AND ct.contact_id = ?
      )
    |]
    (Int64
userId, Int64
contactId)

deleteContactFiles :: DB.Connection -> User -> Contact -> IO ()
deleteContactFiles :: Connection -> User -> Contact -> IO ()
deleteContactFiles Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} Contact {Int64
contactId :: Contact -> Int64
contactId :: Int64
contactId} = do
  Connection -> Query -> (Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM files WHERE user_id = ? AND contact_id = ?" (Int64
userId, Int64
contactId)

deleteContact :: DB.Connection -> User -> Contact -> ExceptT StoreError IO ()
deleteContact :: Connection -> User -> Contact -> ExceptT StoreError IO ()
deleteContact Connection
db user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} ct :: Contact
ct@Contact {Int64
contactId :: Contact -> Int64
contactId :: Int64
contactId, ContactName
localDisplayName :: Contact -> ContactName
localDisplayName :: ContactName
localDisplayName, Maybe Connection
activeConn :: Maybe Connection
activeConn :: Contact -> Maybe Connection
activeConn} = do
  Connection -> User -> Contact -> ExceptT StoreError IO ()
assertNotUser Connection
db User
user Contact
ct
  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 -> (Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM chat_items WHERE user_id = ? AND contact_id = ?" (Int64
userId, Int64
contactId)
    Maybe Int64
ctMember :: (Maybe ContactId) <- (Only Int64 -> Int64) -> IO [Only Int64] -> IO (Maybe Int64)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only Int64 -> Int64
forall a. Only a -> a
fromOnly (IO [Only Int64] -> IO (Maybe Int64))
-> IO [Only Int64] -> IO (Maybe Int64)
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> Only Int64 -> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT contact_id FROM group_members WHERE contact_id = ? LIMIT 1" (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
contactId)
    if Maybe Int64 -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int64
ctMember
      then do
        Connection -> Int64 -> Int64 -> IO ()
deleteContactProfile_ Connection
db Int64
userId Int64
contactId
        -- user's local display name already checked in assertNotUser
        Connection -> Query -> (Int64, ContactName) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (Int64
userId, ContactName
localDisplayName)
      else do
        UTCTime
currentTs <- IO UTCTime
getCurrentTime
        Connection -> Query -> (UTCTime, Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE group_members SET contact_id = NULL, updated_at = ? WHERE user_id = ? AND contact_id = ?" (UTCTime
currentTs, Int64
userId, Int64
contactId)
    Connection -> Query -> (Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM contacts WHERE user_id = ? AND contact_id = ?" (Int64
userId, Int64
contactId)
    Maybe Connection -> (Connection -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Connection
activeConn ((Connection -> IO ()) -> IO ()) -> (Connection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connection {Maybe Int64
customUserProfileId :: Connection -> Maybe Int64
customUserProfileId :: Maybe Int64
customUserProfileId} ->
      Maybe Int64 -> (Int64 -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Int64
customUserProfileId ((Int64 -> IO ()) -> IO ()) -> (Int64 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int64
profileId ->
        Connection -> User -> Int64 -> IO ()
deleteUnusedIncognitoProfileById_ Connection
db User
user Int64
profileId

-- should only be used if contact is not member of any groups
deleteContactWithoutGroups :: DB.Connection -> User -> Contact -> ExceptT StoreError IO ()
deleteContactWithoutGroups :: Connection -> User -> Contact -> ExceptT StoreError IO ()
deleteContactWithoutGroups Connection
db user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} ct :: Contact
ct@Contact {Int64
contactId :: Contact -> Int64
contactId :: Int64
contactId, ContactName
localDisplayName :: Contact -> ContactName
localDisplayName :: ContactName
localDisplayName, Maybe Connection
activeConn :: Contact -> Maybe Connection
activeConn :: Maybe Connection
activeConn} = do
  Connection -> User -> Contact -> ExceptT StoreError IO ()
assertNotUser Connection
db User
user Contact
ct
  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 -> (Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM chat_items WHERE user_id = ? AND contact_id = ?" (Int64
userId, Int64
contactId)
    Connection -> Int64 -> Int64 -> IO ()
deleteContactProfile_ Connection
db Int64
userId Int64
contactId
    -- user's local display name already checked in assertNotUser
    Connection -> Query -> (Int64, ContactName) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (Int64
userId, ContactName
localDisplayName)
    Connection -> Query -> (Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM contacts WHERE user_id = ? AND contact_id = ?" (Int64
userId, Int64
contactId)
    Maybe Connection -> (Connection -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Connection
activeConn ((Connection -> IO ()) -> IO ()) -> (Connection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connection {Maybe Int64
customUserProfileId :: Connection -> Maybe Int64
customUserProfileId :: Maybe Int64
customUserProfileId} ->
      Maybe Int64 -> (Int64 -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Int64
customUserProfileId ((Int64 -> IO ()) -> IO ()) -> (Int64 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int64
profileId ->
        Connection -> User -> Int64 -> IO ()
deleteUnusedIncognitoProfileById_ Connection
db User
user Int64
profileId

-- TODO remove in future versions: only used for legacy contact cleanup
getDeletedContacts :: DB.Connection -> VersionRangeChat -> User -> IO [Contact]
getDeletedContacts :: Connection -> VersionRangeChat -> User -> IO [Contact]
getDeletedContacts Connection
db VersionRangeChat
vr user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} = do
  [Int64]
contactIds <- (Only Int64 -> Int64) -> [Only Int64] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
map Only Int64 -> Int64
forall a. Only a -> a
fromOnly ([Only Int64] -> [Int64]) -> IO [Only Int64] -> IO [Int64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> Only Int64 -> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT contact_id FROM contacts WHERE user_id = ? AND deleted = 1" (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
userId)
  [Either StoreError Contact] -> [Contact]
forall a b. [Either a b] -> [b]
rights ([Either StoreError Contact] -> [Contact])
-> IO [Either StoreError Contact] -> IO [Contact]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int64 -> IO (Either StoreError Contact))
-> [Int64] -> IO [Either StoreError 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) -> [a] -> m [b]
mapM (ExceptT StoreError IO Contact -> IO (Either StoreError Contact)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO Contact -> IO (Either StoreError Contact))
-> (Int64 -> ExceptT StoreError IO Contact)
-> Int64
-> IO (Either StoreError Contact)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getDeletedContact Connection
db VersionRangeChat
vr User
user) [Int64]
contactIds

getDeletedContact :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO Contact
getDeletedContact :: Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getDeletedContact Connection
db VersionRangeChat
vr User
user Int64
contactId = Connection
-> VersionRangeChat
-> User
-> Int64
-> Bool
-> ExceptT StoreError IO Contact
getContact_ Connection
db VersionRangeChat
vr User
user Int64
contactId Bool
True

deleteContactProfile_ :: DB.Connection -> UserId -> ContactId -> IO ()
deleteContactProfile_ :: Connection -> Int64 -> Int64 -> IO ()
deleteContactProfile_ Connection
db Int64
userId Int64
contactId =
  Connection -> Query -> (Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      DELETE FROM contact_profiles
      WHERE contact_profile_id in (
        SELECT contact_profile_id
        FROM contacts
        WHERE user_id = ? AND contact_id = ?
      )
    |]
    (Int64
userId, Int64
contactId)

deleteUnusedProfile_ :: DB.Connection -> UserId -> ProfileId -> IO ()
deleteUnusedProfile_ :: Connection -> Int64 -> Int64 -> IO ()
deleteUnusedProfile_ Connection
db Int64
userId Int64
profileId =
  Connection
-> Query
-> ((Int64, Int64, Int64, Int64, Int64, Int64)
    :. (Int64, Int64, Int64, Int64, Int64))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      DELETE FROM contact_profiles
      WHERE user_id = ? AND contact_profile_id = ?
        AND 1 NOT IN (
          SELECT 1 FROM connections
          WHERE user_id = ? AND custom_user_profile_id = ? LIMIT 1
        )
        AND 1 NOT IN (
          SELECT 1 FROM contacts
          WHERE user_id = ? AND contact_profile_id = ? LIMIT 1
        )
        AND 1 NOT IN (
          SELECT 1 FROM contact_requests
          WHERE user_id = ? AND contact_profile_id = ? LIMIT 1
        )
        AND 1 NOT IN (
          SELECT 1 FROM group_members
          WHERE user_id = ?
            AND (member_profile_id = ? OR contact_profile_id = ?)
          LIMIT 1
        )
    |]
    ( (Int64
userId, Int64
profileId, Int64
userId, Int64
profileId, Int64
userId, Int64
profileId)
        (Int64, Int64, Int64, Int64, Int64, Int64)
-> (Int64, Int64, Int64, Int64, Int64)
-> (Int64, Int64, Int64, Int64, Int64, Int64)
   :. (Int64, Int64, Int64, Int64, Int64)
forall h t. h -> t -> h :. t
:. (Int64
userId, Int64
profileId, Int64
userId, Int64
profileId, Int64
profileId)
    )

updateContactProfile :: DB.Connection -> User -> Contact -> Profile -> ExceptT StoreError IO Contact
updateContactProfile :: Connection
-> User -> Contact -> Profile -> ExceptT StoreError IO Contact
updateContactProfile Connection
db user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} Contact
c Profile
p'
  | ContactName
displayName ContactName -> ContactName -> Bool
forall a. Eq a => a -> a -> Bool
== ContactName
newName = 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 -> Int64 -> Int64 -> Profile -> IO ()
updateContactProfile_ Connection
db Int64
userId Int64
profileId Profile
p'
      Contact -> ExceptT StoreError IO Contact
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Contact
c {profile, mergedPreferences}
  | Bool
otherwise =
      IO (Either StoreError Contact) -> ExceptT StoreError IO Contact
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError Contact) -> ExceptT StoreError IO Contact)
-> ((ContactName -> IO (Either StoreError Contact))
    -> IO (Either StoreError Contact))
-> (ContactName -> IO (Either StoreError Contact))
-> ExceptT StoreError IO Contact
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> Int64
-> ContactName
-> (ContactName -> IO (Either StoreError Contact))
-> IO (Either StoreError Contact)
forall a.
Connection
-> Int64
-> ContactName
-> (ContactName -> IO (Either StoreError a))
-> IO (Either StoreError a)
withLocalDisplayName Connection
db Int64
userId ContactName
newName ((ContactName -> IO (Either StoreError Contact))
 -> ExceptT StoreError IO Contact)
-> (ContactName -> IO (Either StoreError Contact))
-> ExceptT StoreError IO Contact
forall a b. (a -> b) -> a -> b
$ \ContactName
ldn -> do
        UTCTime
currentTs <- IO UTCTime
getCurrentTime
        Connection -> Int64 -> Int64 -> Profile -> UTCTime -> IO ()
updateContactProfile_' Connection
db Int64
userId Int64
profileId Profile
p' UTCTime
currentTs
        Connection
-> User -> Int64 -> ContactName -> ContactName -> UTCTime -> IO ()
updateContactLDN_ Connection
db User
user Int64
contactId ContactName
localDisplayName ContactName
ldn UTCTime
currentTs
        Either StoreError Contact -> IO (Either StoreError Contact)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError Contact -> IO (Either StoreError Contact))
-> Either StoreError Contact -> IO (Either StoreError Contact)
forall a b. (a -> b) -> a -> b
$ Contact -> Either StoreError Contact
forall a b. b -> Either a b
Right Contact
c {localDisplayName = ldn, profile, mergedPreferences}
  where
    Contact {Int64
contactId :: Contact -> Int64
contactId :: Int64
contactId, ContactName
localDisplayName :: Contact -> ContactName
localDisplayName :: ContactName
localDisplayName, profile :: Contact -> LocalProfile
profile = LocalProfile {Int64
profileId :: LocalProfile -> Int64
profileId :: Int64
profileId, ContactName
displayName :: LocalProfile -> ContactName
displayName :: ContactName
displayName, ContactName
localAlias :: ContactName
localAlias :: LocalProfile -> ContactName
localAlias}, Preferences
userPreferences :: Preferences
userPreferences :: Contact -> Preferences
userPreferences} = Contact
c
    Profile {displayName :: Profile -> ContactName
displayName = ContactName
newName, Maybe Preferences
preferences :: Maybe Preferences
preferences :: Profile -> Maybe Preferences
preferences} = Profile
p'
    profile :: LocalProfile
profile = Int64 -> Profile -> ContactName -> LocalProfile
toLocalProfile Int64
profileId Profile
p' ContactName
localAlias
    mergedPreferences :: ContactUserPreferences
mergedPreferences = User
-> Preferences
-> Maybe Preferences
-> Bool
-> ContactUserPreferences
contactUserPreferences User
user Preferences
userPreferences Maybe Preferences
preferences (Bool -> ContactUserPreferences) -> Bool -> ContactUserPreferences
forall a b. (a -> b) -> a -> b
$ Contact -> Bool
contactConnIncognito Contact
c

updateContactUserPreferences :: DB.Connection -> User -> Contact -> Preferences -> IO Contact
updateContactUserPreferences :: Connection -> User -> Contact -> Preferences -> IO Contact
updateContactUserPreferences Connection
db user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} c :: Contact
c@Contact {Int64
contactId :: Contact -> Int64
contactId :: Int64
contactId} Preferences
userPreferences = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection
-> Query -> (Preferences, UTCTime, Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"UPDATE contacts SET user_preferences = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?"
    (Preferences
userPreferences, UTCTime
updatedAt, Int64
userId, Int64
contactId)
  let mergedPreferences :: ContactUserPreferences
mergedPreferences = User
-> Preferences
-> Maybe Preferences
-> Bool
-> ContactUserPreferences
contactUserPreferences User
user Preferences
userPreferences (Contact -> Maybe Preferences
forall a. IsContact a => a -> Maybe Preferences
preferences' Contact
c) (Bool -> ContactUserPreferences) -> Bool -> ContactUserPreferences
forall a b. (a -> b) -> a -> b
$ Contact -> Bool
contactConnIncognito Contact
c
  Contact -> IO Contact
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Contact -> IO Contact) -> Contact -> IO Contact
forall a b. (a -> b) -> a -> b
$ Contact
c {mergedPreferences, userPreferences}

updateContactAlias :: DB.Connection -> UserId -> Contact -> LocalAlias -> IO Contact
updateContactAlias :: Connection -> Int64 -> Contact -> ContactName -> IO Contact
updateContactAlias Connection
db Int64
userId c :: Contact
c@Contact {profile :: Contact -> LocalProfile
profile = lp :: LocalProfile
lp@LocalProfile {Int64
profileId :: LocalProfile -> Int64
profileId :: Int64
profileId}} ContactName
localAlias = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection
-> Query -> (ContactName, UTCTime, Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE contact_profiles
      SET local_alias = ?, updated_at = ?
      WHERE user_id = ? AND contact_profile_id = ?
    |]
    (ContactName
localAlias, UTCTime
updatedAt, Int64
userId, Int64
profileId)
  Contact -> IO Contact
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Contact -> IO Contact) -> Contact -> IO Contact
forall a b. (a -> b) -> a -> b
$ (Contact
c :: Contact) {profile = lp {localAlias}}

updateContactConnectionAlias :: DB.Connection -> UserId -> PendingContactConnection -> LocalAlias -> IO PendingContactConnection
updateContactConnectionAlias :: Connection
-> Int64
-> PendingContactConnection
-> ContactName
-> IO PendingContactConnection
updateContactConnectionAlias Connection
db Int64
userId PendingContactConnection
conn ContactName
localAlias = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection
-> Query -> (ContactName, UTCTime, Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE connections
      SET local_alias = ?, updated_at = ?
      WHERE user_id = ? AND connection_id = ?
    |]
    (ContactName
localAlias, UTCTime
updatedAt, Int64
userId, PendingContactConnection -> Int64
pccConnId PendingContactConnection
conn)
  PendingContactConnection -> IO PendingContactConnection
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PendingContactConnection
conn :: PendingContactConnection) {localAlias, updatedAt}

updatePCCIncognito :: DB.Connection -> User -> PendingContactConnection -> Maybe ProfileId -> Maybe ShortLinkInvitation -> IO PendingContactConnection
updatePCCIncognito :: Connection
-> User
-> PendingContactConnection
-> Maybe Int64
-> Maybe ShortLinkInvitation
-> IO PendingContactConnection
updatePCCIncognito Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} conn :: PendingContactConnection
conn@PendingContactConnection {Maybe CreatedLinkInvitation
connLinkInv :: PendingContactConnection -> Maybe CreatedLinkInvitation
connLinkInv :: Maybe CreatedLinkInvitation
connLinkInv} Maybe Int64
customUserProfileId Maybe ShortLinkInvitation
sLnk = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection
-> Query
-> (Maybe Int64, Maybe ShortLinkInvitation, UTCTime, Int64, Int64)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE connections
      SET custom_user_profile_id = ?, short_link_inv = ?, updated_at = ?
      WHERE user_id = ? AND connection_id = ?
    |]
    (Maybe Int64
customUserProfileId, Maybe ShortLinkInvitation
sLnk, UTCTime
updatedAt, Int64
userId, PendingContactConnection -> Int64
pccConnId PendingContactConnection
conn)
  PendingContactConnection -> IO PendingContactConnection
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PendingContactConnection
conn :: PendingContactConnection) {customUserProfileId, connLinkInv = connLinkInv', updatedAt}
  where
    connLinkInv' :: Maybe CreatedLinkInvitation
connLinkInv' = case Maybe CreatedLinkInvitation
connLinkInv of
      Just (CCLink ConnReqInvitation
cReq Maybe ShortLinkInvitation
_) -> CreatedLinkInvitation -> Maybe CreatedLinkInvitation
forall a. a -> Maybe a
Just (ConnReqInvitation
-> Maybe ShortLinkInvitation -> CreatedLinkInvitation
forall (m :: ConnectionMode).
ConnectionRequestUri m
-> Maybe (ConnShortLink m) -> CreatedConnLink m
CCLink ConnReqInvitation
cReq Maybe ShortLinkInvitation
sLnk)
      Maybe CreatedLinkInvitation
Nothing -> Maybe CreatedLinkInvitation
forall a. Maybe a
Nothing

deletePCCIncognitoProfile :: DB.Connection -> User -> ProfileId -> IO ()
deletePCCIncognitoProfile :: Connection -> User -> Int64 -> IO ()
deletePCCIncognitoProfile Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} Int64
profileId =
  Connection -> Query -> (Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      DELETE FROM contact_profiles
      WHERE user_id = ? AND contact_profile_id = ? AND incognito = 1
    |]
    (Int64
userId, Int64
profileId)

updateContactUnreadChat :: DB.Connection -> User -> Contact -> Bool -> IO ()
updateContactUnreadChat :: Connection -> User -> Contact -> Bool -> IO ()
updateContactUnreadChat Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} Contact {Int64
contactId :: Contact -> Int64
contactId :: Int64
contactId} Bool
unreadChat = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection -> Query -> (BoolInt, UTCTime, Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE contacts SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" (Bool -> BoolInt
BI Bool
unreadChat, UTCTime
updatedAt, Int64
userId, Int64
contactId)

setUserChatsRead :: DB.Connection -> User -> IO ()
setUserChatsRead :: Connection -> User -> IO ()
setUserChatsRead Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection -> Query -> (BoolInt, UTCTime, Int64, BoolInt) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE contacts SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND unread_chat = ?" (Bool -> BoolInt
BI Bool
False, UTCTime
updatedAt, Int64
userId, Bool -> BoolInt
BI Bool
True)
  Connection -> Query -> (BoolInt, UTCTime, Int64, BoolInt) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE groups SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND unread_chat = ?" (Bool -> BoolInt
BI Bool
False, UTCTime
updatedAt, Int64
userId, Bool -> BoolInt
BI Bool
True)
  Connection -> Query -> (BoolInt, UTCTime, Int64, BoolInt) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE note_folders SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND unread_chat = ?" (Bool -> BoolInt
BI Bool
False, UTCTime
updatedAt, Int64
userId, Bool -> BoolInt
BI Bool
True)
  Connection
-> Query
-> (CIStatus 'MDRcv, UTCTime, Int64, CIStatus 'MDRcv)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE chat_items SET item_status = ?, updated_at = ? WHERE user_id = ? AND item_status = ?" (CIStatus 'MDRcv
CISRcvRead, UTCTime
updatedAt, Int64
userId, CIStatus 'MDRcv
CISRcvNew)

updateContactStatus :: DB.Connection -> User -> Contact -> ContactStatus -> IO Contact
updateContactStatus :: Connection -> User -> Contact -> ContactStatus -> IO Contact
updateContactStatus Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} ct :: Contact
ct@Contact {Int64
contactId :: Contact -> Int64
contactId :: Int64
contactId} ContactStatus
contactStatus = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection
-> Query -> (ContactStatus, UTCTime, Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE contacts
      SET contact_status = ?, updated_at = ?
      WHERE user_id = ? AND contact_id = ?
    |]
    (ContactStatus
contactStatus, UTCTime
currentTs, Int64
userId, Int64
contactId)
  Contact -> IO Contact
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Contact
ct {contactStatus}

updateGroupUnreadChat :: DB.Connection -> User -> GroupInfo -> Bool -> IO ()
updateGroupUnreadChat :: Connection -> User -> GroupInfo -> Bool -> IO ()
updateGroupUnreadChat Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} GroupInfo {Int64
groupId :: GroupInfo -> Int64
groupId :: Int64
groupId} Bool
unreadChat = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection -> Query -> (BoolInt, UTCTime, Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE groups SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND group_id = ?" (Bool -> BoolInt
BI Bool
unreadChat, UTCTime
updatedAt, Int64
userId, Int64
groupId)

setConnectionVerified :: DB.Connection -> User -> Int64 -> Maybe Text -> IO ()
setConnectionVerified :: Connection -> User -> Int64 -> Maybe ContactName -> IO ()
setConnectionVerified Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} Int64
connId Maybe ContactName
code = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection
-> Query
-> (Maybe ContactName, Maybe UTCTime, UTCTime, Int64, Int64)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE connections SET security_code = ?, security_code_verified_at = ?, updated_at = ? WHERE user_id = ? AND connection_id = ?" (Maybe ContactName
code, Maybe ContactName
code Maybe ContactName -> UTCTime -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> UTCTime
updatedAt, UTCTime
updatedAt, Int64
userId, Int64
connId)

incAuthErrCounter :: DB.Connection -> User -> Connection -> IO Int
incAuthErrCounter :: Connection -> User -> Connection -> IO Int
incAuthErrCounter Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} Connection {Int64
connId :: Connection -> Int64
connId :: Int64
connId, Int
authErrCounter :: Connection -> Int
authErrCounter :: Int
authErrCounter} = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  (Maybe Int
counter_ :: Maybe Int) <- (Only Int -> Int) -> IO [Only Int] -> IO (Maybe Int)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only Int -> Int
forall a. Only a -> a
fromOnly (IO [Only Int] -> IO (Maybe Int))
-> IO [Only Int] -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> (Int64, Int64) -> IO [Only Int]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT auth_err_counter FROM connections WHERE user_id = ? AND connection_id = ?" (Int64
userId, Int64
connId)
  let counter' :: Int
counter' = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
authErrCounter Maybe Int
counter_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  Connection -> Query -> (Int, UTCTime, Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE connections SET auth_err_counter = ?, updated_at = ? WHERE user_id = ? AND connection_id = ?" (Int
counter', UTCTime
updatedAt, Int64
userId, Int64
connId)
  Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
counter'

setAuthErrCounter :: DB.Connection -> User -> Connection -> Int -> IO ()
setAuthErrCounter :: Connection -> User -> Connection -> Int -> IO ()
setAuthErrCounter Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} Connection {Int64
connId :: Connection -> Int64
connId :: Int64
connId} Int
counter = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection -> Query -> (Int, UTCTime, Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE connections SET auth_err_counter = ?, updated_at = ? WHERE user_id = ? AND connection_id = ?" (Int
counter, UTCTime
updatedAt, Int64
userId, Int64
connId)

incQuotaErrCounter :: DB.Connection -> User -> Connection -> IO Int
incQuotaErrCounter :: Connection -> User -> Connection -> IO Int
incQuotaErrCounter Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} Connection {Int64
connId :: Connection -> Int64
connId :: Int64
connId, Int
quotaErrCounter :: Connection -> Int
quotaErrCounter :: Int
quotaErrCounter} = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  (Maybe Int
counter_ :: Maybe Int) <- (Only Int -> Int) -> IO [Only Int] -> IO (Maybe Int)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only Int -> Int
forall a. Only a -> a
fromOnly (IO [Only Int] -> IO (Maybe Int))
-> IO [Only Int] -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> (Int64, Int64) -> IO [Only Int]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT quota_err_counter FROM connections WHERE user_id = ? AND connection_id = ?" (Int64
userId, Int64
connId)
  let counter' :: Int
counter' = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
quotaErrCounter Maybe Int
counter_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  Connection -> Query -> (Int, UTCTime, Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE connections SET quota_err_counter = ?, updated_at = ? WHERE user_id = ? AND connection_id = ?" (Int
counter', UTCTime
updatedAt, Int64
userId, Int64
connId)
  Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
counter'

setQuotaErrCounter :: DB.Connection -> User -> Connection -> Int -> IO ()
setQuotaErrCounter :: Connection -> User -> Connection -> Int -> IO ()
setQuotaErrCounter Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} Connection {Int64
connId :: Connection -> Int64
connId :: Int64
connId} Int
counter = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection -> Query -> (Int, UTCTime, Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE connections SET quota_err_counter = ?, updated_at = ? WHERE user_id = ? AND connection_id = ?" (Int
counter, UTCTime
updatedAt, Int64
userId, Int64
connId)

updateContactProfile_ :: DB.Connection -> UserId -> ProfileId -> Profile -> IO ()
updateContactProfile_ :: Connection -> Int64 -> Int64 -> Profile -> IO ()
updateContactProfile_ Connection
db Int64
userId Int64
profileId Profile
profile = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection -> Int64 -> Int64 -> Profile -> UTCTime -> IO ()
updateContactProfile_' Connection
db Int64
userId Int64
profileId Profile
profile UTCTime
currentTs

updateContactProfile_' :: DB.Connection -> UserId -> ProfileId -> Profile -> UTCTime -> IO ()
updateContactProfile_' :: Connection -> Int64 -> Int64 -> Profile -> UTCTime -> IO ()
updateContactProfile_' Connection
db Int64
userId Int64
profileId Profile {ContactName
displayName :: Profile -> ContactName
displayName :: 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 :: Profile -> Maybe Preferences
preferences :: Maybe Preferences
preferences, Maybe ChatPeerType
peerType :: Maybe ChatPeerType
peerType :: Profile -> Maybe ChatPeerType
peerType} UTCTime
updatedAt = do
  Connection
-> Query
-> (ContactName, ContactName, Maybe ContactName, Maybe ImageData,
    Maybe ConnLinkContact, Maybe Preferences, Maybe ChatPeerType,
    UTCTime, Int64, Int64)
-> 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 = ?, preferences = ?, chat_peer_type = ?, updated_at = ?
      WHERE user_id = ? AND contact_profile_id = ?
    |]
    (ContactName
displayName, ContactName
fullName, Maybe ContactName
shortDescr, Maybe ImageData
image, Maybe ConnLinkContact
contactLink, Maybe Preferences
preferences, Maybe ChatPeerType
peerType, UTCTime
updatedAt, Int64
userId, Int64
profileId)

-- update only member profile fields (when member doesn't have associated contact - we can reset contactLink and prefs)
updateMemberContactProfileReset_ :: DB.Connection -> UserId -> ProfileId -> Profile -> IO ()
updateMemberContactProfileReset_ :: Connection -> Int64 -> Int64 -> Profile -> IO ()
updateMemberContactProfileReset_ Connection
db Int64
userId Int64
profileId Profile
profile = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection -> Int64 -> Int64 -> Profile -> UTCTime -> IO ()
updateMemberContactProfileReset_' Connection
db Int64
userId Int64
profileId Profile
profile UTCTime
currentTs

updateMemberContactProfileReset_' :: DB.Connection -> UserId -> ProfileId -> Profile -> UTCTime -> IO ()
updateMemberContactProfileReset_' :: Connection -> Int64 -> Int64 -> Profile -> UTCTime -> IO ()
updateMemberContactProfileReset_' Connection
db Int64
userId Int64
profileId Profile {ContactName
displayName :: Profile -> ContactName
displayName :: ContactName
displayName, ContactName
fullName :: Profile -> ContactName
fullName :: ContactName
fullName, Maybe ContactName
shortDescr :: Profile -> Maybe ContactName
shortDescr :: Maybe ContactName
shortDescr, Maybe ImageData
image :: Profile -> Maybe ImageData
image :: Maybe ImageData
image} UTCTime
updatedAt = do
  Connection
-> Query
-> (ContactName, ContactName, Maybe ContactName, Maybe ImageData,
    UTCTime, Int64, Int64)
-> 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 = NULL, preferences = NULL, updated_at = ?
      WHERE user_id = ? AND contact_profile_id = ?
    |]
    (ContactName
displayName, ContactName
fullName, Maybe ContactName
shortDescr, Maybe ImageData
image, UTCTime
updatedAt, Int64
userId, Int64
profileId)

-- update only member profile fields (when member has associated contact - we keep contactLink and prefs)
updateMemberContactProfile_ :: DB.Connection -> UserId -> ProfileId -> Profile -> IO ()
updateMemberContactProfile_ :: Connection -> Int64 -> Int64 -> Profile -> IO ()
updateMemberContactProfile_ Connection
db Int64
userId Int64
profileId Profile
profile = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection -> Int64 -> Int64 -> Profile -> UTCTime -> IO ()
updateMemberContactProfile_' Connection
db Int64
userId Int64
profileId Profile
profile UTCTime
currentTs

updateMemberContactProfile_' :: DB.Connection -> UserId -> ProfileId -> Profile -> UTCTime -> IO ()
updateMemberContactProfile_' :: Connection -> Int64 -> Int64 -> Profile -> UTCTime -> IO ()
updateMemberContactProfile_' Connection
db Int64
userId Int64
profileId Profile {ContactName
displayName :: Profile -> ContactName
displayName :: ContactName
displayName, ContactName
fullName :: Profile -> ContactName
fullName :: ContactName
fullName, Maybe ContactName
shortDescr :: Profile -> Maybe ContactName
shortDescr :: Maybe ContactName
shortDescr, Maybe ImageData
image :: Profile -> Maybe ImageData
image :: Maybe ImageData
image} UTCTime
updatedAt = do
  Connection
-> Query
-> (ContactName, ContactName, Maybe ContactName, Maybe ImageData,
    UTCTime, Int64, Int64)
-> 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 = ?, updated_at = ?
      WHERE user_id = ? AND contact_profile_id = ?
    |]
    (ContactName
displayName, ContactName
fullName, Maybe ContactName
shortDescr, Maybe ImageData
image, UTCTime
updatedAt, Int64
userId, Int64
profileId)

updateContactLDN_ :: DB.Connection -> User -> Int64 -> ContactName -> ContactName -> UTCTime -> IO ()
updateContactLDN_ :: Connection
-> User -> Int64 -> ContactName -> ContactName -> UTCTime -> IO ()
updateContactLDN_ Connection
db user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} Int64
contactId ContactName
displayName ContactName
newName UTCTime
updatedAt = do
  Connection
-> Query -> (ContactName, UTCTime, Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"UPDATE contacts SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?"
    (ContactName
newName, UTCTime
updatedAt, Int64
userId, Int64
contactId)
  Connection
-> Query -> (ContactName, UTCTime, Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"UPDATE group_members SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?"
    (ContactName
newName, UTCTime
updatedAt, Int64
userId, Int64
contactId)
  Connection -> User -> ContactName -> IO ()
safeDeleteLDN Connection
db User
user ContactName
displayName

getContactByName :: DB.Connection -> VersionRangeChat -> User -> ContactName -> ExceptT StoreError IO Contact
getContactByName :: Connection
-> VersionRangeChat
-> User
-> ContactName
-> ExceptT StoreError IO Contact
getContactByName Connection
db VersionRangeChat
vr User
user ContactName
localDisplayName = do
  Int64
cId <- Connection -> User -> ContactName -> ExceptT StoreError IO Int64
getContactIdByName Connection
db User
user ContactName
localDisplayName
  Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
cId

getUserContacts :: DB.Connection -> VersionRangeChat -> User -> IO [Contact]
getUserContacts :: Connection -> VersionRangeChat -> User -> IO [Contact]
getUserContacts Connection
db VersionRangeChat
vr user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} = do
  [Int64]
contactIds <- (Only Int64 -> Int64) -> [Only Int64] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
map Only Int64 -> Int64
forall a. Only a -> a
fromOnly ([Only Int64] -> [Int64]) -> IO [Only Int64] -> IO [Int64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> Only Int64 -> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT contact_id FROM contacts WHERE user_id = ? AND deleted = 0" (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
userId)
  [Contact]
contacts <- [Either StoreError Contact] -> [Contact]
forall a b. [Either a b] -> [b]
rights ([Either StoreError Contact] -> [Contact])
-> IO [Either StoreError Contact] -> IO [Contact]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int64 -> IO (Either StoreError Contact))
-> [Int64] -> IO [Either StoreError 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) -> [a] -> m [b]
mapM (ExceptT StoreError IO Contact -> IO (Either StoreError Contact)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO Contact -> IO (Either StoreError Contact))
-> (Int64 -> ExceptT StoreError IO Contact)
-> Int64
-> IO (Either StoreError Contact)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user) [Int64]
contactIds
  [Contact] -> IO [Contact]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Contact] -> IO [Contact]) -> [Contact] -> IO [Contact]
forall a b. (a -> b) -> a -> b
$ (Contact -> Bool) -> [Contact] -> [Contact]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Contact {Maybe Connection
activeConn :: Contact -> Maybe Connection
activeConn :: Maybe Connection
activeConn} -> Maybe Connection -> Bool
forall a. Maybe a -> Bool
isJust Maybe Connection
activeConn) [Contact]
contacts

getUserContactLinkIdByCReq :: DB.Connection -> Int64 -> ExceptT StoreError IO (Maybe Int64)
getUserContactLinkIdByCReq :: Connection -> Int64 -> ExceptT StoreError IO (Maybe Int64)
getUserContactLinkIdByCReq Connection
db Int64
contactRequestId =
  IO (Either StoreError (Maybe Int64))
-> ExceptT StoreError IO (Maybe Int64)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (Maybe Int64))
 -> ExceptT StoreError IO (Maybe Int64))
-> (IO [Only (Maybe Int64)]
    -> IO (Either StoreError (Maybe Int64)))
-> IO [Only (Maybe Int64)]
-> ExceptT StoreError IO (Maybe Int64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only (Maybe Int64) -> Maybe Int64)
-> StoreError
-> IO [Only (Maybe Int64)]
-> IO (Either StoreError (Maybe Int64))
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only (Maybe Int64) -> Maybe Int64
forall a. Only a -> a
fromOnly (Int64 -> StoreError
SEContactRequestNotFound Int64
contactRequestId) (IO [Only (Maybe Int64)] -> ExceptT StoreError IO (Maybe Int64))
-> IO [Only (Maybe Int64)] -> ExceptT StoreError IO (Maybe Int64)
forall a b. (a -> b) -> a -> b
$
    Connection -> Query -> Only Int64 -> IO [Only (Maybe Int64)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT user_contact_link_id FROM contact_requests WHERE contact_request_id = ?" (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
contactRequestId)

getContactRequest :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO UserContactRequest
getContactRequest :: Connection
-> User -> Int64 -> ExceptT StoreError IO UserContactRequest
getContactRequest Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} Int64
contactRequestId =
  IO (Either StoreError UserContactRequest)
-> ExceptT StoreError IO UserContactRequest
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError UserContactRequest)
 -> ExceptT StoreError IO UserContactRequest)
-> (IO [ContactRequestRow]
    -> IO (Either StoreError UserContactRequest))
-> IO [ContactRequestRow]
-> ExceptT StoreError IO UserContactRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContactRequestRow -> UserContactRequest)
-> StoreError
-> IO [ContactRequestRow]
-> IO (Either StoreError UserContactRequest)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow ContactRequestRow -> UserContactRequest
toContactRequest (Int64 -> StoreError
SEContactRequestNotFound Int64
contactRequestId) (IO [ContactRequestRow]
 -> ExceptT StoreError IO UserContactRequest)
-> IO [ContactRequestRow]
-> ExceptT StoreError IO UserContactRequest
forall a b. (a -> b) -> a -> b
$
    Connection -> Query -> (Int64, Int64) -> IO [ContactRequestRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
contactRequestQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE cr.user_id = ? AND cr.contact_request_id = ?") (Int64
userId, Int64
contactRequestId)

getContactRequest' :: DB.Connection -> User -> Int64 -> IO (Maybe UserContactRequest)
getContactRequest' :: Connection -> User -> Int64 -> IO (Maybe UserContactRequest)
getContactRequest' Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} Int64
contactRequestId =
  (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 -> (Int64, Int64) -> IO [ContactRequestRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
contactRequestQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE cr.user_id = ? AND cr.contact_request_id = ?") (Int64
userId, Int64
contactRequestId)

getBusinessContactRequest :: DB.Connection -> User -> GroupId -> IO (Maybe UserContactRequest)
getBusinessContactRequest :: Connection -> User -> Int64 -> IO (Maybe UserContactRequest)
getBusinessContactRequest Connection
db User
_user Int64
groupId =
  (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 -> Only Int64 -> IO [ContactRequestRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
contactRequestQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE cr.business_group_id = ?") (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
groupId)

contactRequestQuery :: Query
contactRequestQuery :: Query
contactRequestQuery =
  [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)
  |]

getContactRequestIdByName :: DB.Connection -> UserId -> ContactName -> ExceptT StoreError IO Int64
getContactRequestIdByName :: Connection -> Int64 -> ContactName -> ExceptT StoreError IO Int64
getContactRequestIdByName Connection
db Int64
userId ContactName
cName =
  IO (Either StoreError Int64) -> ExceptT StoreError IO Int64
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError Int64) -> ExceptT StoreError IO Int64)
-> (IO [Only Int64] -> IO (Either StoreError Int64))
-> IO [Only Int64]
-> ExceptT StoreError IO Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only Int64 -> Int64)
-> StoreError -> IO [Only Int64] -> IO (Either StoreError Int64)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only Int64 -> Int64
forall a. Only a -> a
fromOnly (ContactName -> StoreError
SEContactRequestNotFoundByName ContactName
cName) (IO [Only Int64] -> ExceptT StoreError IO Int64)
-> IO [Only Int64] -> ExceptT StoreError IO Int64
forall a b. (a -> b) -> a -> b
$
    Connection -> Query -> (Int64, ContactName) -> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT contact_request_id FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (Int64
userId, ContactName
cName)

deleteContactRequest :: DB.Connection -> User -> Int64 -> IO ()
deleteContactRequest :: Connection -> User -> Int64 -> IO ()
deleteContactRequest Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} Int64
contactRequestId = do
  Connection -> Query -> (Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      DELETE FROM contact_profiles
      WHERE contact_profile_id in (
        SELECT contact_profile_id
        FROM contact_requests
        WHERE user_id = ? AND contact_request_id = ?
      )
    |]
    (Int64
userId, Int64
contactRequestId)
  Connection -> Query -> (Int64, Int64, Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
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 = ?
      )
      AND local_display_name NOT IN (SELECT local_display_name FROM users WHERE user_id = ?)
    |]
    (Int64
userId, Int64
userId, Int64
contactRequestId, Int64
userId)
  Connection -> Query -> (Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?" (Int64
userId, Int64
contactRequestId)

createContactFromRequest :: DB.Connection -> User -> Maybe Int64 -> ConnId -> VersionChat -> VersionRangeChat -> ContactName -> ProfileId -> Profile -> Maybe XContactId -> Maybe IncognitoProfile -> SubscriptionMode -> PQSupport -> Bool -> IO (Contact, Connection)
createContactFromRequest :: Connection
-> User
-> Maybe Int64
-> ConnId
-> VersionChat
-> VersionRangeChat
-> ContactName
-> Int64
-> Profile
-> Maybe XContactId
-> Maybe IncognitoProfile
-> SubscriptionMode
-> PQSupport
-> Bool
-> IO (Contact, Connection)
createContactFromRequest Connection
db user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId, profile :: User -> LocalProfile
profile = LocalProfile {Maybe Preferences
preferences :: Maybe Preferences
preferences :: LocalProfile -> Maybe Preferences
preferences}} Maybe Int64
uclId_ ConnId
agentConnId VersionChat
connChatVersion VersionRangeChat
cReqChatVRange ContactName
localDisplayName Int64
profileId Profile
profile Maybe XContactId
xContactId Maybe IncognitoProfile
incognitoProfile SubscriptionMode
subMode PQSupport
pqSup Bool
contactUsed = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  let userPreferences :: Preferences
userPreferences = Preferences -> Maybe Preferences -> Preferences
forall a. a -> Maybe a -> a
fromMaybe Preferences
emptyChatPrefs (Maybe Preferences -> Preferences)
-> Maybe Preferences -> Preferences
forall a b. (a -> b) -> a -> b
$ Maybe IncognitoProfile
incognitoProfile Maybe IncognitoProfile -> Maybe Preferences -> Maybe Preferences
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Preferences
preferences
  Connection
-> Query
-> (Int64, ContactName, Int64, BoolInt, Preferences, UTCTime,
    UTCTime, UTCTime, Maybe XContactId, BoolInt)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"INSERT INTO contacts (user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, created_at, updated_at, chat_ts, xcontact_id, contact_used) VALUES (?,?,?,?,?,?,?,?,?,?)"
    (Int64
userId, ContactName
localDisplayName, Int64
profileId, Bool -> BoolInt
BI Bool
True, Preferences
userPreferences, UTCTime
currentTs, UTCTime
currentTs, UTCTime
currentTs, Maybe XContactId
xContactId, Bool -> BoolInt
BI Bool
contactUsed)
  Int64
contactId <- Connection -> IO Int64
insertedRowId Connection
db
  Connection -> Query -> (Int64, Int64, ContactName) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE contact_requests SET contact_id = ? WHERE user_id = ? AND local_display_name = ?" (Int64
contactId, Int64
userId, ContactName
localDisplayName)
  Connection
conn <- Connection
-> User
-> Maybe Int64
-> Int64
-> ConnId
-> VersionChat
-> VersionRangeChat
-> PQSupport
-> Maybe IncognitoProfile
-> SubscriptionMode
-> UTCTime
-> IO Connection
createAcceptedContactConn Connection
db User
user Maybe Int64
uclId_ Int64
contactId ConnId
agentConnId VersionChat
connChatVersion VersionRangeChat
cReqChatVRange PQSupport
pqSup Maybe IncognitoProfile
incognitoProfile SubscriptionMode
subMode UTCTime
currentTs
  let mergedPreferences :: ContactUserPreferences
mergedPreferences = User
-> Preferences
-> Maybe Preferences
-> Bool
-> ContactUserPreferences
contactUserPreferences User
user Preferences
userPreferences Maybe Preferences
preferences (Bool -> ContactUserPreferences) -> Bool -> ContactUserPreferences
forall a b. (a -> b) -> a -> b
$ Connection -> Bool
connIncognito Connection
conn
      ct :: Contact
ct =
        Contact
          { Int64
contactId :: Int64
contactId :: Int64
contactId,
            ContactName
localDisplayName :: ContactName
localDisplayName :: ContactName
localDisplayName,
            profile :: LocalProfile
profile = Int64 -> Profile -> ContactName -> LocalProfile
toLocalProfile Int64
profileId Profile
profile ContactName
"",
            activeConn :: Maybe Connection
activeConn = Connection -> Maybe Connection
forall a. a -> Maybe a
Just Connection
conn,
            Bool
contactUsed :: Bool
contactUsed :: Bool
contactUsed,
            contactStatus :: ContactStatus
contactStatus = ContactStatus
CSActive,
            chatSettings :: ChatSettings
chatSettings = ChatSettings
defaultChatSettings,
            Preferences
userPreferences :: Preferences
userPreferences :: Preferences
userPreferences,
            ContactUserPreferences
mergedPreferences :: ContactUserPreferences
mergedPreferences :: ContactUserPreferences
mergedPreferences,
            createdAt :: UTCTime
createdAt = UTCTime
currentTs,
            updatedAt :: UTCTime
updatedAt = UTCTime
currentTs,
            chatTs :: Maybe UTCTime
chatTs = UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
currentTs,
            preparedContact :: Maybe PreparedContact
preparedContact = Maybe PreparedContact
forall a. Maybe a
Nothing,
            contactRequestId :: Maybe Int64
contactRequestId = Maybe Int64
forall a. Maybe a
Nothing,
            contactGroupMemberId :: Maybe Int64
contactGroupMemberId = Maybe Int64
forall a. Maybe a
Nothing,
            contactGrpInvSent :: Bool
contactGrpInvSent = Bool
False,
            groupDirectInv :: Maybe GroupDirectInvitation
groupDirectInv = Maybe GroupDirectInvitation
forall a. Maybe a
Nothing,
            chatTags :: [Int64]
chatTags = [],
            chatItemTTL :: Maybe Int64
chatItemTTL = Maybe Int64
forall a. Maybe a
Nothing,
            uiThemes :: Maybe UIThemeEntityOverrides
uiThemes = Maybe UIThemeEntityOverrides
forall a. Maybe a
Nothing,
            chatDeleted :: Bool
chatDeleted = Bool
False,
            customData :: Maybe CustomData
customData = Maybe CustomData
forall a. Maybe a
Nothing
          }
  (Contact, Connection) -> IO (Contact, Connection)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Contact
ct, Connection
conn)

createAcceptedContactConn :: DB.Connection -> User -> Maybe Int64 -> ContactId -> ConnId -> VersionChat -> VersionRangeChat -> PQSupport -> Maybe IncognitoProfile -> SubscriptionMode -> UTCTime -> IO Connection
createAcceptedContactConn :: Connection
-> User
-> Maybe Int64
-> Int64
-> ConnId
-> VersionChat
-> VersionRangeChat
-> PQSupport
-> Maybe IncognitoProfile
-> SubscriptionMode
-> UTCTime
-> IO Connection
createAcceptedContactConn Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} Maybe Int64
uclId_ Int64
contactId ConnId
agentConnId VersionChat
connChatVersion VersionRangeChat
cReqChatVRange PQSupport
pqSup Maybe IncognitoProfile
incognitoProfile SubscriptionMode
subMode UTCTime
currentTs = do
  Maybe Int64
customUserProfileId <- Maybe IncognitoProfile
-> (IncognitoProfile -> IO Int64) -> IO (Maybe Int64)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe IncognitoProfile
incognitoProfile ((IncognitoProfile -> IO Int64) -> IO (Maybe Int64))
-> (IncognitoProfile -> IO Int64) -> IO (Maybe Int64)
forall a b. (a -> b) -> a -> b
$ \case
    NewIncognito Profile
p -> Connection -> Int64 -> UTCTime -> Profile -> IO Int64
createIncognitoProfile_ Connection
db Int64
userId UTCTime
currentTs Profile
p
    ExistingIncognito LocalProfile {profileId :: LocalProfile -> Int64
profileId = Int64
pId} -> Int64 -> IO Int64
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
pId
  Connection
-> Int64
-> ConnType
-> Maybe Int64
-> ConnId
-> ConnStatus
-> VersionChat
-> VersionRangeChat
-> Maybe Int64
-> Maybe Int64
-> Maybe Int64
-> Int
-> UTCTime
-> SubscriptionMode
-> PQSupport
-> IO Connection
createConnection_ Connection
db Int64
userId ConnType
ConnContact (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
contactId) ConnId
agentConnId ConnStatus
ConnNew VersionChat
connChatVersion VersionRangeChat
cReqChatVRange Maybe Int64
forall a. Maybe a
Nothing Maybe Int64
uclId_ Maybe Int64
customUserProfileId Int
0 UTCTime
currentTs SubscriptionMode
subMode PQSupport
pqSup

updateContactAccepted :: DB.Connection -> User -> Contact -> Bool -> IO ()
updateContactAccepted :: Connection -> User -> Contact -> Bool -> IO ()
updateContactAccepted Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} Contact {Int64
contactId :: Contact -> Int64
contactId :: Int64
contactId} Bool
contactUsed =
  Connection -> Query -> (BoolInt, Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"UPDATE contacts SET contact_used = ? WHERE user_id = ? AND contact_id = ?"
    (Bool -> BoolInt
BI Bool
contactUsed, Int64
userId, Int64
contactId)

getContactIdByName :: DB.Connection -> User -> ContactName -> ExceptT StoreError IO Int64
getContactIdByName :: Connection -> User -> ContactName -> ExceptT StoreError IO Int64
getContactIdByName Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} ContactName
cName =
  IO (Either StoreError Int64) -> ExceptT StoreError IO Int64
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError Int64) -> ExceptT StoreError IO Int64)
-> (IO [Only Int64] -> IO (Either StoreError Int64))
-> IO [Only Int64]
-> ExceptT StoreError IO Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only Int64 -> Int64)
-> StoreError -> IO [Only Int64] -> IO (Either StoreError Int64)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only Int64 -> Int64
forall a. Only a -> a
fromOnly (ContactName -> StoreError
SEContactNotFoundByName ContactName
cName) (IO [Only Int64] -> ExceptT StoreError IO Int64)
-> IO [Only Int64] -> ExceptT StoreError IO Int64
forall a b. (a -> b) -> a -> b
$
    Connection -> Query -> (Int64, ContactName) -> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT contact_id FROM contacts WHERE user_id = ? AND local_display_name = ? AND deleted = 0" (Int64
userId, ContactName
cName)

getContactViaShortLinkToConnect :: forall c. ConnectionModeI c => DB.Connection -> VersionRangeChat -> User -> ConnShortLink c -> ExceptT StoreError IO (Maybe (ConnectionRequestUri c, Contact))
getContactViaShortLinkToConnect :: forall (c :: ConnectionMode).
ConnectionModeI c =>
Connection
-> VersionRangeChat
-> User
-> ConnShortLink c
-> ExceptT StoreError IO (Maybe (ConnectionRequestUri c, Contact))
getContactViaShortLinkToConnect Connection
db VersionRangeChat
vr user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} ConnShortLink c
shortLink = do
  IO (Maybe (Int64, Maybe AConnectionRequestUri))
-> ExceptT
     StoreError IO (Maybe (Int64, Maybe AConnectionRequestUri))
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (((Int64, Maybe AConnectionRequestUri)
 -> (Int64, Maybe AConnectionRequestUri))
-> IO [(Int64, Maybe AConnectionRequestUri)]
-> IO (Maybe (Int64, Maybe AConnectionRequestUri))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow (Int64, Maybe AConnectionRequestUri)
-> (Int64, Maybe AConnectionRequestUri)
forall a. a -> a
id (IO [(Int64, Maybe AConnectionRequestUri)]
 -> IO (Maybe (Int64, Maybe AConnectionRequestUri)))
-> IO [(Int64, Maybe AConnectionRequestUri)]
-> IO (Maybe (Int64, Maybe AConnectionRequestUri))
forall a b. (a -> b) -> a -> b
$ Connection
-> Query
-> (Int64, ConnShortLink c)
-> IO [(Int64, Maybe AConnectionRequestUri)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT contact_id, conn_full_link_to_connect FROM contacts WHERE user_id = ? AND conn_short_link_to_connect = ?" (Int64
userId, ConnShortLink c
shortLink)) ExceptT StoreError IO (Maybe (Int64, Maybe AConnectionRequestUri))
-> (Maybe (Int64, Maybe AConnectionRequestUri)
    -> ExceptT StoreError IO (Maybe (ConnectionRequestUri c, Contact)))
-> ExceptT StoreError IO (Maybe (ConnectionRequestUri c, Contact))
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 (Int64
ctId :: Int64, Just (ACR SConnectionMode m
cMode ConnectionRequestUri m
cReq)) ->
      case SConnectionMode m -> SConnectionMode c -> Maybe (m :~: c)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: ConnectionMode) (b :: ConnectionMode).
SConnectionMode a -> SConnectionMode b -> Maybe (a :~: b)
testEquality SConnectionMode m
cMode (forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m
sConnectionMode @c) of
        Just m :~: c
Refl -> (ConnectionRequestUri c, Contact)
-> Maybe (ConnectionRequestUri c, Contact)
forall a. a -> Maybe a
Just ((ConnectionRequestUri c, Contact)
 -> Maybe (ConnectionRequestUri c, Contact))
-> (Contact -> (ConnectionRequestUri c, Contact))
-> Contact
-> Maybe (ConnectionRequestUri c, Contact)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConnectionRequestUri m
cReq,) (Contact -> Maybe (ConnectionRequestUri c, Contact))
-> ExceptT StoreError IO Contact
-> ExceptT StoreError IO (Maybe (ConnectionRequestUri c, Contact))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
ctId
        Maybe (m :~: c)
Nothing -> Maybe (ConnectionRequestUri c, Contact)
-> ExceptT StoreError IO (Maybe (ConnectionRequestUri c, Contact))
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ConnectionRequestUri c, Contact)
forall a. Maybe a
Nothing
    Maybe (Int64, Maybe AConnectionRequestUri)
_ -> Maybe (ConnectionRequestUri c, Contact)
-> ExceptT StoreError IO (Maybe (ConnectionRequestUri c, Contact))
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ConnectionRequestUri c, Contact)
forall a. Maybe a
Nothing

getContact :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO Contact
getContact :: Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId = Connection
-> VersionRangeChat
-> User
-> Int64
-> Bool
-> ExceptT StoreError IO Contact
getContact_ Connection
db VersionRangeChat
vr User
user Int64
contactId Bool
False

getContact_ :: DB.Connection -> VersionRangeChat -> User -> Int64 -> Bool -> ExceptT StoreError IO Contact
getContact_ :: Connection
-> VersionRangeChat
-> User
-> Int64
-> Bool
-> ExceptT StoreError IO Contact
getContact_ Connection
db VersionRangeChat
vr user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} Int64
contactId Bool
deleted = do
  [Int64]
chatTags <- IO [Int64] -> ExceptT StoreError IO [Int64]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Int64] -> ExceptT StoreError IO [Int64])
-> IO [Int64] -> ExceptT StoreError IO [Int64]
forall a b. (a -> b) -> a -> b
$ Connection -> Int64 -> IO [Int64]
getDirectChatTags Connection
db Int64
contactId
  IO (Either StoreError Contact) -> ExceptT StoreError IO Contact
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError Contact) -> ExceptT StoreError IO Contact)
-> (IO [ContactRow :. MaybeConnectionRow]
    -> IO (Either StoreError Contact))
-> IO [ContactRow :. MaybeConnectionRow]
-> ExceptT StoreError IO Contact
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ContactRow :. MaybeConnectionRow) -> Contact)
-> StoreError
-> IO [ContactRow :. MaybeConnectionRow]
-> IO (Either StoreError Contact)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (VersionRangeChat
-> User -> [Int64] -> (ContactRow :. MaybeConnectionRow) -> Contact
toContact VersionRangeChat
vr User
user [Int64]
chatTags) (Int64 -> StoreError
SEContactNotFound Int64
contactId) (IO [ContactRow :. MaybeConnectionRow]
 -> ExceptT StoreError IO Contact)
-> IO [ContactRow :. MaybeConnectionRow]
-> ExceptT StoreError IO Contact
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (Int64, Int64, BoolInt)
-> 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.contact_id = ?
          AND ct.deleted = ?
      |]
      (Int64
userId, Int64
contactId, Bool -> BoolInt
BI Bool
deleted)

getUserByContactRequestId :: DB.Connection -> Int64 -> ExceptT StoreError IO User
getUserByContactRequestId :: Connection -> Int64 -> ExceptT StoreError IO User
getUserByContactRequestId Connection
db Int64
contactRequestId =
  IO (Either StoreError User) -> ExceptT StoreError IO User
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError User) -> ExceptT StoreError IO User)
-> (IO
      [(Int64, Int64, Int64, Int64, BoolInt, Int64)
       :. ((ContactName, ContactName, Maybe ContactName, Maybe ImageData,
            Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Preferences)
           :. (BoolInt, BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString,
               Maybe B64UrlByteString, Maybe UTCTime,
               Maybe UIThemeEntityOverrides))]
    -> IO (Either StoreError User))
-> IO
     [(Int64, Int64, Int64, Int64, BoolInt, Int64)
      :. ((ContactName, ContactName, Maybe ContactName, Maybe ImageData,
           Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Preferences)
          :. (BoolInt, BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString,
              Maybe B64UrlByteString, Maybe UTCTime,
              Maybe UIThemeEntityOverrides))]
-> ExceptT StoreError IO User
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Int64, Int64, Int64, Int64, BoolInt, Int64)
  :. ((ContactName, ContactName, Maybe ContactName, Maybe ImageData,
       Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Preferences)
      :. (BoolInt, BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString,
          Maybe B64UrlByteString, Maybe UTCTime,
          Maybe UIThemeEntityOverrides)))
 -> User)
-> StoreError
-> IO
     [(Int64, Int64, Int64, Int64, BoolInt, Int64)
      :. ((ContactName, ContactName, Maybe ContactName, Maybe ImageData,
           Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Preferences)
          :. (BoolInt, BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString,
              Maybe B64UrlByteString, Maybe UTCTime,
              Maybe UIThemeEntityOverrides))]
-> IO (Either StoreError User)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow ((Int64, Int64, Int64, Int64, BoolInt, Int64)
 :. ((ContactName, ContactName, Maybe ContactName, Maybe ImageData,
      Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Preferences)
     :. (BoolInt, BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString,
         Maybe B64UrlByteString, Maybe UTCTime,
         Maybe UIThemeEntityOverrides)))
-> User
toUser (Int64 -> StoreError
SEUserNotFoundByContactRequestId Int64
contactRequestId) (IO
   [(Int64, Int64, Int64, Int64, BoolInt, Int64)
    :. ((ContactName, ContactName, Maybe ContactName, Maybe ImageData,
         Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Preferences)
        :. (BoolInt, BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString,
            Maybe B64UrlByteString, Maybe UTCTime,
            Maybe UIThemeEntityOverrides))]
 -> ExceptT StoreError IO User)
-> IO
     [(Int64, Int64, Int64, Int64, BoolInt, Int64)
      :. ((ContactName, ContactName, Maybe ContactName, Maybe ImageData,
           Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Preferences)
          :. (BoolInt, BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString,
              Maybe B64UrlByteString, Maybe UTCTime,
              Maybe UIThemeEntityOverrides))]
-> ExceptT StoreError IO User
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> Only Int64
-> IO
     [(Int64, Int64, Int64, Int64, BoolInt, Int64)
      :. ((ContactName, ContactName, Maybe ContactName, Maybe ImageData,
           Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Preferences)
          :. (BoolInt, BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString,
              Maybe B64UrlByteString, Maybe UTCTime,
              Maybe UIThemeEntityOverrides))]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
userQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" JOIN contact_requests cr ON cr.user_id = u.user_id WHERE cr.contact_request_id = ?") (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
contactRequestId)

getContactConnections :: DB.Connection -> VersionRangeChat -> UserId -> Contact -> IO [Connection]
getContactConnections :: Connection
-> VersionRangeChat -> Int64 -> Contact -> IO [Connection]
getContactConnections Connection
db VersionRangeChat
vr Int64
userId Contact {Int64
contactId :: Contact -> Int64
contactId :: Int64
contactId} =
  [ConnectionRow] -> IO [Connection]
connections ([ConnectionRow] -> IO [Connection])
-> IO [ConnectionRow] -> IO [Connection]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [ConnectionRow] -> IO [ConnectionRow]
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [ConnectionRow]
getConnections_
  where
    getConnections_ :: IO [ConnectionRow]
getConnections_ =
      Connection -> Query -> (Int64, Int64, Int64) -> IO [ConnectionRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT 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 connections c
          JOIN contacts ct ON ct.contact_id = c.contact_id
          WHERE c.user_id = ? AND ct.user_id = ? AND ct.contact_id = ?
        |]
        (Int64
userId, Int64
userId, Int64
contactId)
    connections :: [ConnectionRow] -> IO [Connection]
connections [] = [Connection] -> IO [Connection]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    connections [ConnectionRow]
rows = [Connection] -> IO [Connection]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Connection] -> IO [Connection])
-> [Connection] -> IO [Connection]
forall a b. (a -> b) -> a -> b
$ (ConnectionRow -> Connection) -> [ConnectionRow] -> [Connection]
forall a b. (a -> b) -> [a] -> [b]
map (VersionRangeChat -> ConnectionRow -> Connection
toConnection VersionRangeChat
vr) [ConnectionRow]
rows

getConnectionById :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO Connection
getConnectionById :: Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Connection
getConnectionById Connection
db VersionRangeChat
vr User {Int64
userId :: User -> Int64
userId :: Int64
userId} Int64
connId = IO (Either StoreError Connection)
-> ExceptT StoreError IO Connection
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError Connection)
 -> ExceptT StoreError IO Connection)
-> IO (Either StoreError Connection)
-> ExceptT StoreError IO Connection
forall a b. (a -> b) -> a -> b
$ do
  (ConnectionRow -> Connection)
-> StoreError
-> IO [ConnectionRow]
-> IO (Either StoreError Connection)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (VersionRangeChat -> ConnectionRow -> Connection
toConnection VersionRangeChat
vr) (Int64 -> StoreError
SEConnectionNotFoundById Int64
connId) (IO [ConnectionRow] -> IO (Either StoreError Connection))
-> IO [ConnectionRow] -> IO (Either StoreError Connection)
forall a b. (a -> b) -> a -> b
$
    Connection -> Query -> (Int64, Int64) -> IO [ConnectionRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT connection_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, group_link_id, xcontact_id, custom_user_profile_id,
          conn_status, conn_type, contact_conn_initiated, local_alias, contact_id, group_member_id, user_contact_link_id,
          created_at, security_code, security_code_verified_at, pq_support, pq_encryption, pq_snd_enabled, pq_rcv_enabled, auth_err_counter, quota_err_counter,
          conn_chat_version, peer_chat_min_version, peer_chat_max_version
        FROM connections
        WHERE user_id = ? AND connection_id = ?
      |]
      (Int64
userId, Int64
connId)

getConnectionsContacts :: DB.Connection -> [ConnId] -> IO [ContactRef]
getConnectionsContacts :: Connection -> [ConnId] -> IO [ContactRef]
getConnectionsContacts Connection
db [ConnId]
agentConnIds = do
  Connection -> Query -> IO ()
DB.execute_ Connection
db Query
"DROP TABLE IF EXISTS temp_conn_ids"
#if defined(dbPostgres)
  DB.execute_ db "CREATE TABLE temp_conn_ids (conn_id BYTEA)"
#else
  Connection -> Query -> IO ()
DB.execute_ Connection
db Query
"CREATE TABLE temp_conn_ids (conn_id BLOB)"
#endif
  Connection -> Query -> [Only ConnId] -> IO ()
forall q. ToRow q => Connection -> Query -> [q] -> IO ()
DB.executeMany Connection
db Query
"INSERT INTO temp_conn_ids (conn_id) VALUES (?)" ([Only ConnId] -> IO ()) -> [Only ConnId] -> IO ()
forall a b. (a -> b) -> a -> b
$ (ConnId -> Only ConnId) -> [ConnId] -> [Only ConnId]
forall a b. (a -> b) -> [a] -> [b]
map ConnId -> Only ConnId
forall a. a -> Only a
Only [ConnId]
agentConnIds
  [ContactRef]
conns <-
    ((Int64, Int64, ConnId, ContactName) -> ContactRef)
-> [(Int64, Int64, ConnId, ContactName)] -> [ContactRef]
forall a b. (a -> b) -> [a] -> [b]
map (Int64, Int64, ConnId, ContactName) -> ContactRef
toContactRef
      ([(Int64, Int64, ConnId, ContactName)] -> [ContactRef])
-> IO [(Int64, Int64, ConnId, ContactName)] -> IO [ContactRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> Only ConnType
-> IO [(Int64, Int64, ConnId, ContactName)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT ct.contact_id, c.connection_id, c.agent_conn_id, ct.local_display_name
          FROM contacts ct
          JOIN connections c ON c.contact_id = ct.contact_id
          WHERE c.agent_conn_id IN (SELECT conn_id FROM temp_conn_ids)
            AND c.conn_type = ?
            AND ct.deleted = 0
        |]
        (ConnType -> Only ConnType
forall a. a -> Only a
Only ConnType
ConnContact)
  Connection -> Query -> IO ()
DB.execute_ Connection
db Query
"DROP TABLE temp_conn_ids"
  [ContactRef] -> IO [ContactRef]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ContactRef]
conns
  where
    toContactRef :: (ContactId, Int64, ConnId, ContactName) -> ContactRef
    toContactRef :: (Int64, Int64, ConnId, ContactName) -> ContactRef
toContactRef (Int64
contactId, Int64
connId, ConnId
acId, ContactName
localDisplayName) = ContactRef {Int64
contactId :: Int64
contactId :: Int64
contactId, Int64
connId :: Int64
connId :: Int64
connId, agentConnId :: AgentConnId
agentConnId = ConnId -> AgentConnId
AgentConnId ConnId
acId, ContactName
localDisplayName :: ContactName
localDisplayName :: ContactName
localDisplayName}

updateConnectionStatus :: DB.Connection -> Connection -> ConnStatus -> IO ()
updateConnectionStatus :: Connection -> Connection -> ConnStatus -> IO ()
updateConnectionStatus Connection
db Connection {Int64
connId :: Connection -> Int64
connId :: Int64
connId} = Connection -> Int64 -> ConnStatus -> IO ()
updateConnectionStatus_ Connection
db Int64
connId
{-# INLINE updateConnectionStatus #-}

updateConnectionStatusFromTo :: DB.Connection -> Connection -> ConnStatus -> ConnStatus -> IO Connection
updateConnectionStatusFromTo :: Connection
-> Connection -> ConnStatus -> ConnStatus -> IO Connection
updateConnectionStatusFromTo Connection
db conn :: Connection
conn@Connection {Int64
connId :: Connection -> Int64
connId :: Int64
connId} ConnStatus
fromStatus ConnStatus
toStatus = do
  (Only ConnStatus -> ConnStatus)
-> IO [Only ConnStatus] -> IO (Maybe ConnStatus)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only ConnStatus -> ConnStatus
forall a. Only a -> a
fromOnly (Connection -> Query -> Only Int64 -> IO [Only ConnStatus]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT conn_status FROM connections WHERE connection_id = ?" (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
connId)) IO (Maybe ConnStatus)
-> (Maybe ConnStatus -> IO Connection) -> IO Connection
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just ConnStatus
status | ConnStatus
status ConnStatus -> ConnStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ConnStatus
fromStatus -> Connection -> Int64 -> ConnStatus -> IO ()
updateConnectionStatus_ Connection
db Int64
connId ConnStatus
toStatus IO () -> Connection -> IO Connection
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Connection
conn {connStatus = toStatus}
    Maybe ConnStatus
_ -> Connection -> IO Connection
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Connection
conn

updateConnectionStatus_ :: DB.Connection -> Int64 -> ConnStatus -> IO ()
updateConnectionStatus_ :: Connection -> Int64 -> ConnStatus -> IO ()
updateConnectionStatus_ Connection
db Int64
connId ConnStatus
connStatus = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  if ConnStatus
connStatus ConnStatus -> ConnStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ConnStatus
ConnReady
    then Connection -> Query -> (ConnStatus, UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE connections SET conn_status = ?, updated_at = ?, conn_req_inv = NULL, short_link_inv = NULL WHERE connection_id = ?" (ConnStatus
connStatus, UTCTime
currentTs, Int64
connId)
    else Connection -> Query -> (ConnStatus, UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE connections SET conn_status = ?, updated_at = ? WHERE connection_id = ?" (ConnStatus
connStatus, UTCTime
currentTs, Int64
connId)

updateContactSettings :: DB.Connection -> User -> Int64 -> ChatSettings -> IO ()
updateContactSettings :: Connection -> User -> Int64 -> ChatSettings -> IO ()
updateContactSettings Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} Int64
contactId ChatSettings {MsgFilter
enableNtfs :: MsgFilter
enableNtfs :: ChatSettings -> MsgFilter
enableNtfs, Maybe Bool
sendRcpts :: Maybe Bool
sendRcpts :: ChatSettings -> Maybe Bool
sendRcpts, Bool
favorite :: Bool
favorite :: ChatSettings -> Bool
favorite} =
  Connection
-> Query
-> (MsgFilter, Maybe BoolInt, BoolInt, Int64, Int64)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE contacts SET enable_ntfs = ?, send_rcpts = ?, favorite = ? WHERE user_id = ? AND contact_id = ?" (MsgFilter
enableNtfs, Bool -> BoolInt
BI (Bool -> BoolInt) -> Maybe Bool -> Maybe BoolInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
sendRcpts, Bool -> BoolInt
BI Bool
favorite, Int64
userId, Int64
contactId)

setConnConnReqInv :: DB.Connection -> User -> Int64 -> ConnReqInvitation -> IO ()
setConnConnReqInv :: Connection -> User -> Int64 -> ConnReqInvitation -> IO ()
setConnConnReqInv Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} Int64
connId ConnReqInvitation
connReq = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection
-> Query -> (ConnReqInvitation, UTCTime, Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE connections
      SET conn_req_inv = ?, updated_at = ?
      WHERE user_id = ? AND connection_id = ?
    |]
    (ConnReqInvitation
connReq, UTCTime
updatedAt, Int64
userId, Int64
connId)

resetContactConnInitiated :: DB.Connection -> User -> Connection -> IO ()
resetContactConnInitiated :: Connection -> User -> Connection -> IO ()
resetContactConnInitiated Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} Connection {Int64
connId :: Connection -> Int64
connId :: Int64
connId} = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection -> Query -> (UTCTime, Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE connections
      SET contact_conn_initiated = 0, updated_at = ?
      WHERE user_id = ? AND connection_id = ?
    |]
    (UTCTime
updatedAt, Int64
userId, Int64
connId)

setContactCustomData :: DB.Connection -> User -> Contact -> Maybe CustomData -> IO ()
setContactCustomData :: Connection -> User -> Contact -> Maybe CustomData -> IO ()
setContactCustomData Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} Contact {Int64
contactId :: Contact -> Int64
contactId :: Int64
contactId} Maybe CustomData
customData = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection
-> Query -> (Maybe CustomData, UTCTime, Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE contacts SET custom_data = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" (Maybe CustomData
customData, UTCTime
updatedAt, Int64
userId, Int64
contactId)

setContactUIThemes :: DB.Connection -> User -> Contact -> Maybe UIThemeEntityOverrides -> IO ()
setContactUIThemes :: Connection
-> User -> Contact -> Maybe UIThemeEntityOverrides -> IO ()
setContactUIThemes Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} Contact {Int64
contactId :: Contact -> Int64
contactId :: Int64
contactId} Maybe UIThemeEntityOverrides
uiThemes = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection
-> Query
-> (Maybe UIThemeEntityOverrides, UTCTime, Int64, Int64)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE contacts SET ui_themes = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" (Maybe UIThemeEntityOverrides
uiThemes, UTCTime
updatedAt, Int64
userId, Int64
contactId)

setContactChatDeleted :: DB.Connection -> User -> Contact -> Bool -> IO ()
setContactChatDeleted :: Connection -> User -> Contact -> Bool -> IO ()
setContactChatDeleted Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} Contact {Int64
contactId :: Contact -> Int64
contactId :: Int64
contactId} Bool
chatDeleted = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection -> Query -> (BoolInt, UTCTime, Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE contacts SET chat_deleted = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" (Bool -> BoolInt
BI Bool
chatDeleted, UTCTime
updatedAt, Int64
userId, Int64
contactId)

updateDirectChatTags :: DB.Connection -> ContactId -> [ChatTagId] -> IO ()
updateDirectChatTags :: Connection -> Int64 -> [Int64] -> IO ()
updateDirectChatTags Connection
db Int64
contactId [Int64]
tIds = do
  [Int64]
currentTags <- Connection -> Int64 -> IO [Int64]
getDirectChatTags Connection
db Int64
contactId
  let tagsToAdd :: [Int64]
tagsToAdd = (Int64 -> Bool) -> [Int64] -> [Int64]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int64 -> [Int64] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Int64]
currentTags) [Int64]
tIds
      tagsToDelete :: [Int64]
tagsToDelete = (Int64 -> Bool) -> [Int64] -> [Int64]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int64 -> [Int64] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Int64]
tIds) [Int64]
currentTags
  [Int64] -> (Int64 -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int64]
tagsToDelete ((Int64 -> IO ()) -> IO ()) -> (Int64 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> Int64 -> Int64 -> IO ()
untagDirectChat Connection
db Int64
contactId
  [Int64] -> (Int64 -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int64]
tagsToAdd ((Int64 -> IO ()) -> IO ()) -> (Int64 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> Int64 -> Int64 -> IO ()
tagDirectChat Connection
db Int64
contactId

tagDirectChat :: DB.Connection -> ContactId -> ChatTagId -> IO ()
tagDirectChat :: Connection -> Int64 -> Int64 -> IO ()
tagDirectChat Connection
db Int64
contactId Int64
tId =
  Connection -> Query -> (Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      INSERT INTO chat_tags_chats (contact_id, chat_tag_id)
      VALUES (?,?)
    |]
    (Int64
contactId, Int64
tId)

untagDirectChat :: DB.Connection -> ContactId -> ChatTagId -> IO ()
untagDirectChat :: Connection -> Int64 -> Int64 -> IO ()
untagDirectChat Connection
db Int64
contactId Int64
tId =
  Connection -> Query -> (Int64, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      DELETE FROM chat_tags_chats
      WHERE contact_id = ? AND chat_tag_id = ?
    |]
    (Int64
contactId, Int64
tId)

getDirectChatTags :: DB.Connection -> ContactId -> IO [ChatTagId]
getDirectChatTags :: Connection -> Int64 -> IO [Int64]
getDirectChatTags Connection
db Int64
contactId = (Only Int64 -> Int64) -> [Only Int64] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
map Only Int64 -> Int64
forall a. Only a -> a
fromOnly ([Only Int64] -> [Int64]) -> IO [Only Int64] -> IO [Int64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> Only Int64 -> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT chat_tag_id FROM chat_tags_chats WHERE contact_id = ?" (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
contactId)

addDirectChatTags :: DB.Connection -> Contact -> IO Contact
addDirectChatTags :: Connection -> Contact -> IO Contact
addDirectChatTags Connection
db Contact
ct = do
  [Int64]
chatTags <- Connection -> Int64 -> IO [Int64]
getDirectChatTags Connection
db (Int64 -> IO [Int64]) -> Int64 -> IO [Int64]
forall a b. (a -> b) -> a -> b
$ Contact -> Int64
forall a. IsContact a => a -> Int64
contactId' Contact
ct
  Contact -> IO Contact
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Contact
ct :: Contact) {chatTags}

setDirectChatTTL :: DB.Connection -> ContactId -> Maybe Int64 -> IO ()
setDirectChatTTL :: Connection -> Int64 -> Maybe Int64 -> IO ()
setDirectChatTTL Connection
db Int64
ctId Maybe Int64
ttl = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection -> Query -> (Maybe Int64, UTCTime, Int64) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE contacts SET chat_item_ttl = ?, updated_at = ? WHERE contact_id = ?" (Maybe Int64
ttl, UTCTime
updatedAt, Int64
ctId)

getDirectChatTTL :: DB.Connection -> ContactId -> IO (Maybe Int64)
getDirectChatTTL :: Connection -> Int64 -> IO (Maybe Int64)
getDirectChatTTL Connection
db Int64
ctId =
  (Maybe (Maybe Int64) -> Maybe Int64)
-> IO (Maybe (Maybe Int64)) -> IO (Maybe Int64)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe Int64) -> Maybe Int64
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (Maybe (Maybe Int64)) -> IO (Maybe Int64))
-> (IO [Only (Maybe Int64)] -> IO (Maybe (Maybe Int64)))
-> IO [Only (Maybe Int64)]
-> IO (Maybe Int64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only (Maybe Int64) -> Maybe Int64)
-> IO [Only (Maybe Int64)] -> IO (Maybe (Maybe Int64))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only (Maybe Int64) -> Maybe Int64
forall a. Only a -> a
fromOnly (IO [Only (Maybe Int64)] -> IO (Maybe Int64))
-> IO [Only (Maybe Int64)] -> IO (Maybe Int64)
forall a b. (a -> b) -> a -> b
$
    Connection -> Query -> Only Int64 -> IO [Only (Maybe Int64)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT chat_item_ttl FROM contacts WHERE contact_id = ? LIMIT 1" (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
ctId)

getUserContactsToExpire :: DB.Connection -> User -> Int64 -> IO [ContactId]
getUserContactsToExpire :: Connection -> User -> Int64 -> IO [Int64]
getUserContactsToExpire Connection
db User {Int64
userId :: User -> Int64
userId :: Int64
userId} Int64
globalTTL =
  (Only Int64 -> Int64) -> [Only Int64] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
map Only Int64 -> Int64
forall a. Only a -> a
fromOnly ([Only Int64] -> [Int64]) -> IO [Only Int64] -> IO [Int64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> Only Int64 -> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
"SELECT contact_id FROM contacts WHERE user_id = ? AND chat_item_ttl > 0" Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
cond) (Int64 -> Only Int64
forall a. a -> Only a
Only Int64
userId)
  where
    cond :: Query
cond = if Int64
globalTTL Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 then Query
"" else Query
" OR chat_item_ttl IS NULL"