{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
module Simplex.Chat.Store.Connections
( getChatLockEntity,
getConnectionEntity,
getConnectionEntityByConnReq,
getConnectionEntityViaShortLink,
getContactConnEntityByConnReqHash,
getContactConnsToSub,
getUCLConnsToSub,
getMemberConnsToSub,
getPendingConnsToSub,
shouldSyncConnections,
setConnectionsSyncTs,
)
where
import Control.Monad.Except
import Control.Monad.IO.Class
import Data.Bitraversable (bitraverse)
import Data.Int (Int64)
import Data.Maybe (fromMaybe)
import Data.Time.Clock (getCurrentTime)
import Simplex.Chat.Protocol
import Simplex.Chat.Store.Direct
import Simplex.Chat.Store.Groups
import Simplex.Chat.Store.Shared
import Simplex.Chat.Types
import Simplex.Messaging.Agent.Protocol (ConnId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, firstRow', fromOnlyBI, maybeFirstRow)
import Simplex.Messaging.Agent.Store.DB (BoolInt (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Util (eitherToMaybe)
#if defined(dbPostgres)
import Database.PostgreSQL.Simple (Only (..), (:.) (..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
#else
import Database.SQLite.Simple (Only (..), (:.) (..))
import Database.SQLite.Simple.QQ (sql)
#endif
getChatLockEntity :: DB.Connection -> AgentConnId -> ExceptT StoreError IO ChatLockEntity
getChatLockEntity :: Connection -> AgentConnId -> ExceptT StoreError IO ChatLockEntity
getChatLockEntity Connection
db AgentConnId
agentConnId = do
((UserId
connId, ConnType
connType) :. (Maybe UserId
contactId, Maybe UserId
groupMemberId, Maybe UserId
userContactLinkId)) <-
IO
(Either
StoreError
((UserId, ConnType) :. (Maybe UserId, Maybe UserId, Maybe UserId)))
-> ExceptT
StoreError
IO
((UserId, ConnType) :. (Maybe UserId, Maybe UserId, Maybe UserId))
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO
(Either
StoreError
((UserId, ConnType) :. (Maybe UserId, Maybe UserId, Maybe UserId)))
-> ExceptT
StoreError
IO
((UserId, ConnType) :. (Maybe UserId, Maybe UserId, Maybe UserId)))
-> (IO
[(UserId, ConnType) :. (Maybe UserId, Maybe UserId, Maybe UserId)]
-> IO
(Either
StoreError
((UserId, ConnType)
:. (Maybe UserId, Maybe UserId, Maybe UserId))))
-> IO
[(UserId, ConnType) :. (Maybe UserId, Maybe UserId, Maybe UserId)]
-> ExceptT
StoreError
IO
((UserId, ConnType) :. (Maybe UserId, Maybe UserId, Maybe UserId))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((UserId, ConnType) :. (Maybe UserId, Maybe UserId, Maybe UserId))
-> (UserId, ConnType)
:. (Maybe UserId, Maybe UserId, Maybe UserId))
-> StoreError
-> IO
[(UserId, ConnType) :. (Maybe UserId, Maybe UserId, Maybe UserId)]
-> IO
(Either
StoreError
((UserId, ConnType) :. (Maybe UserId, Maybe UserId, Maybe UserId)))
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow ((UserId, ConnType) :. (Maybe UserId, Maybe UserId, Maybe UserId))
-> (UserId, ConnType) :. (Maybe UserId, Maybe UserId, Maybe UserId)
forall a. a -> a
id (AgentConnId -> StoreError
SEConnectionNotFound AgentConnId
agentConnId) (IO
[(UserId, ConnType) :. (Maybe UserId, Maybe UserId, Maybe UserId)]
-> ExceptT
StoreError
IO
((UserId, ConnType) :. (Maybe UserId, Maybe UserId, Maybe UserId)))
-> IO
[(UserId, ConnType) :. (Maybe UserId, Maybe UserId, Maybe UserId)]
-> ExceptT
StoreError
IO
((UserId, ConnType) :. (Maybe UserId, Maybe UserId, Maybe UserId))
forall a b. (a -> b) -> a -> b
$
Connection
-> Query
-> Only AgentConnId
-> IO
[(UserId, ConnType) :. (Maybe UserId, Maybe UserId, Maybe UserId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
Connection
db
[sql|
SELECT connection_id, conn_type, contact_id, group_member_id, user_contact_link_id
FROM connections
WHERE agent_conn_id = ?
|]
(AgentConnId -> Only AgentConnId
forall a. a -> Only a
Only AgentConnId
agentConnId)
let err :: ExceptT StoreError IO a
err = StoreError -> ExceptT StoreError IO a
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO a)
-> StoreError -> ExceptT StoreError IO a
forall a b. (a -> b) -> a -> b
$ String -> StoreError
SEInternalError (String -> StoreError) -> String -> StoreError
forall a b. (a -> b) -> a -> b
$ String
"connection " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ConnType -> String
forall a. Show a => a -> String
show ConnType
connType String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" without entity"
case ConnType
connType of
ConnType
ConnMember -> ExceptT StoreError IO ChatLockEntity
-> (UserId -> ExceptT StoreError IO ChatLockEntity)
-> Maybe UserId
-> ExceptT StoreError IO ChatLockEntity
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ExceptT StoreError IO ChatLockEntity
forall {a}. ExceptT StoreError IO a
err ((UserId -> ChatLockEntity)
-> ExceptT StoreError IO UserId
-> ExceptT StoreError IO ChatLockEntity
forall a b.
(a -> b) -> ExceptT StoreError IO a -> ExceptT StoreError IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UserId -> ChatLockEntity
CLGroup (ExceptT StoreError IO UserId
-> ExceptT StoreError IO ChatLockEntity)
-> (UserId -> ExceptT StoreError IO UserId)
-> UserId
-> ExceptT StoreError IO ChatLockEntity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserId -> ExceptT StoreError IO UserId
getMemberGroupId) Maybe UserId
groupMemberId
ConnType
ConnContact -> ChatLockEntity -> ExceptT StoreError IO ChatLockEntity
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatLockEntity -> ExceptT StoreError IO ChatLockEntity)
-> ChatLockEntity -> ExceptT StoreError IO ChatLockEntity
forall a b. (a -> b) -> a -> b
$ ChatLockEntity
-> (UserId -> ChatLockEntity) -> Maybe UserId -> ChatLockEntity
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (UserId -> ChatLockEntity
CLConnection UserId
connId) UserId -> ChatLockEntity
CLContact Maybe UserId
contactId
ConnType
ConnUserContact -> ExceptT StoreError IO ChatLockEntity
-> (UserId -> ExceptT StoreError IO ChatLockEntity)
-> Maybe UserId
-> ExceptT StoreError IO ChatLockEntity
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ExceptT StoreError IO ChatLockEntity
forall {a}. ExceptT StoreError IO a
err (ChatLockEntity -> ExceptT StoreError IO ChatLockEntity
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatLockEntity -> ExceptT StoreError IO ChatLockEntity)
-> (UserId -> ChatLockEntity)
-> UserId
-> ExceptT StoreError IO ChatLockEntity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserId -> ChatLockEntity
CLUserContact) Maybe UserId
userContactLinkId
where
getMemberGroupId :: GroupMemberId -> ExceptT StoreError IO GroupId
getMemberGroupId :: UserId -> ExceptT StoreError IO UserId
getMemberGroupId UserId
groupMemberId =
IO (Either StoreError UserId) -> ExceptT StoreError IO UserId
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError UserId) -> ExceptT StoreError IO UserId)
-> (IO [Only UserId] -> IO (Either StoreError UserId))
-> IO [Only UserId]
-> ExceptT StoreError IO UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only UserId -> UserId)
-> StoreError -> IO [Only UserId] -> IO (Either StoreError UserId)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only UserId -> UserId
forall a. Only a -> a
fromOnly (String -> StoreError
SEInternalError String
"group member connection group_id not found") (IO [Only UserId] -> ExceptT StoreError IO UserId)
-> IO [Only UserId] -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$
Connection -> Query -> Only UserId -> IO [Only UserId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT group_id FROM group_members WHERE group_member_id = ?" (UserId -> Only UserId
forall a. a -> Only a
Only UserId
groupMemberId)
getConnectionEntity :: DB.Connection -> VersionRangeChat -> User -> AgentConnId -> ExceptT StoreError IO ConnectionEntity
getConnectionEntity :: Connection
-> VersionRangeChat
-> User
-> AgentConnId
-> ExceptT StoreError IO ConnectionEntity
getConnectionEntity Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: UserId
userId :: User -> UserId
userId, UserId
userContactId :: UserId
userContactId :: User -> UserId
userContactId} AgentConnId
agentConnId = do
c :: Connection
c@Connection {ConnType
connType :: ConnType
connType :: Connection -> ConnType
connType, Maybe UserId
entityId :: Maybe UserId
entityId :: Connection -> Maybe UserId
entityId} <- ExceptT StoreError IO Connection
getConnection_
case Maybe UserId
entityId of
Maybe UserId
Nothing ->
if ConnType
connType ConnType -> ConnType -> Bool
forall a. Eq a => a -> a -> Bool
== ConnType
ConnContact
then ConnectionEntity -> ExceptT StoreError IO ConnectionEntity
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionEntity -> ExceptT StoreError IO ConnectionEntity)
-> ConnectionEntity -> ExceptT StoreError IO ConnectionEntity
forall a b. (a -> b) -> a -> b
$ Connection -> Maybe Contact -> ConnectionEntity
RcvDirectMsgConnection Connection
c Maybe Contact
forall a. Maybe a
Nothing
else StoreError -> ExceptT StoreError IO ConnectionEntity
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO ConnectionEntity)
-> StoreError -> ExceptT StoreError IO ConnectionEntity
forall a b. (a -> b) -> a -> b
$ String -> StoreError
SEInternalError (String -> StoreError) -> String -> StoreError
forall a b. (a -> b) -> a -> b
$ String
"connection " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ConnType -> String
forall a. Show a => a -> String
show ConnType
connType String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" without entity"
Just UserId
entId ->
case ConnType
connType of
ConnType
ConnMember -> (GroupInfo -> GroupMember -> ConnectionEntity)
-> (GroupInfo, GroupMember) -> ConnectionEntity
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Connection -> GroupInfo -> GroupMember -> ConnectionEntity
RcvGroupMsgConnection Connection
c) ((GroupInfo, GroupMember) -> ConnectionEntity)
-> ExceptT StoreError IO (GroupInfo, GroupMember)
-> ExceptT StoreError IO ConnectionEntity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserId
-> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember)
getGroupAndMember_ UserId
entId Connection
c
ConnType
ConnContact -> Connection -> Maybe Contact -> ConnectionEntity
RcvDirectMsgConnection Connection
c (Maybe Contact -> ConnectionEntity)
-> (Contact -> Maybe Contact) -> Contact -> ConnectionEntity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contact -> Maybe Contact
forall a. a -> Maybe a
Just (Contact -> ConnectionEntity)
-> ExceptT StoreError IO Contact
-> ExceptT StoreError IO ConnectionEntity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserId -> Connection -> ExceptT StoreError IO Contact
getContactRec_ UserId
entId Connection
c
ConnType
ConnUserContact -> Connection -> UserContact -> ConnectionEntity
UserContactConnection Connection
c (UserContact -> ConnectionEntity)
-> ExceptT StoreError IO UserContact
-> ExceptT StoreError IO ConnectionEntity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserId -> ExceptT StoreError IO UserContact
getUserContact_ UserId
entId
where
getConnection_ :: ExceptT StoreError IO Connection
getConnection_ :: ExceptT StoreError IO Connection
getConnection_ = 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) (AgentConnId -> StoreError
SEConnectionNotFound AgentConnId
agentConnId) (IO [ConnectionRow] -> IO (Either StoreError Connection))
-> IO [ConnectionRow] -> IO (Either StoreError Connection)
forall a b. (a -> b) -> a -> b
$
Connection
-> Query -> (UserId, AgentConnId, ConnStatus) -> 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 agent_conn_id = ? AND conn_status != ?
|]
(UserId
userId, AgentConnId
agentConnId, ConnStatus
ConnDeleted)
getContactRec_ :: Int64 -> Connection -> ExceptT StoreError IO Contact
getContactRec_ :: UserId -> Connection -> ExceptT StoreError IO Contact
getContactRec_ UserId
contactId Connection
c = 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 (Either StoreError Contact) -> ExceptT StoreError IO Contact
forall a b. (a -> b) -> a -> b
$ do
[UserId]
chatTags <- Connection -> UserId -> IO [UserId]
getDirectChatTags Connection
db UserId
contactId
(ContactRow' -> Contact)
-> StoreError -> IO [ContactRow'] -> IO (Either StoreError Contact)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (UserId -> Connection -> [UserId] -> ContactRow' -> Contact
toContact' UserId
contactId Connection
c [UserId]
chatTags) (String -> StoreError
SEInternalError String
"referenced contact not found") (IO [ContactRow'] -> IO (Either StoreError Contact))
-> IO [ContactRow'] -> IO (Either StoreError Contact)
forall a b. (a -> b) -> a -> b
$
Connection
-> Query -> (UserId, UserId, ContactStatus) -> IO [ContactRow']
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
Connection
db
[sql|
SELECT
c.contact_profile_id, c.local_display_name, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, c.contact_used, c.contact_status, c.enable_ntfs, c.send_rcpts, c.favorite,
p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts, c.conn_full_link_to_connect, c.conn_short_link_to_connect, c.welcome_shared_msg_id, c.request_shared_msg_id, c.contact_request_id,
c.contact_group_member_id, c.contact_grp_inv_sent, c.grp_direct_inv_link, c.grp_direct_inv_from_group_id, c.grp_direct_inv_from_group_member_id, c.grp_direct_inv_from_member_conn_id, c.grp_direct_inv_started_connection,
c.ui_themes, c.chat_deleted, c.custom_data, c.chat_item_ttl
FROM contacts c
JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id
WHERE c.user_id = ? AND c.contact_id = ? AND c.contact_status = ? AND c.deleted = 0
|]
(UserId
userId, UserId
contactId, ContactStatus
CSActive)
toContact' :: Int64 -> Connection -> [ChatTagId] -> ContactRow' -> Contact
toContact' :: UserId -> Connection -> [UserId] -> ContactRow' -> Contact
toContact' UserId
contactId Connection
conn [UserId]
chatTags ((UserId
profileId, GroupName
localDisplayName, GroupName
displayName, GroupName
fullName, Maybe GroupName
shortDescr, Maybe ImageData
image, Maybe ConnLinkContact
contactLink, Maybe ChatPeerType
peerType, GroupName
localAlias, BI Bool
contactUsed, ContactStatus
contactStatus) :. (Maybe MsgFilter
enableNtfs_, Maybe BoolInt
sendRcpts, BI Bool
favorite, Maybe Preferences
preferences, Preferences
userPreferences, UTCTime
createdAt, UTCTime
updatedAt, Maybe UTCTime
chatTs) :. PreparedContactRow
preparedContactRow :. (Maybe UserId
contactRequestId, Maybe UserId
contactGroupMemberId, BI Bool
contactGrpInvSent) :. GroupDirectInvitationRow
groupDirectInvRow :. (Maybe UIThemeEntityOverrides
uiThemes, BI Bool
chatDeleted, Maybe CustomData
customData, Maybe UserId
chatItemTTL)) =
let profile :: LocalProfile
profile = LocalProfile {UserId
profileId :: UserId
profileId :: UserId
profileId, GroupName
displayName :: GroupName
displayName :: GroupName
displayName, GroupName
fullName :: GroupName
fullName :: GroupName
fullName, Maybe GroupName
shortDescr :: Maybe GroupName
shortDescr :: Maybe GroupName
shortDescr, Maybe ImageData
image :: Maybe ImageData
image :: Maybe ImageData
image, Maybe ConnLinkContact
contactLink :: Maybe ConnLinkContact
contactLink :: Maybe ConnLinkContact
contactLink, Maybe ChatPeerType
peerType :: Maybe ChatPeerType
peerType :: Maybe ChatPeerType
peerType, Maybe Preferences
preferences :: Maybe Preferences
preferences :: Maybe Preferences
preferences, GroupName
localAlias :: GroupName
localAlias :: GroupName
localAlias}
chatSettings :: ChatSettings
chatSettings = ChatSettings {enableNtfs :: MsgFilter
enableNtfs = MsgFilter -> Maybe MsgFilter -> MsgFilter
forall a. a -> Maybe a -> a
fromMaybe MsgFilter
MFAll Maybe MsgFilter
enableNtfs_, sendRcpts :: Maybe Bool
sendRcpts = BoolInt -> Bool
unBI (BoolInt -> Bool) -> Maybe BoolInt -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BoolInt
sendRcpts, Bool
favorite :: Bool
favorite :: Bool
favorite}
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
activeConn :: Maybe Connection
activeConn = Connection -> Maybe Connection
forall a. a -> Maybe a
Just Connection
conn
preparedContact :: Maybe PreparedContact
preparedContact = PreparedContactRow -> Maybe PreparedContact
toPreparedContact PreparedContactRow
preparedContactRow
groupDirectInv :: Maybe GroupDirectInvitation
groupDirectInv = GroupDirectInvitationRow -> Maybe GroupDirectInvitation
toGroupDirectInvitation GroupDirectInvitationRow
groupDirectInvRow
in Contact {UserId
contactId :: UserId
contactId :: UserId
contactId, GroupName
localDisplayName :: GroupName
localDisplayName :: GroupName
localDisplayName, LocalProfile
profile :: LocalProfile
profile :: LocalProfile
profile, Maybe Connection
activeConn :: Maybe Connection
activeConn :: Maybe Connection
activeConn, Bool
contactUsed :: Bool
contactUsed :: Bool
contactUsed, ContactStatus
contactStatus :: ContactStatus
contactStatus :: ContactStatus
contactStatus, ChatSettings
chatSettings :: ChatSettings
chatSettings :: ChatSettings
chatSettings, Preferences
userPreferences :: Preferences
userPreferences :: Preferences
userPreferences, ContactUserPreferences
mergedPreferences :: ContactUserPreferences
mergedPreferences :: ContactUserPreferences
mergedPreferences, UTCTime
createdAt :: UTCTime
createdAt :: UTCTime
createdAt, UTCTime
updatedAt :: UTCTime
updatedAt :: UTCTime
updatedAt, Maybe UTCTime
chatTs :: Maybe UTCTime
chatTs :: Maybe UTCTime
chatTs, Maybe PreparedContact
preparedContact :: Maybe PreparedContact
preparedContact :: Maybe PreparedContact
preparedContact, Maybe UserId
contactRequestId :: Maybe UserId
contactRequestId :: Maybe UserId
contactRequestId, Maybe UserId
contactGroupMemberId :: Maybe UserId
contactGroupMemberId :: Maybe UserId
contactGroupMemberId, Bool
contactGrpInvSent :: Bool
contactGrpInvSent :: Bool
contactGrpInvSent, Maybe GroupDirectInvitation
groupDirectInv :: Maybe GroupDirectInvitation
groupDirectInv :: Maybe GroupDirectInvitation
groupDirectInv, [UserId]
chatTags :: [UserId]
chatTags :: [UserId]
chatTags, Maybe UserId
chatItemTTL :: Maybe UserId
chatItemTTL :: Maybe UserId
chatItemTTL, Maybe UIThemeEntityOverrides
uiThemes :: Maybe UIThemeEntityOverrides
uiThemes :: Maybe UIThemeEntityOverrides
uiThemes, Bool
chatDeleted :: Bool
chatDeleted :: Bool
chatDeleted, Maybe CustomData
customData :: Maybe CustomData
customData :: Maybe CustomData
customData}
getGroupAndMember_ :: Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember)
getGroupAndMember_ :: UserId
-> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember)
getGroupAndMember_ UserId
groupMemberId Connection
c = do
(GroupInfo, GroupMember)
gm <-
IO (Either StoreError (GroupInfo, GroupMember))
-> ExceptT StoreError IO (GroupInfo, GroupMember)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (GroupInfo, GroupMember))
-> ExceptT StoreError IO (GroupInfo, GroupMember))
-> IO (Either StoreError (GroupInfo, GroupMember))
-> ExceptT StoreError IO (GroupInfo, GroupMember)
forall a b. (a -> b) -> a -> b
$
((GroupInfoRow :. GroupMemberRow) -> (GroupInfo, GroupMember))
-> StoreError
-> IO [GroupInfoRow :. GroupMemberRow]
-> IO (Either StoreError (GroupInfo, GroupMember))
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (Connection
-> (GroupInfoRow :. GroupMemberRow) -> (GroupInfo, GroupMember)
toGroupAndMember Connection
c) (String -> StoreError
SEInternalError String
"referenced group member not found") (IO [GroupInfoRow :. GroupMemberRow]
-> IO (Either StoreError (GroupInfo, GroupMember)))
-> IO [GroupInfoRow :. GroupMemberRow]
-> IO (Either StoreError (GroupInfo, GroupMember))
forall a b. (a -> b) -> a -> b
$
Connection
-> Query
-> (UserId, UserId, UserId, GroupMemberStatus, GroupMemberStatus,
GroupMemberStatus)
-> IO [GroupInfoRow :. GroupMemberRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
Connection
db
[sql|
SELECT
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.short_descr, g.local_alias, gp.description, gp.image,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_prepared_connection, g.conn_link_started_connection, g.welcome_shared_msg_id, g.request_shared_msg_id,
g.business_chat, g.business_member_id, g.customer_member_id,
g.ui_themes, g.summary_current_members_count, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.index_in_group, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.short_descr, pu.image, pu.contact_link, pu.chat_peer_type, pu.local_alias, pu.preferences,
mu.created_at, mu.updated_at,
mu.support_chat_ts, mu.support_chat_items_unread, mu.support_chat_items_member_attention, mu.support_chat_items_mentions, mu.support_chat_last_msg_from_member_ts,
-- from GroupMember
m.group_member_id, m.group_id, m.index_in_group, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
m.created_at, m.updated_at,
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
JOIN groups g ON g.group_id = m.group_id
JOIN group_profiles gp USING (group_profile_id)
JOIN group_members mu ON g.group_id = mu.group_id
JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id)
WHERE m.group_member_id = ? AND g.user_id = ? AND mu.contact_id = ?
AND mu.member_status NOT IN (?,?,?)
|]
(UserId
groupMemberId, UserId
userId, UserId
userContactId, GroupMemberStatus
GSMemRemoved, GroupMemberStatus
GSMemLeft, GroupMemberStatus
GSMemGroupDeleted)
IO (GroupInfo, GroupMember)
-> ExceptT StoreError IO (GroupInfo, GroupMember)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GroupInfo, GroupMember)
-> ExceptT StoreError IO (GroupInfo, GroupMember))
-> IO (GroupInfo, GroupMember)
-> ExceptT StoreError IO (GroupInfo, GroupMember)
forall a b. (a -> b) -> a -> b
$ (GroupInfo -> IO GroupInfo)
-> (GroupMember -> IO GroupMember)
-> (GroupInfo, GroupMember)
-> IO (GroupInfo, GroupMember)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> (a, b) -> f (c, d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (Connection -> GroupInfo -> IO GroupInfo
addGroupChatTags Connection
db) GroupMember -> IO GroupMember
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupInfo, GroupMember)
gm
toGroupAndMember :: Connection -> GroupInfoRow :. GroupMemberRow -> (GroupInfo, GroupMember)
toGroupAndMember :: Connection
-> (GroupInfoRow :. GroupMemberRow) -> (GroupInfo, GroupMember)
toGroupAndMember Connection
c (GroupInfoRow
groupInfoRow :. GroupMemberRow
memberRow) =
let groupInfo :: GroupInfo
groupInfo = VersionRangeChat -> UserId -> [UserId] -> GroupInfoRow -> GroupInfo
toGroupInfo VersionRangeChat
vr UserId
userContactId [] GroupInfoRow
groupInfoRow
member :: GroupMember
member = UserId -> GroupMemberRow -> GroupMember
toGroupMember UserId
userContactId GroupMemberRow
memberRow
in (GroupInfo
groupInfo, (GroupMember
member :: GroupMember) {activeConn = Just c})
getUserContact_ :: Int64 -> ExceptT StoreError IO UserContact
getUserContact_ :: UserId -> ExceptT StoreError IO UserContact
getUserContact_ UserId
userContactLinkId = IO (Either StoreError UserContact)
-> ExceptT StoreError IO UserContact
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError UserContact)
-> ExceptT StoreError IO UserContact)
-> IO (Either StoreError UserContact)
-> ExceptT StoreError IO UserContact
forall a b. (a -> b) -> a -> b
$ do
[(ConnReqContact, Maybe UserId)] -> Either StoreError UserContact
userContact_
([(ConnReqContact, Maybe UserId)] -> Either StoreError UserContact)
-> IO [(ConnReqContact, Maybe UserId)]
-> IO (Either StoreError UserContact)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query -> (UserId, UserId) -> IO [(ConnReqContact, Maybe UserId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
Connection
db
[sql|
SELECT conn_req_contact, group_id
FROM user_contact_links
WHERE user_id = ? AND user_contact_link_id = ?
|]
(UserId
userId, UserId
userContactLinkId)
where
userContact_ :: [(ConnReqContact, Maybe GroupId)] -> Either StoreError UserContact
userContact_ :: [(ConnReqContact, Maybe UserId)] -> Either StoreError UserContact
userContact_ [(ConnReqContact
cReq, Maybe UserId
groupId)] = UserContact -> Either StoreError UserContact
forall a b. b -> Either a b
Right UserContact {UserId
userContactLinkId :: UserId
userContactLinkId :: UserId
userContactLinkId, connReqContact :: ConnReqContact
connReqContact = ConnReqContact
cReq, Maybe UserId
groupId :: Maybe UserId
groupId :: Maybe UserId
groupId}
userContact_ [(ConnReqContact, Maybe UserId)]
_ = StoreError -> Either StoreError UserContact
forall a b. a -> Either a b
Left StoreError
SEUserContactLinkNotFound
getConnectionEntityByConnReq :: DB.Connection -> VersionRangeChat -> User -> (ConnReqInvitation, ConnReqInvitation) -> IO (Maybe ConnectionEntity)
getConnectionEntityByConnReq :: Connection
-> VersionRangeChat
-> User
-> (ConnReqInvitation, ConnReqInvitation)
-> IO (Maybe ConnectionEntity)
getConnectionEntityByConnReq Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} (ConnReqInvitation
cReqSchema1, ConnReqInvitation
cReqSchema2) = do
Maybe AgentConnId
connId_ <-
(Only AgentConnId -> AgentConnId)
-> IO [Only AgentConnId] -> IO (Maybe AgentConnId)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only AgentConnId -> AgentConnId
forall a. Only a -> a
fromOnly (IO [Only AgentConnId] -> IO (Maybe AgentConnId))
-> IO [Only AgentConnId] -> IO (Maybe AgentConnId)
forall a b. (a -> b) -> a -> b
$
Connection
-> Query
-> (UserId, ConnReqInvitation, ConnReqInvitation)
-> IO [Only AgentConnId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT agent_conn_id FROM connections WHERE user_id = ? AND conn_req_inv IN (?,?) LIMIT 1" (UserId
userId, ConnReqInvitation
cReqSchema1, ConnReqInvitation
cReqSchema2)
IO (Maybe ConnectionEntity)
-> (AgentConnId -> IO (Maybe ConnectionEntity))
-> Maybe AgentConnId
-> IO (Maybe ConnectionEntity)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe ConnectionEntity -> IO (Maybe ConnectionEntity)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ConnectionEntity
forall a. Maybe a
Nothing) ((Either StoreError ConnectionEntity -> Maybe ConnectionEntity)
-> IO (Either StoreError ConnectionEntity)
-> IO (Maybe ConnectionEntity)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either StoreError ConnectionEntity -> Maybe ConnectionEntity
forall a b. Either a b -> Maybe b
eitherToMaybe (IO (Either StoreError ConnectionEntity)
-> IO (Maybe ConnectionEntity))
-> (AgentConnId -> IO (Either StoreError ConnectionEntity))
-> AgentConnId
-> IO (Maybe ConnectionEntity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT StoreError IO ConnectionEntity
-> IO (Either StoreError ConnectionEntity)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO ConnectionEntity
-> IO (Either StoreError ConnectionEntity))
-> (AgentConnId -> ExceptT StoreError IO ConnectionEntity)
-> AgentConnId
-> IO (Either StoreError ConnectionEntity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> VersionRangeChat
-> User
-> AgentConnId
-> ExceptT StoreError IO ConnectionEntity
getConnectionEntity Connection
db VersionRangeChat
vr User
user) Maybe AgentConnId
connId_
getConnectionEntityViaShortLink :: DB.Connection -> VersionRangeChat -> User -> ShortLinkInvitation -> IO (Maybe (ConnReqInvitation, ConnectionEntity))
getConnectionEntityViaShortLink :: Connection
-> VersionRangeChat
-> User
-> ShortLinkInvitation
-> IO (Maybe (ConnReqInvitation, ConnectionEntity))
getConnectionEntityViaShortLink Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} ShortLinkInvitation
shortLink = (Either StoreError (ConnReqInvitation, ConnectionEntity)
-> Maybe (ConnReqInvitation, ConnectionEntity))
-> IO (Either StoreError (ConnReqInvitation, ConnectionEntity))
-> IO (Maybe (ConnReqInvitation, ConnectionEntity))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either StoreError (ConnReqInvitation, ConnectionEntity)
-> Maybe (ConnReqInvitation, ConnectionEntity)
forall a b. Either a b -> Maybe b
eitherToMaybe (IO (Either StoreError (ConnReqInvitation, ConnectionEntity))
-> IO (Maybe (ConnReqInvitation, ConnectionEntity)))
-> IO (Either StoreError (ConnReqInvitation, ConnectionEntity))
-> IO (Maybe (ConnReqInvitation, ConnectionEntity))
forall a b. (a -> b) -> a -> b
$ ExceptT StoreError IO (ConnReqInvitation, ConnectionEntity)
-> IO (Either StoreError (ConnReqInvitation, ConnectionEntity))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO (ConnReqInvitation, ConnectionEntity)
-> IO (Either StoreError (ConnReqInvitation, ConnectionEntity)))
-> ExceptT StoreError IO (ConnReqInvitation, ConnectionEntity)
-> IO (Either StoreError (ConnReqInvitation, ConnectionEntity))
forall a b. (a -> b) -> a -> b
$ do
(ConnReqInvitation
cReq, AgentConnId
connId) <- IO (Either StoreError (ConnReqInvitation, AgentConnId))
-> ExceptT StoreError IO (ConnReqInvitation, AgentConnId)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT IO (Either StoreError (ConnReqInvitation, AgentConnId))
getConnReqConnId
(ConnReqInvitation
cReq,) (ConnectionEntity -> (ConnReqInvitation, ConnectionEntity))
-> ExceptT StoreError IO ConnectionEntity
-> ExceptT StoreError IO (ConnReqInvitation, ConnectionEntity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> AgentConnId
-> ExceptT StoreError IO ConnectionEntity
getConnectionEntity Connection
db VersionRangeChat
vr User
user AgentConnId
connId
where
getConnReqConnId :: IO (Either StoreError (ConnReqInvitation, AgentConnId))
getConnReqConnId =
((Maybe ConnReqInvitation, AgentConnId)
-> Either StoreError (ConnReqInvitation, AgentConnId))
-> StoreError
-> IO [(Maybe ConnReqInvitation, AgentConnId)]
-> IO (Either StoreError (ConnReqInvitation, AgentConnId))
forall a e b. (a -> Either e b) -> e -> IO [a] -> IO (Either e b)
firstRow' (Maybe ConnReqInvitation, AgentConnId)
-> Either StoreError (ConnReqInvitation, AgentConnId)
forall {a} {b}. (Maybe a, b) -> Either StoreError (a, b)
toConnReqConnId (String -> StoreError
SEInternalError String
"connection not found") (IO [(Maybe ConnReqInvitation, AgentConnId)]
-> IO (Either StoreError (ConnReqInvitation, AgentConnId)))
-> IO [(Maybe ConnReqInvitation, AgentConnId)]
-> IO (Either StoreError (ConnReqInvitation, AgentConnId))
forall a b. (a -> b) -> a -> b
$
Connection
-> Query
-> (UserId, ShortLinkInvitation)
-> IO [(Maybe ConnReqInvitation, AgentConnId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
Connection
db
[sql|
SELECT conn_req_inv, agent_conn_id
FROM connections
WHERE user_id = ? AND short_link_inv = ? LIMIT 1
|]
(UserId
userId, ShortLinkInvitation
shortLink)
toConnReqConnId :: (Maybe a, b) -> Either StoreError (a, b)
toConnReqConnId = \case
(Just a
cReq, b
connId) -> (a, b) -> Either StoreError (a, b)
forall a b. b -> Either a b
Right (a
cReq, b
connId)
(Maybe a, b)
_ -> StoreError -> Either StoreError (a, b)
forall a b. a -> Either a b
Left (StoreError -> Either StoreError (a, b))
-> StoreError -> Either StoreError (a, b)
forall a b. (a -> b) -> a -> b
$ String -> StoreError
SEInternalError String
"no connection request"
getContactConnEntityByConnReqHash :: DB.Connection -> VersionRangeChat -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe ConnectionEntity)
getContactConnEntityByConnReqHash :: Connection
-> VersionRangeChat
-> User
-> (ConnReqUriHash, ConnReqUriHash)
-> IO (Maybe ConnectionEntity)
getContactConnEntityByConnReqHash Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} (ConnReqUriHash
cReqHash1, ConnReqUriHash
cReqHash2) = do
Maybe AgentConnId
connId_ <-
(Only AgentConnId -> AgentConnId)
-> IO [Only AgentConnId] -> IO (Maybe AgentConnId)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only AgentConnId -> AgentConnId
forall a. Only a -> a
fromOnly (IO [Only AgentConnId] -> IO (Maybe AgentConnId))
-> IO [Only AgentConnId] -> IO (Maybe AgentConnId)
forall a b. (a -> b) -> a -> b
$
Connection
-> Query
-> (UserId, ConnReqUriHash, ConnReqUriHash, ConnStatus)
-> IO [Only AgentConnId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
Connection
db
[sql|
SELECT agent_conn_id FROM (
SELECT
agent_conn_id,
(CASE WHEN contact_id IS NOT NULL THEN 1 ELSE 0 END) AS conn_ord
FROM connections
WHERE user_id = ? AND via_contact_uri_hash IN (?,?) AND conn_status != ?
ORDER BY conn_ord DESC, created_at DESC
LIMIT 1
) c
|]
(UserId
userId, ConnReqUriHash
cReqHash1, ConnReqUriHash
cReqHash2, ConnStatus
ConnDeleted)
IO (Maybe ConnectionEntity)
-> (AgentConnId -> IO (Maybe ConnectionEntity))
-> Maybe AgentConnId
-> IO (Maybe ConnectionEntity)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe ConnectionEntity -> IO (Maybe ConnectionEntity)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ConnectionEntity
forall a. Maybe a
Nothing) ((Either StoreError ConnectionEntity -> Maybe ConnectionEntity)
-> IO (Either StoreError ConnectionEntity)
-> IO (Maybe ConnectionEntity)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either StoreError ConnectionEntity -> Maybe ConnectionEntity
forall a b. Either a b -> Maybe b
eitherToMaybe (IO (Either StoreError ConnectionEntity)
-> IO (Maybe ConnectionEntity))
-> (AgentConnId -> IO (Either StoreError ConnectionEntity))
-> AgentConnId
-> IO (Maybe ConnectionEntity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT StoreError IO ConnectionEntity
-> IO (Either StoreError ConnectionEntity)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO ConnectionEntity
-> IO (Either StoreError ConnectionEntity))
-> (AgentConnId -> ExceptT StoreError IO ConnectionEntity)
-> AgentConnId
-> IO (Either StoreError ConnectionEntity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> VersionRangeChat
-> User
-> AgentConnId
-> ExceptT StoreError IO ConnectionEntity
getConnectionEntity Connection
db VersionRangeChat
vr User
user) Maybe AgentConnId
connId_
getContactConnsToSub :: DB.Connection -> User -> Bool -> IO [ConnId]
getContactConnsToSub :: Connection -> User -> Bool -> IO [ConnId]
getContactConnsToSub Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} Bool
filterToSubscribe =
(Only ConnId -> ConnId) -> [Only ConnId] -> [ConnId]
forall a b. (a -> b) -> [a] -> [b]
map Only ConnId -> ConnId
forall a. Only a -> a
fromOnly ([Only ConnId] -> [ConnId]) -> IO [Only ConnId] -> IO [ConnId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query -> (UserId, ConnStatus, ContactStatus) -> IO [Only ConnId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
query (UserId
userId, ConnStatus
ConnDeleted, ContactStatus
CSActive)
where
query :: Query
query
| Bool
filterToSubscribe = Query
baseQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND c.to_subscribe = 1 " Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
cond
| Bool
otherwise = Query
baseQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" " Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
cond
baseQuery :: Query
baseQuery =
[sql|
SELECT c.agent_conn_id
FROM connections c
JOIN contacts ct ON ct.contact_id = c.contact_id
WHERE c.user_id = ?
|]
cond :: Query
cond =
[sql|
AND c.conn_status != ?
AND ct.contact_status = ? AND ct.deleted = 0
|]
getUCLConnsToSub :: DB.Connection -> User -> Bool -> IO [ConnId]
getUCLConnsToSub :: Connection -> User -> Bool -> IO [ConnId]
getUCLConnsToSub Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} Bool
filterToSubscribe =
(Only ConnId -> ConnId) -> [Only ConnId] -> [ConnId]
forall a b. (a -> b) -> [a] -> [b]
map Only ConnId -> ConnId
forall a. Only a -> a
fromOnly ([Only ConnId] -> [ConnId]) -> IO [Only ConnId] -> IO [ConnId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> (UserId, ConnStatus) -> IO [Only ConnId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
query (UserId
userId, ConnStatus
ConnDeleted)
where
query :: Query
query
| Bool
filterToSubscribe = Query
baseQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND c.to_subscribe = 1 " Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
cond
| Bool
otherwise = Query
baseQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" " Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
cond
baseQuery :: Query
baseQuery =
[sql|
SELECT c.agent_conn_id
FROM connections c
JOIN user_contact_links ucl ON ucl.user_contact_link_id = c.user_contact_link_id
WHERE c.user_id = ?
|]
cond :: Query
cond = Query
" AND c.conn_status != ?"
getMemberConnsToSub :: DB.Connection -> User -> Bool -> IO [ConnId]
getMemberConnsToSub :: Connection -> User -> Bool -> IO [ConnId]
getMemberConnsToSub Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId, UserId
userContactId :: User -> UserId
userContactId :: UserId
userContactId} Bool
filterToSubscribe =
(Only ConnId -> ConnId) -> [Only ConnId] -> [ConnId]
forall a b. (a -> b) -> [a] -> [b]
map Only ConnId -> ConnId
forall a. Only a -> a
fromOnly ([Only ConnId] -> [ConnId]) -> IO [Only ConnId] -> IO [ConnId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Connection
-> Query
-> ((UserId, UserId, GroupMemberStatus, GroupMemberStatus,
GroupMemberStatus)
:. (UserId, ConnStatus, GroupMemberStatus, GroupMemberStatus,
GroupMemberStatus))
-> IO [Only ConnId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
Connection
db
Query
query
((UserId
userId, UserId
userContactId, GroupMemberStatus
GSMemRemoved, GroupMemberStatus
GSMemLeft, GroupMemberStatus
GSMemGroupDeleted)
(UserId, UserId, GroupMemberStatus, GroupMemberStatus,
GroupMemberStatus)
-> (UserId, ConnStatus, GroupMemberStatus, GroupMemberStatus,
GroupMemberStatus)
-> (UserId, UserId, GroupMemberStatus, GroupMemberStatus,
GroupMemberStatus)
:. (UserId, ConnStatus, GroupMemberStatus, GroupMemberStatus,
GroupMemberStatus)
forall h t. h -> t -> h :. t
:. (UserId
userId, ConnStatus
ConnDeleted, GroupMemberStatus
GSMemRemoved, GroupMemberStatus
GSMemLeft, GroupMemberStatus
GSMemGroupDeleted))
where
query :: Query
query
| Bool
filterToSubscribe = Query
baseQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND c.to_subscribe = 1"
| Bool
otherwise = Query
baseQuery
baseQuery :: Query
baseQuery =
[sql|
WITH user_groups AS MATERIALIZED (
SELECT g.group_id
FROM groups g
JOIN group_members mu ON mu.group_id = g.group_id
WHERE g.user_id = ?
AND mu.contact_id = ?
AND mu.member_status NOT IN (?,?,?)
)
SELECT c.agent_conn_id
FROM connections c
JOIN group_members m ON m.group_member_id = c.group_member_id
JOIN user_groups ug ON ug.group_id = m.group_id
WHERE c.user_id = ?
AND c.conn_status != ?
AND m.member_status NOT IN (?,?,?)
|]
getPendingConnsToSub :: DB.Connection -> User -> Bool -> IO [ConnId]
getPendingConnsToSub :: Connection -> User -> Bool -> IO [ConnId]
getPendingConnsToSub Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} Bool
filterToSubscribe =
(Only ConnId -> ConnId) -> [Only ConnId] -> [ConnId]
forall a b. (a -> b) -> [a] -> [b]
map Only ConnId -> ConnId
forall a. Only a -> a
fromOnly ([Only ConnId] -> [ConnId]) -> IO [Only ConnId] -> IO [ConnId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query -> (UserId, ConnType, ConnStatus) -> IO [Only ConnId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
query (UserId
userId, ConnType
ConnContact, ConnStatus
ConnDeleted)
where
query :: Query
query
| Bool
filterToSubscribe = Query
baseQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND to_subscribe = 1 " Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
cond
| Bool
otherwise = Query
baseQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" " Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
cond
baseQuery :: Query
baseQuery =
[sql|
SELECT agent_conn_id
FROM connections
WHERE user_id = ?
|]
cond :: Query
cond =
[sql|
AND conn_type = ?
AND contact_id IS NULL
AND conn_status != ?
|]
shouldSyncConnections :: DB.Connection -> IO Bool
shouldSyncConnections :: Connection -> IO Bool
shouldSyncConnections Connection
db =
Only BoolInt -> Bool
fromOnlyBI (Only BoolInt -> Bool)
-> ([Only BoolInt] -> Only BoolInt) -> [Only BoolInt] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Only BoolInt] -> Only BoolInt
forall a. HasCallStack => [a] -> a
head
([Only BoolInt] -> Bool) -> IO [Only BoolInt] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> IO [Only BoolInt]
forall r. FromRow r => Connection -> Query -> IO [r]
DB.query_
Connection
db
Query
"SELECT should_sync FROM connections_sync WHERE connections_sync_id = 1"
setConnectionsSyncTs :: DB.Connection -> IO ()
setConnectionsSyncTs :: Connection -> IO ()
setConnectionsSyncTs Connection
db = do
UTCTime
currentTs <- IO UTCTime
getCurrentTime
Connection -> Query -> Only UTCTime -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
Connection
db
[sql|
UPDATE connections_sync
SET should_sync = 0, last_sync_ts = ?
WHERE connections_sync_id = 1
|]
(UTCTime -> Only UTCTime
forall a. a -> Only a
Only UTCTime
currentTs)