{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}

module Simplex.Chat.Store.Groups
  ( -- * Util methods
    GroupInfoRow,
    GroupMemberRow,
    MaybeGroupMemberRow,
    toGroupInfo,
    toGroupMember,
    toMaybeGroupMember,

    -- * Group functions
    createGroupLink,
    getGroupLinkConnection,
    deleteGroupLink,
    getGroupLink,
    getGroupLinkId,
    setGroupLinkMemberRole,
    setGroupLinkShortLink,
    createNewGroup,
    createGroupInvitation,
    deleteContactCardKeepConn,
    createPreparedGroup,
    updatePreparedGroupUser,
    updatePreparedUserAndHostMembersInvited,
    updatePreparedUserAndHostMembersRejected,
    createGroupInvitedViaLink,
    createGroupRejectedViaLink,
    setGroupInvitationChatItemId,
    getGroup,
    getGroupInfo,
    getGroupInfoByUserContactLinkConnReq,
    getGroupInfoViaUserShortLink,
    getGroupViaShortLinkToConnect,
    getGroupInfoByGroupLinkHash,
    updateGroupProfile,
    updateGroupPreferences,
    updateGroupProfileFromMember,
    getGroupIdByName,
    getGroupMemberIdByName,
    getActiveMembersByName,
    getGroupInfoByName,
    getGroupMember,
    getHostMember,
    getMentionedGroupMember,
    getMentionedMemberByMemberId,
    getGroupMemberById,
    getGroupMemberByIndex,
    getGroupMemberByMemberId,
    getGroupMemberIdViaMemberId,
    getScopeMemberIdViaMemberId,
    getGroupMembers,
    getGroupMembersByIndexes,
    getSupportScopeMembersByIndexes,
    getGroupModerators,
    getGroupRelays,
    getGroupMembersForExpiration,
    getGroupCurrentMembersCount,
    deleteGroupChatItems,
    deleteGroupMembers,
    cleanupHostGroupLinkConn,
    deleteGroup,
    getBaseGroupDetails,
    getContactGroupPreferences,
    getGroupInvitation,
    createNewContactMember,
    createNewContactMemberAsync,
    createJoiningMember,
    getMemberJoinRequest,
    createJoiningMemberConnection,
    createBusinessRequestGroup,
    getContactViaMember,
    setNewContactMemberConnRequest,
    getMemberInvitation,
    createMemberConnection,
    createMemberConnectionAsync,
    updateGroupMemberStatus,
    updateGroupMemberStatusById,
    updateGroupMemberAccepted,
    deleteGroupMemberSupportChat,
    updateGroupMembersRequireAttention,
    decreaseGroupMembersRequireAttention,
    increaseGroupMembersRequireAttention,
    createNewGroupMember,
    checkGroupMemberHasItems,
    deleteGroupMember,
    deleteGroupMemberConnection,
    updateGroupMemberRole,
    setMemberVectorNewRelations,
    setMembersVectorsNewRelation,
    setMemberVectorRelationConnected,
    getMemberRelationsVector,
    createIntroReMember,
    createIntroToMemberContact,
    getMatchingContacts,
    getMatchingMembers,
    getMatchingMemberContacts,
    createSentProbe,
    createSentProbeHash,
    matchReceivedProbe,
    matchReceivedProbeHash,
    matchSentProbe,
    associateMemberWithContactRecord,
    associateContactWithMemberRecord,
    deleteOldProbes,
    updateGroupSettings,
    updateGroupMemberSettings,
    updateGroupMemberBlocked,
    getHostConnId,
    createMemberContact,
    getMemberContact,
    setContactGrpInvSent,
    createMemberContactInvited,
    updateMemberContactInvited,
    createMemberContactConn,
    getMemberContactInvited,
    setMemberContactStartedConnection,
    resetMemberContactFields,
    updateMemberProfile,
    updateContactMemberProfile,
    getXGrpLinkMemReceived,
    setXGrpLinkMemReceived,
    createNewUnknownGroupMember,
    updateUnknownMemberAnnounced,
    updateUserMemberProfileSentAt,
    setGroupCustomData,
    setGroupUIThemes,
    updateGroupChatTags,
    getGroupChatTags,
    setGroupChatTTL,
    getGroupChatTTL,
    getUserGroupsToExpire,
    updateGroupAlias,
  )
where

import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class
import Crypto.Random (ChaChaDRG)
import Data.Bifunctor (second)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Char (toLower)
import Data.Either (rights)
import Data.Int (Int64)
import Data.List (partition, sortOn)
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
import Data.Ord (Down (..))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock (UTCTime (..), getCurrentTime)
import Data.Text.Encoding (encodeUtf8)
import Simplex.Chat.Messages
import Simplex.Chat.Protocol hiding (Binary)
import Simplex.Chat.Store.Direct
import Simplex.Chat.Store.Shared
import Simplex.Chat.Types
import Simplex.Chat.Types.MemberRelations (IntroductionDirection (..), MemberRelation (..), setNewRelations, setRelationConnected, toIntroDirInt, toRelationInt)
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Chat.Types.UITheme
import Simplex.Messaging.Agent.Protocol (ConnId, CreatedConnLink (..), UserId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, fromOnlyBI, maybeFirstRow)
import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.Ratchet (pattern PQEncOff, pattern PQSupportOff)
import Simplex.Messaging.Protocol (SubscriptionMode (..))
import Simplex.Messaging.Util (eitherToMaybe, firstRow', safeDecodeUtf8, ($>>=), (<$$>))
import Simplex.Messaging.Version
import UnliftIO.STM
#if defined(dbPostgres)
import qualified Data.Set as S
import Database.PostgreSQL.Simple (In (..), Only (..), Query, (:.) (..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
#else
import Database.SQLite.Simple (Only (..), Query, (:.) (..))
import Database.SQLite.Simple.QQ (sql)
#endif

type MaybeGroupMemberRow = (Maybe GroupMemberId, Maybe GroupId, Maybe Int64, Maybe MemberId, Maybe VersionChat, Maybe VersionChat, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId) :. (Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe LocalAlias, Maybe Preferences) :. (Maybe UTCTime, Maybe UTCTime) :. (Maybe UTCTime, Maybe Int64, Maybe Int64, Maybe Int64, Maybe UTCTime)

toMaybeGroupMember :: Int64 -> MaybeGroupMemberRow -> Maybe GroupMember
toMaybeGroupMember :: UserId -> MaybeGroupMemberRow -> Maybe GroupMember
toMaybeGroupMember UserId
userContactId ((Just UserId
groupMemberId, Just UserId
groupId, Just UserId
indexInGroup, Just MemberId
memberId, Just VersionChat
minVer, Just VersionChat
maxVer, Just GroupMemberRole
memberRole, Just GroupMemberCategory
memberCategory, Just GroupMemberStatus
memberStatus, Just BoolInt
showMessages, Maybe MemberRestrictionStatus
memberBlocked') :. (Maybe UserId
invitedById, Maybe UserId
invitedByGroupMemberId, Just LocalAlias
localDisplayName, Maybe UserId
memberContactId, Just UserId
memberContactProfileId) :. (Just UserId
profileId, Just LocalAlias
displayName, Just LocalAlias
fullName, Maybe LocalAlias
shortDescr, Maybe ImageData
image, Maybe ConnLinkContact
contactLink, Maybe ChatPeerType
peerType, Just LocalAlias
localAlias, Maybe Preferences
contactPreferences) :. (Just UTCTime
createdAt, Just UTCTime
updatedAt) :. (Maybe UTCTime
supportChatTs, Just UserId
supportChatUnread, Just UserId
supportChatUnanswered, Just UserId
supportChatMentions, Maybe UTCTime
supportChatLastMsgFromMemberTs)) =
  GroupMember -> Maybe GroupMember
forall a. a -> Maybe a
Just (GroupMember -> Maybe GroupMember)
-> GroupMember -> Maybe GroupMember
forall a b. (a -> b) -> a -> b
$ UserId -> GroupMemberRow -> GroupMember
toGroupMember UserId
userContactId ((UserId
groupMemberId, UserId
groupId, UserId
indexInGroup, MemberId
memberId, VersionChat
minVer, VersionChat
maxVer, GroupMemberRole
memberRole, GroupMemberCategory
memberCategory, GroupMemberStatus
memberStatus, BoolInt
showMessages, Maybe MemberRestrictionStatus
memberBlocked') (UserId, UserId, UserId, MemberId, VersionChat, VersionChat,
 GroupMemberRole, GroupMemberCategory, GroupMemberStatus, BoolInt,
 Maybe MemberRestrictionStatus)
-> ((Maybe UserId, Maybe UserId, LocalAlias, Maybe UserId, UserId)
    :. (ProfileRow
        :. ((UTCTime, UTCTime)
            :. (Maybe UTCTime, UserId, UserId, UserId, Maybe UTCTime))))
-> GroupMemberRow
forall h t. h -> t -> h :. t
:. (Maybe UserId
invitedById, Maybe UserId
invitedByGroupMemberId, LocalAlias
localDisplayName, Maybe UserId
memberContactId, UserId
memberContactProfileId) (Maybe UserId, Maybe UserId, LocalAlias, Maybe UserId, UserId)
-> (ProfileRow
    :. ((UTCTime, UTCTime)
        :. (Maybe UTCTime, UserId, UserId, UserId, Maybe UTCTime)))
-> (Maybe UserId, Maybe UserId, LocalAlias, Maybe UserId, UserId)
   :. (ProfileRow
       :. ((UTCTime, UTCTime)
           :. (Maybe UTCTime, UserId, UserId, UserId, Maybe UTCTime)))
forall h t. h -> t -> h :. t
:. (UserId
profileId, LocalAlias
displayName, LocalAlias
fullName, Maybe LocalAlias
shortDescr, Maybe ImageData
image, Maybe ConnLinkContact
contactLink, Maybe ChatPeerType
peerType, LocalAlias
localAlias, Maybe Preferences
contactPreferences) ProfileRow
-> ((UTCTime, UTCTime)
    :. (Maybe UTCTime, UserId, UserId, UserId, Maybe UTCTime))
-> ProfileRow
   :. ((UTCTime, UTCTime)
       :. (Maybe UTCTime, UserId, UserId, UserId, Maybe UTCTime))
forall h t. h -> t -> h :. t
:. (UTCTime
createdAt, UTCTime
updatedAt) (UTCTime, UTCTime)
-> (Maybe UTCTime, UserId, UserId, UserId, Maybe UTCTime)
-> (UTCTime, UTCTime)
   :. (Maybe UTCTime, UserId, UserId, UserId, Maybe UTCTime)
forall h t. h -> t -> h :. t
:. (Maybe UTCTime
supportChatTs, UserId
supportChatUnread, UserId
supportChatUnanswered, UserId
supportChatMentions, Maybe UTCTime
supportChatLastMsgFromMemberTs))
toMaybeGroupMember UserId
_ MaybeGroupMemberRow
_ = Maybe GroupMember
forall a. Maybe a
Nothing

createGroupLink :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> ConnId -> CreatedLinkContact -> GroupLinkId -> GroupMemberRole -> SubscriptionMode -> ExceptT StoreError IO GroupLink
createGroupLink :: Connection
-> TVar ChaChaDRG
-> User
-> GroupInfo
-> ConnId
-> CreatedLinkContact
-> GroupLinkId
-> GroupMemberRole
-> SubscriptionMode
-> ExceptT StoreError IO GroupLink
createGroupLink Connection
db TVar ChaChaDRG
gVar user :: User
user@User {UserId
userId :: UserId
userId :: User -> UserId
userId} groupInfo :: GroupInfo
groupInfo@GroupInfo {UserId
groupId :: UserId
groupId :: GroupInfo -> UserId
groupId, LocalAlias
localDisplayName :: LocalAlias
localDisplayName :: GroupInfo -> LocalAlias
localDisplayName} ConnId
agentConnId (CCLink ConnReqContact
cReq Maybe ShortLinkContact
shortLink) GroupLinkId
groupLinkId GroupMemberRole
memberRole SubscriptionMode
subMode = do
  StoreError -> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall a.
StoreError -> ExceptT StoreError IO a -> ExceptT StoreError IO a
checkConstraint (GroupInfo -> StoreError
SEDuplicateGroupLink GroupInfo
groupInfo) (ExceptT StoreError IO () -> ExceptT StoreError IO ())
-> (IO () -> ExceptT StoreError IO ())
-> IO ()
-> ExceptT StoreError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    ConnId
randSuffix <- IO ConnId -> IO ConnId
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ConnId -> IO ConnId) -> IO ConnId -> IO ConnId
forall a b. (a -> b) -> a -> b
$ TVar ChaChaDRG -> Int -> IO ConnId
encodedRandomBytes TVar ChaChaDRG
gVar Int
12
    let groupLinkLDN :: LocalAlias
groupLinkLDN = LocalAlias
"group_link_" LocalAlias -> LocalAlias -> LocalAlias
forall a. Semigroup a => a -> a -> a
<> LocalAlias
localDisplayName LocalAlias -> LocalAlias -> LocalAlias
forall a. Semigroup a => a -> a -> a
<> LocalAlias
"_" LocalAlias -> LocalAlias -> LocalAlias
forall a. Semigroup a => a -> a -> a
<> ConnId -> LocalAlias
safeDecodeUtf8 ConnId
randSuffix
        slDataSet :: BoolInt
slDataSet = Bool -> BoolInt
BI (Maybe ShortLinkContact -> Bool
forall a. Maybe a -> Bool
isJust Maybe ShortLinkContact
shortLink)
    Connection
-> Query
-> ((UserId, UserId, GroupLinkId, LocalAlias, ConnReqContact,
     Maybe ShortLinkContact, BoolInt, BoolInt)
    :. (GroupMemberRole, BoolInt, UTCTime, UTCTime))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      Query
"INSERT INTO user_contact_links (user_id, group_id, group_link_id, local_display_name, conn_req_contact, short_link_contact, short_link_data_set, short_link_large_data_set, group_link_member_role, auto_accept, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)"
      ((UserId
userId, UserId
groupId, GroupLinkId
groupLinkId, LocalAlias
groupLinkLDN, ConnReqContact
cReq, Maybe ShortLinkContact
shortLink, BoolInt
slDataSet, BoolInt
slDataSet) (UserId, UserId, GroupLinkId, LocalAlias, ConnReqContact,
 Maybe ShortLinkContact, BoolInt, BoolInt)
-> (GroupMemberRole, BoolInt, UTCTime, UTCTime)
-> (UserId, UserId, GroupLinkId, LocalAlias, ConnReqContact,
    Maybe ShortLinkContact, BoolInt, BoolInt)
   :. (GroupMemberRole, BoolInt, UTCTime, UTCTime)
forall h t. h -> t -> h :. t
:. (GroupMemberRole
memberRole, Bool -> BoolInt
BI Bool
True, UTCTime
currentTs, UTCTime
currentTs))
    UserId
userContactLinkId <- Connection -> IO UserId
insertedRowId Connection
db
    IO Connection -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Connection -> IO ()) -> IO Connection -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> UserId
-> ConnType
-> Maybe UserId
-> ConnId
-> ConnStatus
-> VersionChat
-> VersionRangeChat
-> Maybe UserId
-> Maybe UserId
-> Maybe UserId
-> Int
-> UTCTime
-> SubscriptionMode
-> PQSupport
-> IO Connection
createConnection_ Connection
db UserId
userId ConnType
ConnUserContact (UserId -> Maybe UserId
forall a. a -> Maybe a
Just UserId
userContactLinkId) ConnId
agentConnId ConnStatus
ConnNew VersionChat
initialChatVersion VersionRangeChat
chatInitialVRange Maybe UserId
forall a. Maybe a
Nothing Maybe UserId
forall a. Maybe a
Nothing Maybe UserId
forall a. Maybe a
Nothing Int
0 UTCTime
currentTs SubscriptionMode
subMode PQSupport
PQSupportOff
  Connection -> User -> GroupInfo -> ExceptT StoreError IO GroupLink
getGroupLink Connection
db User
user GroupInfo
groupInfo

getGroupLinkConnection :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> ExceptT StoreError IO Connection
getGroupLinkConnection :: Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> ExceptT StoreError IO Connection
getGroupLinkConnection Connection
db VersionRangeChat
vr User {UserId
userId :: User -> UserId
userId :: UserId
userId} groupInfo :: GroupInfo
groupInfo@GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} =
  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 [ConnectionRow] -> IO (Either StoreError Connection))
-> IO [ConnectionRow]
-> ExceptT StoreError IO Connection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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) (GroupInfo -> StoreError
SEGroupLinkNotFound GroupInfo
groupInfo) (IO [ConnectionRow] -> ExceptT StoreError IO Connection)
-> IO [ConnectionRow] -> ExceptT StoreError IO Connection
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query -> (UserId, UserId, UserId) -> 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 user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id
        WHERE c.user_id = ? AND uc.user_id = ? AND uc.group_id = ?
      |]
      (UserId
userId, UserId
userId, UserId
groupId)

deleteGroupLink :: DB.Connection -> User -> GroupInfo -> IO ()
deleteGroupLink :: Connection -> User -> GroupInfo -> IO ()
deleteGroupLink Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} = do
  Connection -> Query -> (UserId, UserId) -> 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 user_contact_links uc USING (user_contact_link_id)
        WHERE uc.user_id = ? AND uc.group_id = ?
      )
    |]
    (UserId
userId, UserId
groupId)
  Connection -> Query -> (UserId, UserId, UserId, UserId) -> 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 in (
          SELECT cr.local_display_name
          FROM contact_requests cr
          JOIN user_contact_links uc USING (user_contact_link_id)
          WHERE uc.user_id = ? AND uc.group_id = ?
        )
        AND local_display_name NOT IN (SELECT local_display_name FROM users WHERE user_id = ?)
    |]
    (UserId
userId, UserId
userId, UserId
groupId, UserId
userId)
  Connection -> Query -> (UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      DELETE FROM contact_profiles
      WHERE contact_profile_id in (
        SELECT cr.contact_profile_id
        FROM contact_requests cr
        JOIN user_contact_links uc USING (user_contact_link_id)
        WHERE uc.user_id = ? AND uc.group_id = ?
      )
    |]
    (UserId
userId, UserId
groupId)
  Connection -> Query -> (UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM user_contact_links WHERE user_id = ? AND group_id = ?" (UserId
userId, UserId
groupId)

getGroupLink :: DB.Connection -> User -> GroupInfo -> ExceptT StoreError IO GroupLink
getGroupLink :: Connection -> User -> GroupInfo -> ExceptT StoreError IO GroupLink
getGroupLink Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} gInfo :: GroupInfo
gInfo@GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} =
  IO (Either StoreError GroupLink) -> ExceptT StoreError IO GroupLink
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError GroupLink)
 -> ExceptT StoreError IO GroupLink)
-> (IO
      [(UserId, ConnReqContact, Maybe ShortLinkContact, BoolInt, BoolInt,
        GroupLinkId, Maybe GroupMemberRole)]
    -> IO (Either StoreError GroupLink))
-> IO
     [(UserId, ConnReqContact, Maybe ShortLinkContact, BoolInt, BoolInt,
       GroupLinkId, Maybe GroupMemberRole)]
-> ExceptT StoreError IO GroupLink
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UserId, ConnReqContact, Maybe ShortLinkContact, BoolInt, BoolInt,
  GroupLinkId, Maybe GroupMemberRole)
 -> GroupLink)
-> StoreError
-> IO
     [(UserId, ConnReqContact, Maybe ShortLinkContact, BoolInt, BoolInt,
       GroupLinkId, Maybe GroupMemberRole)]
-> IO (Either StoreError GroupLink)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (UserId, ConnReqContact, Maybe ShortLinkContact, BoolInt, BoolInt,
 GroupLinkId, Maybe GroupMemberRole)
-> GroupLink
toGroupLink (GroupInfo -> StoreError
SEGroupLinkNotFound GroupInfo
gInfo) (IO
   [(UserId, ConnReqContact, Maybe ShortLinkContact, BoolInt, BoolInt,
     GroupLinkId, Maybe GroupMemberRole)]
 -> ExceptT StoreError IO GroupLink)
-> IO
     [(UserId, ConnReqContact, Maybe ShortLinkContact, BoolInt, BoolInt,
       GroupLinkId, Maybe GroupMemberRole)]
-> ExceptT StoreError IO GroupLink
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (UserId, UserId)
-> IO
     [(UserId, ConnReqContact, Maybe ShortLinkContact, BoolInt, BoolInt,
       GroupLinkId, Maybe GroupMemberRole)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT user_contact_link_id, conn_req_contact, short_link_contact, short_link_data_set, short_link_large_data_set, group_link_id, group_link_member_role FROM user_contact_links WHERE user_id = ? AND group_id = ? LIMIT 1" (UserId
userId, UserId
groupId)
  where
    toGroupLink :: (UserId, ConnReqContact, Maybe ShortLinkContact, BoolInt, BoolInt,
 GroupLinkId, Maybe GroupMemberRole)
-> GroupLink
toGroupLink (UserId
userContactLinkId, ConnReqContact
cReq, Maybe ShortLinkContact
shortLink, BI Bool
shortLinkDataSet, BI Bool
slLargeDataSet, GroupLinkId
groupLinkId, Maybe GroupMemberRole
mRole_) =
      GroupLink {
        UserId
userContactLinkId :: UserId
userContactLinkId :: UserId
userContactLinkId,
        connLinkContact :: CreatedLinkContact
connLinkContact = ConnReqContact -> Maybe ShortLinkContact -> CreatedLinkContact
forall (m :: ConnectionMode).
ConnectionRequestUri m
-> Maybe (ConnShortLink m) -> CreatedConnLink m
CCLink ConnReqContact
cReq Maybe ShortLinkContact
shortLink,
        Bool
shortLinkDataSet :: Bool
shortLinkDataSet :: Bool
shortLinkDataSet,
        shortLinkLargeDataSet :: BoolDef
shortLinkLargeDataSet = Bool -> BoolDef
BoolDef Bool
slLargeDataSet,
        GroupLinkId
groupLinkId :: GroupLinkId
groupLinkId :: GroupLinkId
groupLinkId,
        acceptMemberRole :: GroupMemberRole
acceptMemberRole = GroupMemberRole -> Maybe GroupMemberRole -> GroupMemberRole
forall a. a -> Maybe a -> a
fromMaybe GroupMemberRole
GRMember Maybe GroupMemberRole
mRole_
      }

getGroupLinkId :: DB.Connection -> User -> GroupInfo -> IO (Maybe GroupLinkId)
getGroupLinkId :: Connection -> User -> GroupInfo -> IO (Maybe GroupLinkId)
getGroupLinkId Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} =
  (Maybe (Maybe GroupLinkId) -> Maybe GroupLinkId)
-> IO (Maybe (Maybe GroupLinkId)) -> IO (Maybe GroupLinkId)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe GroupLinkId) -> Maybe GroupLinkId
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (Maybe (Maybe GroupLinkId)) -> IO (Maybe GroupLinkId))
-> (IO [Only (Maybe GroupLinkId)]
    -> IO (Maybe (Maybe GroupLinkId)))
-> IO [Only (Maybe GroupLinkId)]
-> IO (Maybe GroupLinkId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only (Maybe GroupLinkId) -> Maybe GroupLinkId)
-> IO [Only (Maybe GroupLinkId)] -> IO (Maybe (Maybe GroupLinkId))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only (Maybe GroupLinkId) -> Maybe GroupLinkId
forall a. Only a -> a
fromOnly (IO [Only (Maybe GroupLinkId)] -> IO (Maybe GroupLinkId))
-> IO [Only (Maybe GroupLinkId)] -> IO (Maybe GroupLinkId)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query -> (UserId, UserId) -> IO [Only (Maybe GroupLinkId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT group_link_id FROM user_contact_links WHERE user_id = ? AND group_id = ? LIMIT 1" (UserId
userId, UserId
groupId)

setGroupLinkMemberRole :: DB.Connection -> User -> GroupLink -> GroupMemberRole -> IO GroupLink
setGroupLinkMemberRole :: Connection -> User -> GroupLink -> GroupMemberRole -> IO GroupLink
setGroupLinkMemberRole Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} gLnk :: GroupLink
gLnk@GroupLink{UserId
userContactLinkId :: GroupLink -> UserId
userContactLinkId :: UserId
userContactLinkId} GroupMemberRole
memberRole = do
  Connection -> Query -> (GroupMemberRole, UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE user_contact_links SET group_link_member_role = ? WHERE user_id = ? AND user_contact_link_id = ?" (GroupMemberRole
memberRole, UserId
userId, UserId
userContactLinkId)
  GroupLink -> IO GroupLink
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupLink
gLnk {acceptMemberRole = memberRole}

setGroupLinkShortLink :: DB.Connection -> GroupLink -> ShortLinkContact -> IO GroupLink
setGroupLinkShortLink :: Connection -> GroupLink -> ShortLinkContact -> IO GroupLink
setGroupLinkShortLink Connection
db gLnk :: GroupLink
gLnk@GroupLink {UserId
userContactLinkId :: GroupLink -> UserId
userContactLinkId :: UserId
userContactLinkId, connLinkContact :: GroupLink -> CreatedLinkContact
connLinkContact = CCLink ConnReqContact
connFullLink Maybe ShortLinkContact
_sLnk_} ShortLinkContact
shortLink = do
  Connection
-> Query -> (ShortLinkContact, BoolInt, BoolInt, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE user_contact_links
      SET short_link_contact = ?,
          short_link_data_set = ?,
          short_link_large_data_set = ?
      WHERE user_contact_link_id = ?
    |]
    (ShortLinkContact
shortLink, Bool -> BoolInt
BI Bool
True, Bool -> BoolInt
BI Bool
True, UserId
userContactLinkId)
  GroupLink -> IO GroupLink
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupLink
gLnk {connLinkContact = CCLink connFullLink (Just shortLink), shortLinkDataSet = True, shortLinkLargeDataSet = BoolDef True}

-- | creates completely new group with a single member - the current user
createNewGroup :: DB.Connection -> VersionRangeChat -> TVar ChaChaDRG -> User -> GroupProfile -> Maybe Profile -> ExceptT StoreError IO GroupInfo
createNewGroup :: Connection
-> VersionRangeChat
-> TVar ChaChaDRG
-> User
-> GroupProfile
-> Maybe Profile
-> ExceptT StoreError IO GroupInfo
createNewGroup Connection
db VersionRangeChat
vr TVar ChaChaDRG
gVar user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupProfile
groupProfile Maybe Profile
incognitoProfile = IO (Either StoreError GroupInfo) -> ExceptT StoreError IO GroupInfo
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError GroupInfo)
 -> ExceptT StoreError IO GroupInfo)
-> IO (Either StoreError GroupInfo)
-> ExceptT StoreError IO GroupInfo
forall a b. (a -> b) -> a -> b
$ do
  let GroupProfile {LocalAlias
displayName :: LocalAlias
displayName :: GroupProfile -> LocalAlias
displayName, LocalAlias
fullName :: LocalAlias
fullName :: GroupProfile -> LocalAlias
fullName, Maybe LocalAlias
shortDescr :: Maybe LocalAlias
shortDescr :: GroupProfile -> Maybe LocalAlias
shortDescr, Maybe LocalAlias
description :: Maybe LocalAlias
description :: GroupProfile -> Maybe LocalAlias
description, Maybe ImageData
image :: Maybe ImageData
image :: GroupProfile -> Maybe ImageData
image, Maybe GroupPreferences
groupPreferences :: Maybe GroupPreferences
groupPreferences :: GroupProfile -> Maybe GroupPreferences
groupPreferences, Maybe GroupMemberAdmission
memberAdmission :: Maybe GroupMemberAdmission
memberAdmission :: GroupProfile -> Maybe GroupMemberAdmission
memberAdmission} = GroupProfile
groupProfile
      fullGroupPreferences :: FullGroupPreferences
fullGroupPreferences = Maybe GroupPreferences -> FullGroupPreferences
mergeGroupPreferences Maybe GroupPreferences
groupPreferences
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Maybe UserId
customUserProfileId <- (Profile -> IO UserId) -> Maybe Profile -> IO (Maybe UserId)
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 -> UserId -> UTCTime -> Profile -> IO UserId
createIncognitoProfile_ Connection
db UserId
userId UTCTime
currentTs) Maybe Profile
incognitoProfile
  Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError GroupInfo))
-> IO (Either StoreError GroupInfo)
forall a.
Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError a))
-> IO (Either StoreError a)
withLocalDisplayName Connection
db UserId
userId LocalAlias
displayName ((LocalAlias -> IO (Either StoreError GroupInfo))
 -> IO (Either StoreError GroupInfo))
-> (LocalAlias -> IO (Either StoreError GroupInfo))
-> IO (Either StoreError GroupInfo)
forall a b. (a -> b) -> a -> b
$ \LocalAlias
ldn -> ExceptT StoreError IO GroupInfo -> IO (Either StoreError GroupInfo)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO GroupInfo
 -> IO (Either StoreError GroupInfo))
-> ExceptT StoreError IO GroupInfo
-> IO (Either StoreError GroupInfo)
forall a b. (a -> b) -> a -> b
$ do
    UserId
groupId <- IO UserId -> ExceptT StoreError IO UserId
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserId -> ExceptT StoreError IO UserId)
-> IO UserId -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$ do
      Connection
-> Query
-> (LocalAlias, LocalAlias, Maybe LocalAlias, Maybe LocalAlias,
    Maybe ImageData, UserId, Maybe GroupPreferences,
    Maybe GroupMemberAdmission, UTCTime, UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        Query
"INSERT INTO group_profiles (display_name, full_name, short_descr, description, image, user_id, preferences, member_admission, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?)"
        (LocalAlias
displayName, LocalAlias
fullName, Maybe LocalAlias
shortDescr, Maybe LocalAlias
description, Maybe ImageData
image, UserId
userId, Maybe GroupPreferences
groupPreferences, Maybe GroupMemberAdmission
memberAdmission, UTCTime
currentTs, UTCTime
currentTs)
      UserId
profileId <- Connection -> IO UserId
insertedRowId Connection
db
      Connection
-> Query
-> (LocalAlias, UserId, UserId, BoolInt, UTCTime, UTCTime, UTCTime,
    UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        [sql|
          INSERT INTO groups
            (local_display_name, user_id, group_profile_id, enable_ntfs,
             created_at, updated_at, chat_ts, user_member_profile_sent_at)
          VALUES (?,?,?,?,?,?,?,?)
        |]
        (LocalAlias
ldn, UserId
userId, UserId
profileId, Bool -> BoolInt
BI Bool
True, UTCTime
currentTs, UTCTime
currentTs, UTCTime
currentTs, UTCTime
currentTs)
      Connection -> IO UserId
insertedRowId Connection
db
    ConnId
memberId <- IO ConnId -> ExceptT StoreError IO ConnId
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ConnId -> ExceptT StoreError IO ConnId)
-> IO ConnId -> ExceptT StoreError IO ConnId
forall a b. (a -> b) -> a -> b
$ TVar ChaChaDRG -> Int -> IO ConnId
encodedRandomBytes TVar ChaChaDRG
gVar Int
12
    GroupMember
membership <- Connection
-> User
-> UserId
-> Maybe UserId
-> User
-> MemberIdRole
-> GroupMemberCategory
-> GroupMemberStatus
-> InvitedBy
-> Maybe UserId
-> UTCTime
-> VersionRangeChat
-> ExceptT StoreError IO GroupMember
forall a.
IsContact a =>
Connection
-> User
-> UserId
-> Maybe UserId
-> a
-> MemberIdRole
-> GroupMemberCategory
-> GroupMemberStatus
-> InvitedBy
-> Maybe UserId
-> UTCTime
-> VersionRangeChat
-> ExceptT StoreError IO GroupMember
createContactMemberInv_ Connection
db User
user UserId
groupId Maybe UserId
forall a. Maybe a
Nothing User
user (MemberId -> GroupMemberRole -> MemberIdRole
MemberIdRole (ConnId -> MemberId
MemberId ConnId
memberId) GroupMemberRole
GROwner) GroupMemberCategory
GCUserMember GroupMemberStatus
GSMemCreator InvitedBy
IBUser Maybe UserId
customUserProfileId UTCTime
currentTs VersionRangeChat
vr
    let chatSettings :: ChatSettings
chatSettings = ChatSettings {enableNtfs :: MsgFilter
enableNtfs = MsgFilter
MFAll, sendRcpts :: Maybe Bool
sendRcpts = Maybe Bool
forall a. Maybe a
Nothing, favorite :: Bool
favorite = Bool
False}
    GroupInfo -> ExceptT StoreError IO GroupInfo
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      GroupInfo
        { UserId
groupId :: UserId
groupId :: UserId
groupId,
          useRelays :: BoolDef
useRelays = Bool -> BoolDef
BoolDef Bool
False,
          localDisplayName :: LocalAlias
localDisplayName = LocalAlias
ldn,
          GroupProfile
groupProfile :: GroupProfile
groupProfile :: GroupProfile
groupProfile,
          localAlias :: LocalAlias
localAlias = LocalAlias
"",
          businessChat :: Maybe BusinessChatInfo
businessChat = Maybe BusinessChatInfo
forall a. Maybe a
Nothing,
          FullGroupPreferences
fullGroupPreferences :: FullGroupPreferences
fullGroupPreferences :: FullGroupPreferences
fullGroupPreferences,
          GroupMember
membership :: GroupMember
membership :: GroupMember
membership,
          ChatSettings
chatSettings :: ChatSettings
chatSettings :: ChatSettings
chatSettings,
          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,
          userMemberProfileSentAt :: Maybe UTCTime
userMemberProfileSentAt = UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
currentTs,
          preparedGroup :: Maybe PreparedGroup
preparedGroup = Maybe PreparedGroup
forall a. Maybe a
Nothing,
          chatTags :: [UserId]
chatTags = [],
          chatItemTTL :: Maybe UserId
chatItemTTL = Maybe UserId
forall a. Maybe a
Nothing,
          uiThemes :: Maybe UIThemeEntityOverrides
uiThemes = Maybe UIThemeEntityOverrides
forall a. Maybe a
Nothing,
          groupSummary :: GroupSummary
groupSummary = UserId -> GroupSummary
GroupSummary UserId
1,
          customData :: Maybe CustomData
customData = Maybe CustomData
forall a. Maybe a
Nothing,
          membersRequireAttention :: Int
membersRequireAttention = Int
0,
          viaGroupLinkUri :: Maybe ConnReqContact
viaGroupLinkUri = Maybe ConnReqContact
forall a. Maybe a
Nothing
        }

-- | creates a new group record for the group the current user was invited to, or returns an existing one
createGroupInvitation :: DB.Connection -> VersionRangeChat -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMemberId)
createGroupInvitation :: Connection
-> VersionRangeChat
-> User
-> Contact
-> GroupInvitation
-> Maybe UserId
-> ExceptT StoreError IO (GroupInfo, UserId)
createGroupInvitation Connection
_ VersionRangeChat
_ User
_ Contact {LocalAlias
localDisplayName :: LocalAlias
localDisplayName :: Contact -> LocalAlias
localDisplayName, activeConn :: Contact -> Maybe Connection
activeConn = Maybe Connection
Nothing} GroupInvitation
_ Maybe UserId
_ = StoreError -> ExceptT StoreError IO (GroupInfo, UserId)
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO (GroupInfo, UserId))
-> StoreError -> ExceptT StoreError IO (GroupInfo, UserId)
forall a b. (a -> b) -> a -> b
$ LocalAlias -> StoreError
SEContactNotReady LocalAlias
localDisplayName
createGroupInvitation Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} contact :: Contact
contact@Contact {UserId
contactId :: UserId
contactId :: Contact -> UserId
contactId, activeConn :: Contact -> Maybe Connection
activeConn = Just Connection {VersionRangeChat
peerChatVRange :: VersionRangeChat
peerChatVRange :: Connection -> VersionRangeChat
peerChatVRange}} GroupInvitation {MemberIdRole
fromMember :: MemberIdRole
fromMember :: GroupInvitation -> MemberIdRole
fromMember, MemberIdRole
invitedMember :: MemberIdRole
invitedMember :: GroupInvitation -> MemberIdRole
invitedMember, ConnReqInvitation
connRequest :: ConnReqInvitation
connRequest :: GroupInvitation -> ConnReqInvitation
connRequest, GroupProfile
groupProfile :: GroupProfile
groupProfile :: GroupInvitation -> GroupProfile
groupProfile, Maybe BusinessChatInfo
business :: Maybe BusinessChatInfo
business :: GroupInvitation -> Maybe BusinessChatInfo
business} Maybe UserId
incognitoProfileId = do
  IO (Maybe UserId) -> ExceptT StoreError IO (Maybe UserId)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Maybe UserId)
getInvitationGroupId_ ExceptT StoreError IO (Maybe UserId)
-> (Maybe UserId -> ExceptT StoreError IO (GroupInfo, UserId))
-> ExceptT StoreError IO (GroupInfo, UserId)
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
    Maybe UserId
Nothing -> ExceptT StoreError IO (GroupInfo, UserId)
createGroupInvitation_
    Just UserId
gId -> do
      gInfo :: GroupInfo
gInfo@GroupInfo {GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership, groupProfile :: GroupInfo -> GroupProfile
groupProfile = GroupProfile
p'} <- Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user UserId
gId
      UserId
hostId <- Connection -> User -> UserId -> ExceptT StoreError IO UserId
getHostMemberId_ Connection
db User
user UserId
gId
      let GroupMember {UserId
groupMemberId :: UserId
groupMemberId :: GroupMember -> UserId
groupMemberId, MemberId
memberId :: MemberId
memberId :: GroupMember -> MemberId
memberId, GroupMemberRole
memberRole :: GroupMemberRole
memberRole :: GroupMember -> GroupMemberRole
memberRole} = GroupMember
membership
          MemberIdRole {memberId :: MemberIdRole -> MemberId
memberId = MemberId
invMemberId, memberRole :: MemberIdRole -> GroupMemberRole
memberRole = GroupMemberRole
memberRole'} = MemberIdRole
invitedMember
      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 () -> IO ()) -> IO () -> ExceptT StoreError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MemberId
memberId MemberId -> MemberId -> Bool
forall a. Eq a => a -> a -> Bool
/= MemberId
invMemberId Bool -> Bool -> Bool
|| GroupMemberRole
memberRole GroupMemberRole -> GroupMemberRole -> Bool
forall a. Eq a => a -> a -> Bool
/= GroupMemberRole
memberRole') (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
        Connection -> Query -> (MemberId, GroupMemberRole, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE group_members SET member_id = ?, member_role = ? WHERE group_member_id = ?" (MemberId
invMemberId, GroupMemberRole
memberRole', UserId
groupMemberId)
      GroupInfo
gInfo' <-
        if GroupProfile
p' GroupProfile -> GroupProfile -> Bool
forall a. Eq a => a -> a -> Bool
== GroupProfile
groupProfile
          then GroupInfo -> ExceptT StoreError IO GroupInfo
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupInfo
gInfo
          else Connection
-> User
-> GroupInfo
-> GroupProfile
-> ExceptT StoreError IO GroupInfo
updateGroupProfile Connection
db User
user GroupInfo
gInfo GroupProfile
groupProfile
      (GroupInfo, UserId) -> ExceptT StoreError IO (GroupInfo, UserId)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupInfo
gInfo', UserId
hostId)
  where
    getInvitationGroupId_ :: IO (Maybe Int64)
    getInvitationGroupId_ :: IO (Maybe UserId)
getInvitationGroupId_ =
      (Only UserId -> UserId) -> IO [Only UserId] -> IO (Maybe UserId)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only UserId -> UserId
forall a. Only a -> a
fromOnly (IO [Only UserId] -> IO (Maybe UserId))
-> IO [Only UserId] -> IO (Maybe UserId)
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query -> (ConnReqInvitation, 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 groups WHERE inv_queue_info = ? AND user_id = ? LIMIT 1" (ConnReqInvitation
connRequest, UserId
userId)
    createGroupInvitation_ :: ExceptT StoreError IO (GroupInfo, GroupMemberId)
    createGroupInvitation_ :: ExceptT StoreError IO (GroupInfo, UserId)
createGroupInvitation_ = do
      let GroupProfile {LocalAlias
displayName :: GroupProfile -> LocalAlias
displayName :: LocalAlias
displayName, LocalAlias
fullName :: GroupProfile -> LocalAlias
fullName :: LocalAlias
fullName, Maybe LocalAlias
shortDescr :: GroupProfile -> Maybe LocalAlias
shortDescr :: Maybe LocalAlias
shortDescr, Maybe LocalAlias
description :: GroupProfile -> Maybe LocalAlias
description :: Maybe LocalAlias
description, Maybe ImageData
image :: GroupProfile -> Maybe ImageData
image :: Maybe ImageData
image, Maybe GroupPreferences
groupPreferences :: GroupProfile -> Maybe GroupPreferences
groupPreferences :: Maybe GroupPreferences
groupPreferences, Maybe GroupMemberAdmission
memberAdmission :: GroupProfile -> Maybe GroupMemberAdmission
memberAdmission :: Maybe GroupMemberAdmission
memberAdmission} = GroupProfile
groupProfile
          fullGroupPreferences :: FullGroupPreferences
fullGroupPreferences = Maybe GroupPreferences -> FullGroupPreferences
mergeGroupPreferences Maybe GroupPreferences
groupPreferences
      IO (Either StoreError (GroupInfo, UserId))
-> ExceptT StoreError IO (GroupInfo, UserId)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (GroupInfo, UserId))
 -> ExceptT StoreError IO (GroupInfo, UserId))
-> IO (Either StoreError (GroupInfo, UserId))
-> ExceptT StoreError IO (GroupInfo, UserId)
forall a b. (a -> b) -> a -> b
$
        Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError (GroupInfo, UserId)))
-> IO (Either StoreError (GroupInfo, UserId))
forall a.
Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError a))
-> IO (Either StoreError a)
withLocalDisplayName Connection
db UserId
userId LocalAlias
displayName ((LocalAlias -> IO (Either StoreError (GroupInfo, UserId)))
 -> IO (Either StoreError (GroupInfo, UserId)))
-> (LocalAlias -> IO (Either StoreError (GroupInfo, UserId)))
-> IO (Either StoreError (GroupInfo, UserId))
forall a b. (a -> b) -> a -> b
$ \LocalAlias
localDisplayName -> ExceptT StoreError IO (GroupInfo, UserId)
-> IO (Either StoreError (GroupInfo, UserId))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO (GroupInfo, UserId)
 -> IO (Either StoreError (GroupInfo, UserId)))
-> ExceptT StoreError IO (GroupInfo, UserId)
-> IO (Either StoreError (GroupInfo, UserId))
forall a b. (a -> b) -> a -> b
$ 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
          UserId
groupId <- IO UserId -> ExceptT StoreError IO UserId
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserId -> ExceptT StoreError IO UserId)
-> IO UserId -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$ do
            Connection
-> Query
-> (LocalAlias, LocalAlias, Maybe LocalAlias, Maybe LocalAlias,
    Maybe ImageData, UserId, Maybe GroupPreferences,
    Maybe GroupMemberAdmission, UTCTime, UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
              Connection
db
              Query
"INSERT INTO group_profiles (display_name, full_name, short_descr, description, image, user_id, preferences, member_admission, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?)"
              (LocalAlias
displayName, LocalAlias
fullName, Maybe LocalAlias
shortDescr, Maybe LocalAlias
description, Maybe ImageData
image, UserId
userId, Maybe GroupPreferences
groupPreferences, Maybe GroupMemberAdmission
memberAdmission, UTCTime
currentTs, UTCTime
currentTs)
            UserId
profileId <- Connection -> IO UserId
insertedRowId Connection
db
            Connection
-> Query
-> ((UserId, LocalAlias, ConnReqInvitation, UserId, BoolInt,
     UTCTime, UTCTime, UTCTime, UTCTime)
    :. BusinessChatInfoRow)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
              Connection
db
              [sql|
                INSERT INTO groups
                  (group_profile_id, local_display_name, inv_queue_info, user_id, enable_ntfs,
                   created_at, updated_at, chat_ts, user_member_profile_sent_at, business_chat, business_member_id, customer_member_id)
                VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
              |]
              ((UserId
profileId, LocalAlias
localDisplayName, ConnReqInvitation
connRequest, UserId
userId, Bool -> BoolInt
BI Bool
True, UTCTime
currentTs, UTCTime
currentTs, UTCTime
currentTs, UTCTime
currentTs) (UserId, LocalAlias, ConnReqInvitation, UserId, BoolInt, UTCTime,
 UTCTime, UTCTime, UTCTime)
-> BusinessChatInfoRow
-> (UserId, LocalAlias, ConnReqInvitation, UserId, BoolInt,
    UTCTime, UTCTime, UTCTime, UTCTime)
   :. BusinessChatInfoRow
forall h t. h -> t -> h :. t
:. Maybe BusinessChatInfo -> BusinessChatInfoRow
businessChatInfoRow Maybe BusinessChatInfo
business)
            Connection -> IO UserId
insertedRowId Connection
db
          let hostVRange :: VersionRangeChat
hostVRange = VersionRangeChat -> VersionRangeChat -> VersionRangeChat
adjustedMemberVRange VersionRangeChat
vr VersionRangeChat
peerChatVRange
          GroupMember {UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId} <- Connection
-> User
-> UserId
-> Maybe UserId
-> Contact
-> MemberIdRole
-> GroupMemberCategory
-> GroupMemberStatus
-> InvitedBy
-> Maybe UserId
-> UTCTime
-> VersionRangeChat
-> ExceptT StoreError IO GroupMember
forall a.
IsContact a =>
Connection
-> User
-> UserId
-> Maybe UserId
-> a
-> MemberIdRole
-> GroupMemberCategory
-> GroupMemberStatus
-> InvitedBy
-> Maybe UserId
-> UTCTime
-> VersionRangeChat
-> ExceptT StoreError IO GroupMember
createContactMemberInv_ Connection
db User
user UserId
groupId Maybe UserId
forall a. Maybe a
Nothing Contact
contact MemberIdRole
fromMember GroupMemberCategory
GCHostMember GroupMemberStatus
GSMemInvited InvitedBy
IBUnknown Maybe UserId
forall a. Maybe a
Nothing UTCTime
currentTs VersionRangeChat
hostVRange
          GroupMember
membership <- Connection
-> User
-> UserId
-> Maybe UserId
-> User
-> MemberIdRole
-> GroupMemberCategory
-> GroupMemberStatus
-> InvitedBy
-> Maybe UserId
-> UTCTime
-> VersionRangeChat
-> ExceptT StoreError IO GroupMember
forall a.
IsContact a =>
Connection
-> User
-> UserId
-> Maybe UserId
-> a
-> MemberIdRole
-> GroupMemberCategory
-> GroupMemberStatus
-> InvitedBy
-> Maybe UserId
-> UTCTime
-> VersionRangeChat
-> ExceptT StoreError IO GroupMember
createContactMemberInv_ Connection
db User
user UserId
groupId (UserId -> Maybe UserId
forall a. a -> Maybe a
Just UserId
groupMemberId) User
user MemberIdRole
invitedMember GroupMemberCategory
GCUserMember GroupMemberStatus
GSMemInvited (UserId -> InvitedBy
IBContact UserId
contactId) Maybe UserId
incognitoProfileId UTCTime
currentTs VersionRangeChat
vr
          let chatSettings :: ChatSettings
chatSettings = ChatSettings {enableNtfs :: MsgFilter
enableNtfs = MsgFilter
MFAll, sendRcpts :: Maybe Bool
sendRcpts = Maybe Bool
forall a. Maybe a
Nothing, favorite :: Bool
favorite = Bool
False}
          (GroupInfo, UserId) -> ExceptT StoreError IO (GroupInfo, UserId)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ( GroupInfo
                { UserId
groupId :: UserId
groupId :: UserId
groupId,
                  useRelays :: BoolDef
useRelays = Bool -> BoolDef
BoolDef Bool
False,
                  LocalAlias
localDisplayName :: LocalAlias
localDisplayName :: LocalAlias
localDisplayName,
                  GroupProfile
groupProfile :: GroupProfile
groupProfile :: GroupProfile
groupProfile,
                  localAlias :: LocalAlias
localAlias = LocalAlias
"",
                  businessChat :: Maybe BusinessChatInfo
businessChat = Maybe BusinessChatInfo
forall a. Maybe a
Nothing,
                  FullGroupPreferences
fullGroupPreferences :: FullGroupPreferences
fullGroupPreferences :: FullGroupPreferences
fullGroupPreferences,
                  GroupMember
membership :: GroupMember
membership :: GroupMember
membership,
                  ChatSettings
chatSettings :: ChatSettings
chatSettings :: ChatSettings
chatSettings,
                  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,
                  userMemberProfileSentAt :: Maybe UTCTime
userMemberProfileSentAt = UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
currentTs,
                  preparedGroup :: Maybe PreparedGroup
preparedGroup = Maybe PreparedGroup
forall a. Maybe a
Nothing,
                  chatTags :: [UserId]
chatTags = [],
                  chatItemTTL :: Maybe UserId
chatItemTTL = Maybe UserId
forall a. Maybe a
Nothing,
                  uiThemes :: Maybe UIThemeEntityOverrides
uiThemes = Maybe UIThemeEntityOverrides
forall a. Maybe a
Nothing,
                  groupSummary :: GroupSummary
groupSummary = UserId -> GroupSummary
GroupSummary UserId
2,
                  customData :: Maybe CustomData
customData = Maybe CustomData
forall a. Maybe a
Nothing,
                  membersRequireAttention :: Int
membersRequireAttention = Int
0,
                  viaGroupLinkUri :: Maybe ConnReqContact
viaGroupLinkUri = Maybe ConnReqContact
forall a. Maybe a
Nothing
                },
              UserId
groupMemberId
            )

businessChatInfoRow :: Maybe BusinessChatInfo -> BusinessChatInfoRow
businessChatInfoRow :: Maybe BusinessChatInfo -> BusinessChatInfoRow
businessChatInfoRow = \case
  Just BusinessChatInfo {BusinessChatType
chatType :: BusinessChatType
chatType :: BusinessChatInfo -> BusinessChatType
chatType, MemberId
businessId :: MemberId
businessId :: BusinessChatInfo -> MemberId
businessId, MemberId
customerId :: MemberId
customerId :: BusinessChatInfo -> MemberId
customerId} -> (BusinessChatType -> Maybe BusinessChatType
forall a. a -> Maybe a
Just BusinessChatType
chatType, MemberId -> Maybe MemberId
forall a. a -> Maybe a
Just MemberId
businessId, MemberId -> Maybe MemberId
forall a. a -> Maybe a
Just MemberId
customerId)
  Maybe BusinessChatInfo
Nothing -> (Maybe BusinessChatType
forall a. Maybe a
Nothing, Maybe MemberId
forall a. Maybe a
Nothing, Maybe MemberId
forall a. Maybe a
Nothing)

adjustedMemberVRange :: VersionRangeChat -> VersionRangeChat -> VersionRangeChat
adjustedMemberVRange :: VersionRangeChat -> VersionRangeChat -> VersionRangeChat
adjustedMemberVRange VersionRangeChat
chatVR vr :: VersionRangeChat
vr@(VersionRange VersionChat
minV VersionChat
maxV) =
  let maxV' :: VersionChat
maxV' = VersionChat -> VersionChat -> VersionChat
forall a. Ord a => a -> a -> a
min VersionChat
maxV (VersionRangeChat -> VersionChat
forall v. VersionRange v -> Version v
maxVersion VersionRangeChat
chatVR)
   in VersionRangeChat -> Maybe VersionRangeChat -> VersionRangeChat
forall a. a -> Maybe a -> a
fromMaybe VersionRangeChat
vr (Maybe VersionRangeChat -> VersionRangeChat)
-> Maybe VersionRangeChat -> VersionRangeChat
forall a b. (a -> b) -> a -> b
$ VersionChat -> VersionChat -> Maybe VersionRangeChat
forall v. Version v -> Version v -> Maybe (VersionRange v)
safeVersionRange VersionChat
minV (VersionChat -> VersionChat -> VersionChat
forall a. Ord a => a -> a -> a
max VersionChat
minV VersionChat
maxV')

getHostMemberId_ :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO GroupMemberId
getHostMemberId_ :: Connection -> User -> UserId -> ExceptT StoreError IO UserId
getHostMemberId_ Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} UserId
groupId =
  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 (UserId -> StoreError
SEHostMemberIdNotFound UserId
groupId) (IO [Only UserId] -> ExceptT StoreError IO UserId)
-> IO [Only UserId] -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (UserId, UserId, GroupMemberCategory)
-> IO [Only UserId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT group_member_id FROM group_members WHERE user_id = ? AND group_id = ? AND member_category = ?" (UserId
userId, UserId
groupId, GroupMemberCategory
GCHostMember)

getUpdateNextIndexInGroup_ :: DB.Connection -> GroupId -> ExceptT StoreError IO Int64
getUpdateNextIndexInGroup_ :: Connection -> UserId -> ExceptT StoreError IO UserId
getUpdateNextIndexInGroup_ Connection
db UserId
groupId =
  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 (UserId -> StoreError
SEGroupNotFound UserId
groupId) (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
      [sql|
        UPDATE groups
        SET member_index = member_index + 1
        WHERE group_id = ?
        RETURNING member_index - 1
      |]
      (UserId -> Only UserId
forall a. a -> Only a
Only UserId
groupId)

createContactMemberInv_ :: IsContact a => DB.Connection -> User -> GroupId -> Maybe GroupMemberId -> a -> MemberIdRole -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> Maybe ProfileId -> UTCTime -> VersionRangeChat -> ExceptT StoreError IO GroupMember
createContactMemberInv_ :: forall a.
IsContact a =>
Connection
-> User
-> UserId
-> Maybe UserId
-> a
-> MemberIdRole
-> GroupMemberCategory
-> GroupMemberStatus
-> InvitedBy
-> Maybe UserId
-> UTCTime
-> VersionRangeChat
-> ExceptT StoreError IO GroupMember
createContactMemberInv_ Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId, UserId
userContactId :: UserId
userContactId :: User -> UserId
userContactId} UserId
groupId Maybe UserId
invitedByGroupMemberId a
userOrContact MemberIdRole {MemberId
memberId :: MemberIdRole -> MemberId
memberId :: MemberId
memberId, GroupMemberRole
memberRole :: MemberIdRole -> GroupMemberRole
memberRole :: GroupMemberRole
memberRole} GroupMemberCategory
memberCategory GroupMemberStatus
memberStatus InvitedBy
invitedBy Maybe UserId
incognitoProfileId UTCTime
createdAt VersionRangeChat
vr = do
  Maybe LocalProfile
incognitoProfile <- Maybe UserId
-> (UserId -> ExceptT StoreError IO LocalProfile)
-> ExceptT StoreError IO (Maybe LocalProfile)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe UserId
incognitoProfileId ((UserId -> ExceptT StoreError IO LocalProfile)
 -> ExceptT StoreError IO (Maybe LocalProfile))
-> (UserId -> ExceptT StoreError IO LocalProfile)
-> ExceptT StoreError IO (Maybe LocalProfile)
forall a b. (a -> b) -> a -> b
$ \UserId
profileId -> Connection
-> UserId -> UserId -> ExceptT StoreError IO LocalProfile
getProfileById Connection
db UserId
userId UserId
profileId
  (UserId
indexInGroup, LocalAlias
localDisplayName, LocalProfile
memberProfile) <- case (Maybe LocalProfile
incognitoProfile, Maybe UserId
incognitoProfileId) of
    (Just profile :: LocalProfile
profile@LocalProfile {LocalAlias
displayName :: LocalAlias
displayName :: LocalProfile -> LocalAlias
displayName}, Just UserId
profileId) -> do
      (UserId
indexInGroup, LocalAlias
localDisplayName) <- LocalAlias -> UserId -> ExceptT StoreError IO (UserId, LocalAlias)
insertMemberIncognitoProfile_ LocalAlias
displayName UserId
profileId
      (UserId, LocalAlias, LocalProfile)
-> ExceptT StoreError IO (UserId, LocalAlias, LocalProfile)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserId
indexInGroup, LocalAlias
localDisplayName, LocalProfile
profile)
    (Maybe LocalProfile, Maybe UserId)
_ -> do
      (UserId
indexInGroup, LocalAlias
localDisplayName) <- ExceptT StoreError IO (UserId, LocalAlias)
insertMember_
      (UserId, LocalAlias, LocalProfile)
-> ExceptT StoreError IO (UserId, LocalAlias, LocalProfile)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserId
indexInGroup, LocalAlias
localDisplayName, a -> LocalProfile
forall a. IsContact a => a -> LocalProfile
profile' a
userOrContact)
  UserId
groupMemberId <- IO UserId -> ExceptT StoreError IO UserId
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserId -> ExceptT StoreError IO UserId)
-> IO UserId -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$ Connection -> IO UserId
insertedRowId Connection
db
  GroupMember -> ExceptT StoreError IO GroupMember
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    GroupMember
      { UserId
groupMemberId :: UserId
groupMemberId :: UserId
groupMemberId,
        UserId
groupId :: UserId
groupId :: UserId
groupId,
        UserId
indexInGroup :: UserId
indexInGroup :: UserId
indexInGroup,
        MemberId
memberId :: MemberId
memberId :: MemberId
memberId,
        GroupMemberRole
memberRole :: GroupMemberRole
memberRole :: GroupMemberRole
memberRole,
        GroupMemberCategory
memberCategory :: GroupMemberCategory
memberCategory :: GroupMemberCategory
memberCategory,
        GroupMemberStatus
memberStatus :: GroupMemberStatus
memberStatus :: GroupMemberStatus
memberStatus,
        memberSettings :: GroupMemberSettings
memberSettings = GroupMemberSettings
defaultMemberSettings,
        blockedByAdmin :: Bool
blockedByAdmin = Bool
False,
        InvitedBy
invitedBy :: InvitedBy
invitedBy :: InvitedBy
invitedBy,
        Maybe UserId
invitedByGroupMemberId :: Maybe UserId
invitedByGroupMemberId :: Maybe UserId
invitedByGroupMemberId,
        LocalAlias
localDisplayName :: LocalAlias
localDisplayName :: LocalAlias
localDisplayName,
        LocalProfile
memberProfile :: LocalProfile
memberProfile :: LocalProfile
memberProfile,
        memberContactId :: Maybe UserId
memberContactId = UserId -> Maybe UserId
forall a. a -> Maybe a
Just (UserId -> Maybe UserId) -> UserId -> Maybe UserId
forall a b. (a -> b) -> a -> b
$ a -> UserId
forall a. IsContact a => a -> UserId
contactId' a
userOrContact,
        memberContactProfileId :: UserId
memberContactProfileId = LocalProfile -> UserId
localProfileId (a -> LocalProfile
forall a. IsContact a => a -> LocalProfile
profile' a
userOrContact),
        activeConn :: Maybe Connection
activeConn = Maybe Connection
forall a. Maybe a
Nothing,
        VersionRangeChat
memberChatVRange :: VersionRangeChat
memberChatVRange :: VersionRangeChat
memberChatVRange,
        UTCTime
createdAt :: UTCTime
createdAt :: UTCTime
createdAt,
        updatedAt :: UTCTime
updatedAt = UTCTime
createdAt,
        supportChat :: Maybe GroupSupportChat
supportChat = Maybe GroupSupportChat
forall a. Maybe a
Nothing
      }
  where
    memberChatVRange :: VersionRangeChat
memberChatVRange@(VersionRange VersionChat
minV VersionChat
maxV) = VersionRangeChat
vr
    insertMember_ :: ExceptT StoreError IO (Int64, ContactName)
    insertMember_ :: ExceptT StoreError IO (UserId, LocalAlias)
insertMember_ = do
      let localDisplayName :: LocalAlias
localDisplayName = a -> LocalAlias
forall a. IsContact a => a -> LocalAlias
localDisplayName' a
userOrContact
      UserId
indexInGroup <- Connection -> UserId -> ExceptT StoreError IO UserId
getUpdateNextIndexInGroup_ Connection
db UserId
groupId
      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
-> ((UserId, UserId, MemberId, GroupMemberRole,
     GroupMemberCategory, GroupMemberStatus, Binary ConnId,
     Maybe UserId, Maybe UserId)
    :. ((UserId, LocalAlias, UserId, UserId, UTCTime, UTCTime)
        :. (VersionChat, VersionChat)))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
          Connection
db
          [sql|
            INSERT INTO group_members
              ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by, invited_by_group_member_id,
                user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
                peer_chat_min_version, peer_chat_max_version)
            VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
          |]
          ( (UserId
groupId, UserId
indexInGroup, MemberId
memberId, GroupMemberRole
memberRole, GroupMemberCategory
memberCategory, GroupMemberStatus
memberStatus, ConnId -> Binary ConnId
forall a. a -> Binary a
Binary ConnId
B.empty, UserId -> InvitedBy -> Maybe UserId
fromInvitedBy UserId
userContactId InvitedBy
invitedBy, Maybe UserId
invitedByGroupMemberId)
              (UserId, UserId, MemberId, GroupMemberRole, GroupMemberCategory,
 GroupMemberStatus, Binary ConnId, Maybe UserId, Maybe UserId)
-> ((UserId, LocalAlias, UserId, UserId, UTCTime, UTCTime)
    :. (VersionChat, VersionChat))
-> (UserId, UserId, MemberId, GroupMemberRole, GroupMemberCategory,
    GroupMemberStatus, Binary ConnId, Maybe UserId, Maybe UserId)
   :. ((UserId, LocalAlias, UserId, UserId, UTCTime, UTCTime)
       :. (VersionChat, VersionChat))
forall h t. h -> t -> h :. t
:. (UserId
userId, a -> LocalAlias
forall a. IsContact a => a -> LocalAlias
localDisplayName' a
userOrContact, a -> UserId
forall a. IsContact a => a -> UserId
contactId' a
userOrContact, LocalProfile -> UserId
localProfileId (LocalProfile -> UserId) -> LocalProfile -> UserId
forall a b. (a -> b) -> a -> b
$ a -> LocalProfile
forall a. IsContact a => a -> LocalProfile
profile' a
userOrContact, UTCTime
createdAt, UTCTime
createdAt)
              (UserId, LocalAlias, UserId, UserId, UTCTime, UTCTime)
-> (VersionChat, VersionChat)
-> (UserId, LocalAlias, UserId, UserId, UTCTime, UTCTime)
   :. (VersionChat, VersionChat)
forall h t. h -> t -> h :. t
:. (VersionChat
minV, VersionChat
maxV)
          )
      (UserId, LocalAlias) -> ExceptT StoreError IO (UserId, LocalAlias)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserId
indexInGroup, LocalAlias
localDisplayName)
    insertMemberIncognitoProfile_ :: ContactName -> ProfileId -> ExceptT StoreError IO (Int64, ContactName)
    insertMemberIncognitoProfile_ :: LocalAlias -> UserId -> ExceptT StoreError IO (UserId, LocalAlias)
insertMemberIncognitoProfile_ LocalAlias
incognitoDisplayName UserId
customUserProfileId =
      IO (Either StoreError (UserId, LocalAlias))
-> ExceptT StoreError IO (UserId, LocalAlias)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (UserId, LocalAlias))
 -> ExceptT StoreError IO (UserId, LocalAlias))
-> ((LocalAlias -> IO (Either StoreError (UserId, LocalAlias)))
    -> IO (Either StoreError (UserId, LocalAlias)))
-> (LocalAlias -> IO (Either StoreError (UserId, LocalAlias)))
-> ExceptT StoreError IO (UserId, LocalAlias)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError (UserId, LocalAlias)))
-> IO (Either StoreError (UserId, LocalAlias))
forall a.
Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError a))
-> IO (Either StoreError a)
withLocalDisplayName Connection
db UserId
userId LocalAlias
incognitoDisplayName ((LocalAlias -> IO (Either StoreError (UserId, LocalAlias)))
 -> ExceptT StoreError IO (UserId, LocalAlias))
-> (LocalAlias -> IO (Either StoreError (UserId, LocalAlias)))
-> ExceptT StoreError IO (UserId, LocalAlias)
forall a b. (a -> b) -> a -> b
$ \LocalAlias
incognitoLdn -> ExceptT StoreError IO (UserId, LocalAlias)
-> IO (Either StoreError (UserId, LocalAlias))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO (UserId, LocalAlias)
 -> IO (Either StoreError (UserId, LocalAlias)))
-> ExceptT StoreError IO (UserId, LocalAlias)
-> IO (Either StoreError (UserId, LocalAlias))
forall a b. (a -> b) -> a -> b
$ do
        UserId
indexInGroup <- Connection -> UserId -> ExceptT StoreError IO UserId
getUpdateNextIndexInGroup_ Connection
db UserId
groupId
        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
-> ((UserId, UserId, MemberId, GroupMemberRole,
     GroupMemberCategory, GroupMemberStatus, Binary ConnId,
     Maybe UserId, Maybe UserId)
    :. ((UserId, LocalAlias, UserId, UserId, UserId, UTCTime, UTCTime)
        :. (VersionChat, VersionChat)))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
            Connection
db
            [sql|
              INSERT INTO group_members
                ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by, invited_by_group_member_id,
                  user_id, local_display_name, contact_id, contact_profile_id, member_profile_id, created_at, updated_at,
                  peer_chat_min_version, peer_chat_max_version)
              VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
            |]
            ( (UserId
groupId, UserId
indexInGroup, MemberId
memberId, GroupMemberRole
memberRole, GroupMemberCategory
memberCategory, GroupMemberStatus
memberStatus, ConnId -> Binary ConnId
forall a. a -> Binary a
Binary ConnId
B.empty, UserId -> InvitedBy -> Maybe UserId
fromInvitedBy UserId
userContactId InvitedBy
invitedBy, Maybe UserId
invitedByGroupMemberId)
                (UserId, UserId, MemberId, GroupMemberRole, GroupMemberCategory,
 GroupMemberStatus, Binary ConnId, Maybe UserId, Maybe UserId)
-> ((UserId, LocalAlias, UserId, UserId, UserId, UTCTime, UTCTime)
    :. (VersionChat, VersionChat))
-> (UserId, UserId, MemberId, GroupMemberRole, GroupMemberCategory,
    GroupMemberStatus, Binary ConnId, Maybe UserId, Maybe UserId)
   :. ((UserId, LocalAlias, UserId, UserId, UserId, UTCTime, UTCTime)
       :. (VersionChat, VersionChat))
forall h t. h -> t -> h :. t
:. (UserId
userId, LocalAlias
incognitoLdn, a -> UserId
forall a. IsContact a => a -> UserId
contactId' a
userOrContact, LocalProfile -> UserId
localProfileId (LocalProfile -> UserId) -> LocalProfile -> UserId
forall a b. (a -> b) -> a -> b
$ a -> LocalProfile
forall a. IsContact a => a -> LocalProfile
profile' a
userOrContact, UserId
customUserProfileId, UTCTime
createdAt, UTCTime
createdAt)
                (UserId, LocalAlias, UserId, UserId, UserId, UTCTime, UTCTime)
-> (VersionChat, VersionChat)
-> (UserId, LocalAlias, UserId, UserId, UserId, UTCTime, UTCTime)
   :. (VersionChat, VersionChat)
forall h t. h -> t -> h :. t
:. (VersionChat
minV, VersionChat
maxV)
            )
        (UserId, LocalAlias) -> ExceptT StoreError IO (UserId, LocalAlias)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserId
indexInGroup, LocalAlias
incognitoLdn)

deleteContactCardKeepConn :: DB.Connection -> Int64 -> Contact -> IO ()
deleteContactCardKeepConn :: Connection -> UserId -> Contact -> IO ()
deleteContactCardKeepConn Connection
db UserId
connId Contact {UserId
contactId :: Contact -> UserId
contactId :: UserId
contactId, profile :: Contact -> LocalProfile
profile = LocalProfile {UserId
profileId :: UserId
profileId :: LocalProfile -> UserId
profileId}} = do
  Connection -> Query -> Only UserId -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE connections SET contact_id = NULL WHERE connection_id = ?" (UserId -> Only UserId
forall a. a -> Only a
Only UserId
connId)
  Connection -> Query -> Only UserId -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM contacts WHERE contact_id = ?" (UserId -> Only UserId
forall a. a -> Only a
Only UserId
contactId)
  Connection -> Query -> Only UserId -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM contact_profiles WHERE contact_profile_id = ?" (UserId -> Only UserId
forall a. a -> Only a
Only UserId
profileId)

createPreparedGroup :: DB.Connection -> VersionRangeChat -> User -> GroupProfile -> Bool -> CreatedLinkContact -> Maybe SharedMsgId -> ExceptT StoreError IO (GroupInfo, GroupMember)
createPreparedGroup :: Connection
-> VersionRangeChat
-> User
-> GroupProfile
-> Bool
-> CreatedLinkContact
-> Maybe SharedMsgId
-> ExceptT StoreError IO (GroupInfo, GroupMember)
createPreparedGroup Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId, UserId
userContactId :: User -> UserId
userContactId :: UserId
userContactId} GroupProfile
groupProfile Bool
business CreatedLinkContact
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 (CreatedLinkContact, Maybe SharedMsgId)
prepared = (CreatedLinkContact, Maybe SharedMsgId)
-> Maybe (CreatedLinkContact, Maybe SharedMsgId)
forall a. a -> Maybe a
Just (CreatedLinkContact
connLinkToConnect, Maybe SharedMsgId
welcomeSharedMsgId)
  (UserId
groupId, LocalAlias
groupLDN) <- Connection
-> UserId
-> GroupProfile
-> Maybe (CreatedLinkContact, Maybe SharedMsgId)
-> Maybe BusinessChatInfo
-> UTCTime
-> ExceptT StoreError IO (UserId, LocalAlias)
createGroup_ Connection
db UserId
userId GroupProfile
groupProfile Maybe (CreatedLinkContact, Maybe SharedMsgId)
prepared Maybe BusinessChatInfo
forall a. Maybe a
Nothing UTCTime
currentTs
  UserId
hostMemberId <- UTCTime -> UserId -> LocalAlias -> ExceptT StoreError IO UserId
insertHost_ UTCTime
currentTs UserId
groupId LocalAlias
groupLDN
  let userMember :: MemberIdRole
userMember = MemberId -> GroupMemberRole -> MemberIdRole
MemberIdRole (ConnId -> MemberId
MemberId (ConnId -> MemberId) -> ConnId -> MemberId
forall a b. (a -> b) -> a -> b
$ LocalAlias -> ConnId
encodeUtf8 LocalAlias
groupLDN ConnId -> ConnId -> ConnId
forall a. Semigroup a => a -> a -> a
<> ConnId
"_user_unknown_id") GroupMemberRole
GRMember
  GroupMember
membership <- Connection
-> User
-> UserId
-> Maybe UserId
-> User
-> MemberIdRole
-> GroupMemberCategory
-> GroupMemberStatus
-> InvitedBy
-> Maybe UserId
-> UTCTime
-> VersionRangeChat
-> ExceptT StoreError IO GroupMember
forall a.
IsContact a =>
Connection
-> User
-> UserId
-> Maybe UserId
-> a
-> MemberIdRole
-> GroupMemberCategory
-> GroupMemberStatus
-> InvitedBy
-> Maybe UserId
-> UTCTime
-> VersionRangeChat
-> ExceptT StoreError IO GroupMember
createContactMemberInv_ Connection
db User
user UserId
groupId (UserId -> Maybe UserId
forall a. a -> Maybe a
Just UserId
hostMemberId) User
user MemberIdRole
userMember GroupMemberCategory
GCUserMember GroupMemberStatus
GSMemUnknown InvitedBy
IBUnknown Maybe UserId
forall a. Maybe a
Nothing UTCTime
currentTs VersionRangeChat
vr
  GroupMember
hostMember <- Connection
-> VersionRangeChat
-> User
-> UserId
-> UserId
-> ExceptT StoreError IO GroupMember
getGroupMember Connection
db VersionRangeChat
vr User
user UserId
groupId UserId
hostMemberId
  Bool -> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
business (ExceptT StoreError IO () -> ExceptT StoreError IO ())
-> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ 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
$ UserId -> GroupMember -> GroupMember -> IO ()
setGroupBusinessChatInfo UserId
groupId GroupMember
membership GroupMember
hostMember
  GroupInfo
g <- Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user UserId
groupId
  (GroupInfo, GroupMember)
-> ExceptT StoreError IO (GroupInfo, GroupMember)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupInfo
g, GroupMember
hostMember)
  where
    insertHost_ :: UTCTime -> UserId -> LocalAlias -> ExceptT StoreError IO UserId
insertHost_ UTCTime
currentTs UserId
groupId LocalAlias
groupLDN = do
      let memberId :: MemberId
memberId = ConnId -> MemberId
MemberId (ConnId -> MemberId) -> ConnId -> MemberId
forall a b. (a -> b) -> a -> b
$ LocalAlias -> ConnId
encodeUtf8 LocalAlias
groupLDN ConnId -> ConnId -> ConnId
forall a. Semigroup a => a -> a -> a
<> ConnId
"_host_unknown_id"
          hostProfile :: Profile
hostProfile = LocalAlias -> Profile
profileFromName (LocalAlias -> Profile) -> LocalAlias -> Profile
forall a b. (a -> b) -> a -> b
$ MemberId -> LocalAlias
nameFromMemberId MemberId
memberId
      (LocalAlias
localDisplayName, UserId
profileId) <- Connection
-> User
-> Profile
-> UTCTime
-> ExceptT StoreError IO (LocalAlias, UserId)
createNewMemberProfile_ Connection
db User
user Profile
hostProfile UTCTime
currentTs
      UserId
indexInGroup <- Connection -> UserId -> ExceptT StoreError IO UserId
getUpdateNextIndexInGroup_ Connection
db UserId
groupId
      IO UserId -> ExceptT StoreError IO UserId
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserId -> ExceptT StoreError IO UserId)
-> IO UserId -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$ do
        Connection
-> Query
-> ((UserId, UserId, MemberId, GroupMemberRole,
     GroupMemberCategory, GroupMemberStatus, Binary ConnId,
     Maybe UserId)
    :. (UserId, LocalAlias, Maybe UserId, UserId, UTCTime, UTCTime))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
          Connection
db
          [sql|
            INSERT INTO group_members
              ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by,
                user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at)
            VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
          |]
          ( (UserId
groupId, UserId
indexInGroup, MemberId
memberId, GroupMemberRole
GRAdmin, GroupMemberCategory
GCHostMember, GroupMemberStatus
GSMemAccepted, ConnId -> Binary ConnId
forall a. a -> Binary a
Binary ConnId
B.empty, UserId -> InvitedBy -> Maybe UserId
fromInvitedBy UserId
userContactId InvitedBy
IBUnknown)
              (UserId, UserId, MemberId, GroupMemberRole, GroupMemberCategory,
 GroupMemberStatus, Binary ConnId, Maybe UserId)
-> (UserId, LocalAlias, Maybe UserId, UserId, UTCTime, UTCTime)
-> (UserId, UserId, MemberId, GroupMemberRole, GroupMemberCategory,
    GroupMemberStatus, Binary ConnId, Maybe UserId)
   :. (UserId, LocalAlias, Maybe UserId, UserId, UTCTime, UTCTime)
forall h t. h -> t -> h :. t
:. (UserId
userId, LocalAlias
localDisplayName, Maybe UserId
forall a. Maybe a
Nothing :: (Maybe Int64), UserId
profileId, UTCTime
currentTs, UTCTime
currentTs)
          )
        Connection -> IO UserId
insertedRowId Connection
db
    setGroupBusinessChatInfo :: GroupId -> GroupMember -> GroupMember -> IO ()
    setGroupBusinessChatInfo :: UserId -> GroupMember -> GroupMember -> IO ()
setGroupBusinessChatInfo UserId
groupId GroupMember
membership GroupMember
hostMember = do
      let businessChatInfo :: Maybe BusinessChatInfo
businessChatInfo = BusinessChatInfo -> Maybe BusinessChatInfo
forall a. a -> Maybe a
Just BusinessChatInfo {chatType :: BusinessChatType
chatType = BusinessChatType
BCBusiness, businessId :: MemberId
businessId = GroupMember -> MemberId
memberId' GroupMember
hostMember, customerId :: MemberId
customerId = GroupMember -> MemberId
memberId' GroupMember
membership}
      Connection -> UserId -> Maybe BusinessChatInfo -> IO ()
updateBusinessChatInfo Connection
db UserId
groupId Maybe BusinessChatInfo
businessChatInfo

updateBusinessChatInfo :: DB.Connection -> GroupId -> Maybe BusinessChatInfo -> IO ()
updateBusinessChatInfo :: Connection -> UserId -> Maybe BusinessChatInfo -> IO ()
updateBusinessChatInfo Connection
db UserId
groupId Maybe BusinessChatInfo
businessChatInfo =
  Connection
-> Query -> (BusinessChatInfoRow :. Only UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE groups
      SET business_chat = ?,
          business_member_id = ?,
          customer_member_id = ?
      WHERE group_id = ?
    |]
    (Maybe BusinessChatInfo -> BusinessChatInfoRow
businessChatInfoRow Maybe BusinessChatInfo
businessChatInfo BusinessChatInfoRow
-> Only UserId -> BusinessChatInfoRow :. Only UserId
forall h t. h -> t -> h :. t
:. (UserId -> Only UserId
forall a. a -> Only a
Only UserId
groupId))

updatePreparedGroupUser :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMember -> User -> ExceptT StoreError IO GroupInfo
updatePreparedGroupUser :: Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> GroupMember
-> User
-> ExceptT StoreError IO GroupInfo
updatePreparedGroupUser Connection
db VersionRangeChat
vr User
user gInfo :: GroupInfo
gInfo@GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId, GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} GroupMember
hostMember newUser :: User
newUser@User {userId :: User -> UserId
userId = UserId
newUserId} = 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
  GroupInfo -> UTCTime -> ExceptT StoreError IO ()
forall {b}. ToField b => GroupInfo -> b -> ExceptT StoreError IO ()
updateGroup GroupInfo
gInfo 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
$ GroupMember -> UTCTime -> IO ()
forall {e}. ToField e => GroupMember -> e -> IO ()
updateMembership GroupMember
membership UTCTime
currentTs
  GroupMember -> UTCTime -> ExceptT StoreError IO ()
forall {b}.
ToField b =>
GroupMember -> b -> ExceptT StoreError IO ()
updateHostMember GroupMember
hostMember UTCTime
currentTs
  Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
newUser UserId
groupId
  where
    updateGroup :: GroupInfo -> b -> ExceptT StoreError IO ()
updateGroup GroupInfo {localDisplayName :: GroupInfo -> LocalAlias
localDisplayName = LocalAlias
oldGroupLDN, groupProfile :: GroupInfo -> GroupProfile
groupProfile = GroupProfile {displayName :: GroupProfile -> LocalAlias
displayName = LocalAlias
groupDisplayName}} b
currentTs =
      IO (Either StoreError ()) -> ExceptT StoreError IO ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError ()) -> ExceptT StoreError IO ())
-> ((LocalAlias -> IO (Either StoreError ()))
    -> IO (Either StoreError ()))
-> (LocalAlias -> IO (Either StoreError ()))
-> ExceptT StoreError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError ()))
-> IO (Either StoreError ())
forall a.
Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError a))
-> IO (Either StoreError a)
withLocalDisplayName Connection
db UserId
newUserId LocalAlias
groupDisplayName ((LocalAlias -> IO (Either StoreError ()))
 -> ExceptT StoreError IO ())
-> (LocalAlias -> IO (Either StoreError ()))
-> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ \LocalAlias
newGroupLDN -> ExceptT StoreError IO () -> IO (Either StoreError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO () -> IO (Either StoreError ()))
-> ExceptT StoreError IO () -> IO (Either StoreError ())
forall a b. (a -> b) -> a -> b
$ do
        IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ do
          Connection -> Query -> (UserId, LocalAlias, b, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
            Connection
db
            [sql|
              UPDATE groups
              SET user_id = ?, local_display_name = ?, updated_at = ?
              WHERE group_id = ?
            |]
            (UserId
newUserId, LocalAlias
newGroupLDN, b
currentTs, UserId
groupId)
          Connection -> Query -> (UserId, b, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
            Connection
db
            [sql|
              UPDATE group_profiles
              SET user_id = ?, updated_at = ?
              WHERE group_profile_id IN (SELECT group_profile_id FROM groups WHERE group_id = ?)
            |]
            (UserId
newUserId, b
currentTs, UserId
groupId)
          Connection -> User -> LocalAlias -> IO ()
safeDeleteLDN Connection
db User
user LocalAlias
oldGroupLDN
    updateMembership :: GroupMember -> e -> IO ()
updateMembership GroupMember {groupMemberId :: GroupMember -> UserId
groupMemberId = UserId
membershipId} e
currentTs =
      Connection
-> Query
-> (UserId, LocalAlias, UserId, UserId, e, UserId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        [sql|
          UPDATE group_members
          SET user_id = ?, local_display_name = ?, contact_id = ?, contact_profile_id = ?, updated_at = ?
          WHERE group_member_id = ?
        |]
        (UserId
newUserId, User -> LocalAlias
forall a. IsContact a => a -> LocalAlias
localDisplayName' User
newUser, User -> UserId
forall a. IsContact a => a -> UserId
contactId' User
newUser, LocalProfile -> UserId
localProfileId (LocalProfile -> UserId) -> LocalProfile -> UserId
forall a b. (a -> b) -> a -> b
$ User -> LocalProfile
forall a. IsContact a => a -> LocalProfile
profile' User
newUser, e
currentTs, UserId
membershipId)
    updateHostMember :: GroupMember -> b -> ExceptT StoreError IO ()
updateHostMember
      GroupMember
        { groupMemberId :: GroupMember -> UserId
groupMemberId = UserId
hostId,
          localDisplayName :: GroupMember -> LocalAlias
localDisplayName = LocalAlias
oldHostLDN,
          memberProfile :: GroupMember -> LocalProfile
memberProfile = LocalProfile {profileId :: LocalProfile -> UserId
profileId = UserId
hostProfileId, displayName :: LocalProfile -> LocalAlias
displayName = LocalAlias
hostDisplayName}
        }
      b
currentTs =
        IO (Either StoreError ()) -> ExceptT StoreError IO ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError ()) -> ExceptT StoreError IO ())
-> ((LocalAlias -> IO (Either StoreError ()))
    -> IO (Either StoreError ()))
-> (LocalAlias -> IO (Either StoreError ()))
-> ExceptT StoreError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError ()))
-> IO (Either StoreError ())
forall a.
Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError a))
-> IO (Either StoreError a)
withLocalDisplayName Connection
db UserId
newUserId LocalAlias
hostDisplayName ((LocalAlias -> IO (Either StoreError ()))
 -> ExceptT StoreError IO ())
-> (LocalAlias -> IO (Either StoreError ()))
-> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ \LocalAlias
newHostLDN -> ExceptT StoreError IO () -> IO (Either StoreError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO () -> IO (Either StoreError ()))
-> ExceptT StoreError IO () -> IO (Either StoreError ())
forall a b. (a -> b) -> a -> b
$ do
          IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ do
            Connection -> Query -> (UserId, LocalAlias, b, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
              Connection
db
              [sql|
                UPDATE group_members
                SET user_id = ?, local_display_name = ?, updated_at = ?
                WHERE group_member_id = ?
              |]
              (UserId
newUserId, LocalAlias
newHostLDN, b
currentTs, UserId
hostId)
            Connection -> Query -> (UserId, b, UserId) -> 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 = ?
              |]
              (UserId
newUserId, b
currentTs, UserId
hostProfileId)
            Connection -> User -> LocalAlias -> IO ()
safeDeleteLDN Connection
db User
user LocalAlias
oldHostLDN

updatePreparedUserAndHostMembersInvited :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMember -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
updatePreparedUserAndHostMembersInvited :: Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> GroupMember
-> GroupLinkInvitation
-> ExceptT StoreError IO (GroupInfo, GroupMember)
updatePreparedUserAndHostMembersInvited Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo GroupMember
hostMember GroupLinkInvitation {MemberIdRole
fromMember :: MemberIdRole
fromMember :: GroupLinkInvitation -> MemberIdRole
fromMember, LocalAlias
fromMemberName :: LocalAlias
fromMemberName :: GroupLinkInvitation -> LocalAlias
fromMemberName, MemberIdRole
invitedMember :: MemberIdRole
invitedMember :: GroupLinkInvitation -> MemberIdRole
invitedMember, GroupProfile
groupProfile :: GroupProfile
groupProfile :: GroupLinkInvitation -> GroupProfile
groupProfile, Maybe GroupAcceptance
accepted :: Maybe GroupAcceptance
accepted :: GroupLinkInvitation -> Maybe GroupAcceptance
accepted, Maybe BusinessChatInfo
business :: Maybe BusinessChatInfo
business :: GroupLinkInvitation -> Maybe BusinessChatInfo
business} = do
  let fromMemberProfile :: Profile
fromMemberProfile = LocalAlias -> Profile
profileFromName LocalAlias
fromMemberName
      initialStatus :: GroupMemberStatus
initialStatus = GroupMemberStatus
-> (GroupAcceptance -> GroupMemberStatus)
-> Maybe GroupAcceptance
-> GroupMemberStatus
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GroupMemberStatus
GSMemAccepted (Maybe GroupMemberAdmission -> GroupAcceptance -> GroupMemberStatus
acceptanceToStatus (Maybe GroupMemberAdmission
 -> GroupAcceptance -> GroupMemberStatus)
-> Maybe GroupMemberAdmission
-> GroupAcceptance
-> GroupMemberStatus
forall a b. (a -> b) -> a -> b
$ GroupProfile -> Maybe GroupMemberAdmission
memberAdmission GroupProfile
groupProfile) Maybe GroupAcceptance
accepted
  Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> GroupMember
-> MemberIdRole
-> Profile
-> MemberIdRole
-> GroupProfile
-> Maybe BusinessChatInfo
-> GroupMemberStatus
-> ExceptT StoreError IO (GroupInfo, GroupMember)
updatePreparedUserAndHostMembers' Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo GroupMember
hostMember MemberIdRole
fromMember Profile
fromMemberProfile MemberIdRole
invitedMember GroupProfile
groupProfile Maybe BusinessChatInfo
business GroupMemberStatus
initialStatus

updatePreparedUserAndHostMembersRejected :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMember -> GroupLinkRejection -> ExceptT StoreError IO (GroupInfo, GroupMember)
updatePreparedUserAndHostMembersRejected :: Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> GroupMember
-> GroupLinkRejection
-> ExceptT StoreError IO (GroupInfo, GroupMember)
updatePreparedUserAndHostMembersRejected Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo GroupMember
hostMember GroupLinkRejection {fromMember :: GroupLinkRejection -> MemberIdRole
fromMember = fromMember :: MemberIdRole
fromMember@MemberIdRole {MemberId
memberId :: MemberIdRole -> MemberId
memberId :: MemberId
memberId}, MemberIdRole
invitedMember :: MemberIdRole
invitedMember :: GroupLinkRejection -> MemberIdRole
invitedMember, GroupProfile
groupProfile :: GroupProfile
groupProfile :: GroupLinkRejection -> GroupProfile
groupProfile} = do
  let fromMemberProfile :: Profile
fromMemberProfile = LocalAlias -> Profile
profileFromName (LocalAlias -> Profile) -> LocalAlias -> Profile
forall a b. (a -> b) -> a -> b
$ MemberId -> LocalAlias
nameFromMemberId MemberId
memberId
  Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> GroupMember
-> MemberIdRole
-> Profile
-> MemberIdRole
-> GroupProfile
-> Maybe BusinessChatInfo
-> GroupMemberStatus
-> ExceptT StoreError IO (GroupInfo, GroupMember)
updatePreparedUserAndHostMembers' Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo GroupMember
hostMember MemberIdRole
fromMember Profile
fromMemberProfile MemberIdRole
invitedMember GroupProfile
groupProfile Maybe BusinessChatInfo
forall a. Maybe a
Nothing GroupMemberStatus
GSMemRejected

updatePreparedUserAndHostMembers' :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMember -> MemberIdRole -> Profile -> MemberIdRole -> GroupProfile -> Maybe BusinessChatInfo -> GroupMemberStatus -> ExceptT StoreError IO (GroupInfo, GroupMember)
updatePreparedUserAndHostMembers' :: Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> GroupMember
-> MemberIdRole
-> Profile
-> MemberIdRole
-> GroupProfile
-> Maybe BusinessChatInfo
-> GroupMemberStatus
-> ExceptT StoreError IO (GroupInfo, GroupMember)
updatePreparedUserAndHostMembers'
  Connection
db
  VersionRangeChat
vr
  User
user
  gInfo :: GroupInfo
gInfo@GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId, groupProfile :: GroupInfo -> GroupProfile
groupProfile = GroupProfile
gp, Maybe BusinessChatInfo
businessChat :: GroupInfo -> Maybe BusinessChatInfo
businessChat :: Maybe BusinessChatInfo
businessChat}
  GroupMember
hostMember
  MemberIdRole
fromMember
  Profile
fromMemberProfile
  MemberIdRole
invitedMember
  GroupProfile
groupProfile
  Maybe BusinessChatInfo
business
  GroupMemberStatus
membershipStatus = do
    UTCTime
currentTs <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ UTCTime -> IO ()
forall {d}. ToField d => d -> IO ()
updateUserMember UTCTime
currentTs
    GroupMember
hostMember' <- UTCTime -> ExceptT StoreError IO GroupMember
forall {c}. ToField c => c -> ExceptT StoreError IO GroupMember
updateHostMember UTCTime
currentTs
    Bool -> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GroupProfile
gp GroupProfile -> GroupProfile -> Bool
forall a. Eq a => a -> a -> Bool
/= GroupProfile
groupProfile) (ExceptT StoreError IO () -> ExceptT StoreError IO ())
-> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
      ExceptT StoreError IO GroupInfo -> ExceptT StoreError IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT StoreError IO GroupInfo -> ExceptT StoreError IO ())
-> ExceptT StoreError IO GroupInfo -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> User
-> GroupInfo
-> GroupProfile
-> ExceptT StoreError IO GroupInfo
updateGroupProfile Connection
db User
user GroupInfo
gInfo GroupProfile
groupProfile
    Bool -> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe BusinessChatInfo -> Bool
forall a. Maybe a -> Bool
isJust Maybe BusinessChatInfo
businessChat Bool -> Bool -> Bool
&& Maybe BusinessChatInfo -> Bool
forall a. Maybe a -> Bool
isJust Maybe BusinessChatInfo
business) (ExceptT StoreError IO () -> ExceptT StoreError IO ())
-> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
      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 -> UserId -> Maybe BusinessChatInfo -> IO ()
updateBusinessChatInfo Connection
db UserId
groupId Maybe BusinessChatInfo
business
    GroupInfo
gInfo' <- Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user UserId
groupId
    (GroupInfo, GroupMember)
-> ExceptT StoreError IO (GroupInfo, GroupMember)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupInfo
gInfo', GroupMember
hostMember')
    where
      updateUserMember :: d -> IO ()
updateUserMember d
currentTs = do
        let GroupInfo {GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} = GroupInfo
gInfo
            MemberIdRole MemberId
memberId GroupMemberRole
memberRole = MemberIdRole
invitedMember
        Connection
-> Query
-> (MemberId, GroupMemberRole, GroupMemberStatus, d, UserId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
          Connection
db
          [sql|
            UPDATE group_members
            SET member_id = ?,
                member_role = ?,
                member_status = ?,
                updated_at = ?
            WHERE group_member_id = ?
          |]
          (MemberId
memberId, GroupMemberRole
memberRole, GroupMemberStatus
membershipStatus, d
currentTs, GroupMember -> UserId
groupMemberId' GroupMember
membership)
      updateHostMember :: c -> ExceptT StoreError IO GroupMember
updateHostMember c
currentTs = do
        GroupMember
_ <- Connection
-> User
-> GroupMember
-> Profile
-> ExceptT StoreError IO GroupMember
updateMemberProfile Connection
db User
user GroupMember
hostMember Profile
fromMemberProfile
        let MemberIdRole MemberId
memberId GroupMemberRole
memberRole = MemberIdRole
fromMember
            gmId :: UserId
gmId = GroupMember -> UserId
groupMemberId' GroupMember
hostMember
        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 -> (MemberId, GroupMemberRole, c, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
            Connection
db
            [sql|
              UPDATE group_members
              SET member_id = ?,
                  member_role = ?,
                  updated_at = ?
              WHERE group_member_id = ?
            |]
            (MemberId
memberId, GroupMemberRole
memberRole, c
currentTs, UserId
gmId)
        Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupMember
getGroupMemberById Connection
db VersionRangeChat
vr User
user UserId
gmId

createGroupInvitedViaLink :: DB.Connection -> VersionRangeChat -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
createGroupInvitedViaLink :: Connection
-> VersionRangeChat
-> User
-> Connection
-> GroupLinkInvitation
-> ExceptT StoreError IO (GroupInfo, GroupMember)
createGroupInvitedViaLink Connection
db VersionRangeChat
vr User
user Connection
conn GroupLinkInvitation {MemberIdRole
fromMember :: GroupLinkInvitation -> MemberIdRole
fromMember :: MemberIdRole
fromMember, LocalAlias
fromMemberName :: GroupLinkInvitation -> LocalAlias
fromMemberName :: LocalAlias
fromMemberName, MemberIdRole
invitedMember :: GroupLinkInvitation -> MemberIdRole
invitedMember :: MemberIdRole
invitedMember, GroupProfile
groupProfile :: GroupLinkInvitation -> GroupProfile
groupProfile :: GroupProfile
groupProfile, Maybe GroupAcceptance
accepted :: GroupLinkInvitation -> Maybe GroupAcceptance
accepted :: Maybe GroupAcceptance
accepted, Maybe BusinessChatInfo
business :: GroupLinkInvitation -> Maybe BusinessChatInfo
business :: Maybe BusinessChatInfo
business} = do
  let fromMemberProfile :: Profile
fromMemberProfile = LocalAlias -> Profile
profileFromName LocalAlias
fromMemberName
      initialStatus :: GroupMemberStatus
initialStatus = GroupMemberStatus
-> (GroupAcceptance -> GroupMemberStatus)
-> Maybe GroupAcceptance
-> GroupMemberStatus
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GroupMemberStatus
GSMemAccepted (Maybe GroupMemberAdmission -> GroupAcceptance -> GroupMemberStatus
acceptanceToStatus (Maybe GroupMemberAdmission
 -> GroupAcceptance -> GroupMemberStatus)
-> Maybe GroupMemberAdmission
-> GroupAcceptance
-> GroupMemberStatus
forall a b. (a -> b) -> a -> b
$ GroupProfile -> Maybe GroupMemberAdmission
memberAdmission GroupProfile
groupProfile) Maybe GroupAcceptance
accepted
  Connection
-> VersionRangeChat
-> User
-> Connection
-> MemberIdRole
-> Profile
-> MemberIdRole
-> GroupProfile
-> Maybe BusinessChatInfo
-> GroupMemberStatus
-> ExceptT StoreError IO (GroupInfo, GroupMember)
createGroupViaLink' Connection
db VersionRangeChat
vr User
user Connection
conn MemberIdRole
fromMember Profile
fromMemberProfile MemberIdRole
invitedMember GroupProfile
groupProfile Maybe BusinessChatInfo
business GroupMemberStatus
initialStatus

createGroupRejectedViaLink :: DB.Connection -> VersionRangeChat -> User -> Connection -> GroupLinkRejection -> ExceptT StoreError IO (GroupInfo, GroupMember)
createGroupRejectedViaLink :: Connection
-> VersionRangeChat
-> User
-> Connection
-> GroupLinkRejection
-> ExceptT StoreError IO (GroupInfo, GroupMember)
createGroupRejectedViaLink Connection
db VersionRangeChat
vr User
user Connection
conn GroupLinkRejection {fromMember :: GroupLinkRejection -> MemberIdRole
fromMember = fromMember :: MemberIdRole
fromMember@MemberIdRole {MemberId
memberId :: MemberIdRole -> MemberId
memberId :: MemberId
memberId}, MemberIdRole
invitedMember :: GroupLinkRejection -> MemberIdRole
invitedMember :: MemberIdRole
invitedMember, GroupProfile
groupProfile :: GroupLinkRejection -> GroupProfile
groupProfile :: GroupProfile
groupProfile} = do
  let fromMemberProfile :: Profile
fromMemberProfile = LocalAlias -> Profile
profileFromName (LocalAlias -> Profile) -> LocalAlias -> Profile
forall a b. (a -> b) -> a -> b
$ MemberId -> LocalAlias
nameFromMemberId MemberId
memberId
  Connection
-> VersionRangeChat
-> User
-> Connection
-> MemberIdRole
-> Profile
-> MemberIdRole
-> GroupProfile
-> Maybe BusinessChatInfo
-> GroupMemberStatus
-> ExceptT StoreError IO (GroupInfo, GroupMember)
createGroupViaLink' Connection
db VersionRangeChat
vr User
user Connection
conn MemberIdRole
fromMember Profile
fromMemberProfile MemberIdRole
invitedMember GroupProfile
groupProfile Maybe BusinessChatInfo
forall a. Maybe a
Nothing GroupMemberStatus
GSMemRejected

createGroupViaLink' :: DB.Connection -> VersionRangeChat -> User -> Connection -> MemberIdRole -> Profile -> MemberIdRole -> GroupProfile -> Maybe BusinessChatInfo -> GroupMemberStatus -> ExceptT StoreError IO (GroupInfo, GroupMember)
createGroupViaLink' :: Connection
-> VersionRangeChat
-> User
-> Connection
-> MemberIdRole
-> Profile
-> MemberIdRole
-> GroupProfile
-> Maybe BusinessChatInfo
-> GroupMemberStatus
-> ExceptT StoreError IO (GroupInfo, GroupMember)
createGroupViaLink'
  Connection
db
  VersionRangeChat
vr
  user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId, UserId
userContactId :: User -> UserId
userContactId :: UserId
userContactId}
  Connection {UserId
connId :: UserId
connId :: Connection -> UserId
connId, Maybe UserId
customUserProfileId :: Maybe UserId
customUserProfileId :: Connection -> Maybe UserId
customUserProfileId}
  MemberIdRole
fromMember
  Profile
fromMemberProfile
  MemberIdRole
invitedMember
  GroupProfile
groupProfile
  Maybe BusinessChatInfo
business
  GroupMemberStatus
membershipStatus = 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
    (UserId
groupId, LocalAlias
_groupLDN) <- Connection
-> UserId
-> GroupProfile
-> Maybe (CreatedLinkContact, Maybe SharedMsgId)
-> Maybe BusinessChatInfo
-> UTCTime
-> ExceptT StoreError IO (UserId, LocalAlias)
createGroup_ Connection
db UserId
userId GroupProfile
groupProfile Maybe (CreatedLinkContact, Maybe SharedMsgId)
forall a. Maybe a
Nothing Maybe BusinessChatInfo
business UTCTime
currentTs
    UserId
hostMemberId <- UTCTime -> UserId -> ExceptT StoreError IO UserId
insertHost_ UTCTime
currentTs UserId
groupId
    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 -> (ConnType, UserId, UTCTime, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE connections SET conn_type = ?, group_member_id = ?, updated_at = ? WHERE connection_id = ?" (ConnType
ConnMember, UserId
hostMemberId, UTCTime
currentTs, UserId
connId)
    -- using IBUnknown since host is created without contact
    ExceptT StoreError IO GroupMember -> ExceptT StoreError IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT StoreError IO GroupMember -> ExceptT StoreError IO ())
-> ExceptT StoreError IO GroupMember -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> User
-> UserId
-> Maybe UserId
-> User
-> MemberIdRole
-> GroupMemberCategory
-> GroupMemberStatus
-> InvitedBy
-> Maybe UserId
-> UTCTime
-> VersionRangeChat
-> ExceptT StoreError IO GroupMember
forall a.
IsContact a =>
Connection
-> User
-> UserId
-> Maybe UserId
-> a
-> MemberIdRole
-> GroupMemberCategory
-> GroupMemberStatus
-> InvitedBy
-> Maybe UserId
-> UTCTime
-> VersionRangeChat
-> ExceptT StoreError IO GroupMember
createContactMemberInv_ Connection
db User
user UserId
groupId (UserId -> Maybe UserId
forall a. a -> Maybe a
Just UserId
hostMemberId) User
user MemberIdRole
invitedMember GroupMemberCategory
GCUserMember GroupMemberStatus
membershipStatus InvitedBy
IBUnknown Maybe UserId
customUserProfileId UTCTime
currentTs VersionRangeChat
vr
    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 -> UserId -> UserId -> IO ()
setViaGroupLinkUri Connection
db UserId
groupId UserId
connId
    (,) (GroupInfo -> GroupMember -> (GroupInfo, GroupMember))
-> ExceptT StoreError IO GroupInfo
-> ExceptT StoreError IO (GroupMember -> (GroupInfo, GroupMember))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user UserId
groupId ExceptT StoreError IO (GroupMember -> (GroupInfo, GroupMember))
-> ExceptT StoreError IO GroupMember
-> ExceptT StoreError IO (GroupInfo, GroupMember)
forall a b.
ExceptT StoreError IO (a -> b)
-> ExceptT StoreError IO a -> ExceptT StoreError IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupMember
getGroupMemberById Connection
db VersionRangeChat
vr User
user UserId
hostMemberId
    where
      insertHost_ :: UTCTime -> UserId -> ExceptT StoreError IO UserId
insertHost_ UTCTime
currentTs UserId
groupId = do
        (LocalAlias
localDisplayName, UserId
profileId) <- Connection
-> User
-> Profile
-> UTCTime
-> ExceptT StoreError IO (LocalAlias, UserId)
createNewMemberProfile_ Connection
db User
user Profile
fromMemberProfile UTCTime
currentTs
        let MemberIdRole {MemberId
memberId :: MemberIdRole -> MemberId
memberId :: MemberId
memberId, GroupMemberRole
memberRole :: MemberIdRole -> GroupMemberRole
memberRole :: GroupMemberRole
memberRole} = MemberIdRole
fromMember
        UserId
indexInGroup <- Connection -> UserId -> ExceptT StoreError IO UserId
getUpdateNextIndexInGroup_ Connection
db UserId
groupId
        IO UserId -> ExceptT StoreError IO UserId
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserId -> ExceptT StoreError IO UserId)
-> IO UserId -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$ do
          Connection
-> Query
-> ((UserId, UserId, MemberId, GroupMemberRole,
     GroupMemberCategory, GroupMemberStatus, Binary ConnId,
     Maybe UserId)
    :. (UserId, LocalAlias, Maybe UserId, UserId, UTCTime, UTCTime))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
            Connection
db
            [sql|
              INSERT INTO group_members
                ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by,
                  user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at)
              VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
            |]
            ( (UserId
groupId, UserId
indexInGroup, MemberId
memberId, GroupMemberRole
memberRole, GroupMemberCategory
GCHostMember, GroupMemberStatus
GSMemAccepted, ConnId -> Binary ConnId
forall a. a -> Binary a
Binary ConnId
B.empty, UserId -> InvitedBy -> Maybe UserId
fromInvitedBy UserId
userContactId InvitedBy
IBUnknown)
                (UserId, UserId, MemberId, GroupMemberRole, GroupMemberCategory,
 GroupMemberStatus, Binary ConnId, Maybe UserId)
-> (UserId, LocalAlias, Maybe UserId, UserId, UTCTime, UTCTime)
-> (UserId, UserId, MemberId, GroupMemberRole, GroupMemberCategory,
    GroupMemberStatus, Binary ConnId, Maybe UserId)
   :. (UserId, LocalAlias, Maybe UserId, UserId, UTCTime, UTCTime)
forall h t. h -> t -> h :. t
:. (UserId
userId, LocalAlias
localDisplayName, Maybe UserId
forall a. Maybe a
Nothing :: (Maybe Int64), UserId
profileId, UTCTime
currentTs, UTCTime
currentTs)
            )
          Connection -> IO UserId
insertedRowId Connection
db

createGroup_ :: DB.Connection -> UserId -> GroupProfile -> Maybe (CreatedLinkContact, Maybe SharedMsgId) -> Maybe BusinessChatInfo -> UTCTime -> ExceptT StoreError IO (GroupId, Text)
createGroup_ :: Connection
-> UserId
-> GroupProfile
-> Maybe (CreatedLinkContact, Maybe SharedMsgId)
-> Maybe BusinessChatInfo
-> UTCTime
-> ExceptT StoreError IO (UserId, LocalAlias)
createGroup_ Connection
db UserId
userId GroupProfile
groupProfile Maybe (CreatedLinkContact, Maybe SharedMsgId)
prepared Maybe BusinessChatInfo
business UTCTime
currentTs = IO (Either StoreError (UserId, LocalAlias))
-> ExceptT StoreError IO (UserId, LocalAlias)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (UserId, LocalAlias))
 -> ExceptT StoreError IO (UserId, LocalAlias))
-> IO (Either StoreError (UserId, LocalAlias))
-> ExceptT StoreError IO (UserId, LocalAlias)
forall a b. (a -> b) -> a -> b
$ do
  let GroupProfile {LocalAlias
displayName :: GroupProfile -> LocalAlias
displayName :: LocalAlias
displayName, LocalAlias
fullName :: GroupProfile -> LocalAlias
fullName :: LocalAlias
fullName, Maybe LocalAlias
shortDescr :: GroupProfile -> Maybe LocalAlias
shortDescr :: Maybe LocalAlias
shortDescr, Maybe LocalAlias
description :: GroupProfile -> Maybe LocalAlias
description :: Maybe LocalAlias
description, Maybe ImageData
image :: GroupProfile -> Maybe ImageData
image :: Maybe ImageData
image, Maybe GroupPreferences
groupPreferences :: GroupProfile -> Maybe GroupPreferences
groupPreferences :: Maybe GroupPreferences
groupPreferences, Maybe GroupMemberAdmission
memberAdmission :: GroupProfile -> Maybe GroupMemberAdmission
memberAdmission :: Maybe GroupMemberAdmission
memberAdmission} = GroupProfile
groupProfile
  Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError (UserId, LocalAlias)))
-> IO (Either StoreError (UserId, LocalAlias))
forall a.
Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError a))
-> IO (Either StoreError a)
withLocalDisplayName Connection
db UserId
userId LocalAlias
displayName ((LocalAlias -> IO (Either StoreError (UserId, LocalAlias)))
 -> IO (Either StoreError (UserId, LocalAlias)))
-> (LocalAlias -> IO (Either StoreError (UserId, LocalAlias)))
-> IO (Either StoreError (UserId, LocalAlias))
forall a b. (a -> b) -> a -> b
$ \LocalAlias
localDisplayName -> ExceptT StoreError IO (UserId, LocalAlias)
-> IO (Either StoreError (UserId, LocalAlias))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO (UserId, LocalAlias)
 -> IO (Either StoreError (UserId, LocalAlias)))
-> ExceptT StoreError IO (UserId, LocalAlias)
-> IO (Either StoreError (UserId, LocalAlias))
forall a b. (a -> b) -> a -> b
$ do
    IO (UserId, LocalAlias)
-> ExceptT StoreError IO (UserId, LocalAlias)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (UserId, LocalAlias)
 -> ExceptT StoreError IO (UserId, LocalAlias))
-> IO (UserId, LocalAlias)
-> ExceptT StoreError IO (UserId, LocalAlias)
forall a b. (a -> b) -> a -> b
$ do
      Connection
-> Query
-> (LocalAlias, LocalAlias, Maybe LocalAlias, Maybe LocalAlias,
    Maybe ImageData, UserId, Maybe GroupPreferences,
    Maybe GroupMemberAdmission, UTCTime, UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        Query
"INSERT INTO group_profiles (display_name, full_name, short_descr, description, image, user_id, preferences, member_admission, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?)"
        (LocalAlias
displayName, LocalAlias
fullName, Maybe LocalAlias
shortDescr, Maybe LocalAlias
description, Maybe ImageData
image, UserId
userId, Maybe GroupPreferences
groupPreferences, Maybe GroupMemberAdmission
memberAdmission, UTCTime
currentTs, UTCTime
currentTs)
      UserId
profileId <- Connection -> IO UserId
insertedRowId Connection
db
      Connection
-> Query
-> ((UserId, LocalAlias, UserId, BoolInt, UTCTime, UTCTime,
     UTCTime, UTCTime)
    :. (NewPreparedGroupRow 'CMContact :. BusinessChatInfoRow))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        [sql|
          INSERT INTO groups
            (group_profile_id, local_display_name, user_id, enable_ntfs,
              created_at, updated_at, chat_ts, user_member_profile_sent_at, conn_full_link_to_connect, conn_short_link_to_connect, welcome_shared_msg_id,
              business_chat, business_member_id, customer_member_id)
          VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
        |]
        ((UserId
profileId, LocalAlias
localDisplayName, UserId
userId, Bool -> BoolInt
BI Bool
True, UTCTime
currentTs, UTCTime
currentTs, UTCTime
currentTs, UTCTime
currentTs) (UserId, LocalAlias, UserId, BoolInt, UTCTime, UTCTime, UTCTime,
 UTCTime)
-> (NewPreparedGroupRow 'CMContact :. BusinessChatInfoRow)
-> (UserId, LocalAlias, UserId, BoolInt, UTCTime, UTCTime, UTCTime,
    UTCTime)
   :. (NewPreparedGroupRow 'CMContact :. BusinessChatInfoRow)
forall h t. h -> t -> h :. t
:. Maybe (CreatedLinkContact, Maybe SharedMsgId)
-> NewPreparedGroupRow 'CMContact
forall (m :: ConnectionMode).
Maybe (CreatedConnLink m, Maybe SharedMsgId)
-> NewPreparedGroupRow m
toPreparedGroupRow Maybe (CreatedLinkContact, Maybe SharedMsgId)
prepared NewPreparedGroupRow 'CMContact
-> BusinessChatInfoRow
-> NewPreparedGroupRow 'CMContact :. BusinessChatInfoRow
forall h t. h -> t -> h :. t
:. Maybe BusinessChatInfo -> BusinessChatInfoRow
businessChatInfoRow Maybe BusinessChatInfo
business)
      UserId
groupId <- Connection -> IO UserId
insertedRowId Connection
db
      (UserId, LocalAlias) -> IO (UserId, LocalAlias)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserId
groupId, LocalAlias
localDisplayName)

setGroupInvitationChatItemId :: DB.Connection -> User -> GroupId -> ChatItemId -> IO ()
setGroupInvitationChatItemId :: Connection -> User -> UserId -> UserId -> IO ()
setGroupInvitationChatItemId Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} UserId
groupId UserId
chatItemId = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection -> Query -> (UserId, UTCTime, UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE groups SET chat_item_id = ?, updated_at = ? WHERE user_id = ? AND group_id = ?" (UserId
chatItemId, UTCTime
currentTs, UserId
userId, UserId
groupId)

-- TODO return the last connection that is ready, not any last connection
-- requires updating connection status
getGroup :: DB.Connection -> VersionRangeChat -> User -> GroupId -> ExceptT StoreError IO Group
getGroup :: Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO Group
getGroup Connection
db VersionRangeChat
vr User
user UserId
groupId = do
  GroupInfo
gInfo <- Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user UserId
groupId
  [GroupMember]
members <- IO [GroupMember] -> ExceptT StoreError IO [GroupMember]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [GroupMember] -> ExceptT StoreError IO [GroupMember])
-> IO [GroupMember] -> ExceptT StoreError IO [GroupMember]
forall a b. (a -> b) -> a -> b
$ Connection
-> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupMembers Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo
  Group -> ExceptT StoreError IO Group
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Group -> ExceptT StoreError IO Group)
-> Group -> ExceptT StoreError IO Group
forall a b. (a -> b) -> a -> b
$ GroupInfo -> [GroupMember] -> Group
Group GroupInfo
gInfo [GroupMember]
members

deleteGroupChatItems :: DB.Connection -> User -> GroupInfo -> IO ()
deleteGroupChatItems :: Connection -> User -> GroupInfo -> IO ()
deleteGroupChatItems Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} =
  Connection -> Query -> (UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM chat_items WHERE user_id = ? AND group_id = ?" (UserId
userId, UserId
groupId)

deleteGroupMembers :: DB.Connection -> User -> GroupInfo -> IO ()
deleteGroupMembers :: Connection -> User -> GroupInfo -> IO ()
deleteGroupMembers Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} = do
  Connection -> Query -> IO ()
DB.execute_ Connection
db Query
"DROP TABLE IF EXISTS temp_delete_members"
#if defined(dbPostgres)
  DB.execute_ db "CREATE TABLE temp_delete_members (contact_profile_id BIGINT, member_profile_id BIGINT, local_display_name TEXT)"
#else
  Connection -> Query -> IO ()
DB.execute_ Connection
db Query
"CREATE TABLE temp_delete_members (contact_profile_id INTEGER, member_profile_id INTEGER, local_display_name TEXT)"
#endif
  Connection -> Query -> Only UserId -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      INSERT INTO temp_delete_members (contact_profile_id, member_profile_id, local_display_name)
      SELECT contact_profile_id, member_profile_id, local_display_name FROM group_members WHERE group_id = ?
    |]
    (UserId -> Only UserId
forall a. a -> Only a
Only UserId
groupId)
  Connection -> Query -> (UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM group_members WHERE user_id = ? AND group_id = ?" (UserId
userId, UserId
groupId)
  Connection -> Query -> Only UserId -> 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 IN (SELECT contact_profile_id FROM temp_delete_members)
          OR contact_profile_id IN (SELECT member_profile_id FROM temp_delete_members WHERE member_profile_id IS NOT NULL))
        AND contact_profile_id NOT IN (SELECT contact_profile_id FROM group_members)
        AND contact_profile_id NOT IN (SELECT member_profile_id FROM group_members)
        AND contact_profile_id NOT IN (SELECT contact_profile_id FROM contacts)
        AND contact_profile_id NOT IN (SELECT contact_profile_id FROM contact_requests)
        AND contact_profile_id NOT IN (SELECT custom_user_profile_id FROM connections)
    |]
    (UserId -> Only UserId
forall a. a -> Only a
Only UserId
userId)
  Connection -> Query -> Only UserId -> 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 IN (SELECT local_display_name FROM temp_delete_members)
        AND local_display_name NOT IN (SELECT local_display_name FROM group_members)
        AND local_display_name NOT IN (SELECT local_display_name FROM contacts)
        AND local_display_name NOT IN (SELECT local_display_name FROM users)
        AND local_display_name NOT IN (SELECT local_display_name FROM groups)
        AND local_display_name NOT IN (SELECT local_display_name FROM user_contact_links)
        AND local_display_name NOT IN (SELECT local_display_name FROM contact_requests)
    |]
    (UserId -> Only UserId
forall a. a -> Only a
Only UserId
userId)
  Connection -> Query -> IO ()
DB.execute_ Connection
db Query
"DROP TABLE temp_delete_members"

-- to allow repeat connection via the same group link if one was used
cleanupHostGroupLinkConn :: DB.Connection -> User -> GroupInfo -> IO ()
cleanupHostGroupLinkConn :: Connection -> User -> GroupInfo -> IO ()
cleanupHostGroupLinkConn Connection
db user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} = do
  ExceptT StoreError IO UserId -> IO (Either StoreError UserId)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (Connection -> User -> UserId -> ExceptT StoreError IO UserId
getHostMemberId_ Connection
db User
user UserId
groupId) IO (Either StoreError UserId)
-> (Either StoreError UserId -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left StoreError
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Right UserId
hostId ->
      Connection -> Query -> (UserId, UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        [sql|
          UPDATE connections SET via_contact_uri = NULL, via_contact_uri_hash = NULL, xcontact_id = NULL
          WHERE user_id = ? AND via_group_link = 1 AND contact_id IN (
            SELECT contact_id
            FROM group_members
            WHERE user_id = ? AND group_member_id = ?
          )
        |]
        (UserId
userId, UserId
userId, UserId
hostId)

deleteGroup :: DB.Connection -> User -> GroupInfo -> IO ()
deleteGroup :: Connection -> User -> GroupInfo -> IO ()
deleteGroup Connection
db user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} g :: GroupInfo
g@GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId, LocalAlias
localDisplayName :: GroupInfo -> LocalAlias
localDisplayName :: LocalAlias
localDisplayName} = do
  Connection -> UserId -> UserId -> IO ()
deleteGroupProfile_ Connection
db UserId
userId UserId
groupId
  Connection -> Query -> (UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM groups WHERE user_id = ? AND group_id = ?" (UserId
userId, UserId
groupId)
  Connection -> User -> LocalAlias -> IO ()
safeDeleteLDN Connection
db User
user LocalAlias
localDisplayName
  Maybe LocalProfile -> (LocalProfile -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (GroupInfo -> Maybe LocalProfile
incognitoMembershipProfile GroupInfo
g) ((LocalProfile -> IO ()) -> IO ())
-> (LocalProfile -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> User -> UserId -> IO ()
deleteUnusedIncognitoProfileById_ Connection
db User
user (UserId -> IO ())
-> (LocalProfile -> UserId) -> LocalProfile -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalProfile -> UserId
localProfileId

deleteGroupProfile_ :: DB.Connection -> UserId -> GroupId -> IO ()
deleteGroupProfile_ :: Connection -> UserId -> UserId -> IO ()
deleteGroupProfile_ Connection
db UserId
userId UserId
groupId =
  Connection -> Query -> (UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      DELETE FROM group_profiles
      WHERE group_profile_id in (
        SELECT group_profile_id
        FROM groups
        WHERE user_id = ? AND group_id = ?
      )
    |]
    (UserId
userId, UserId
groupId)

getBaseGroupDetails :: DB.Connection -> VersionRangeChat -> User -> Maybe ContactId -> Maybe Text -> IO [GroupInfo]
getBaseGroupDetails :: Connection
-> VersionRangeChat
-> User
-> Maybe UserId
-> Maybe LocalAlias
-> IO [GroupInfo]
getBaseGroupDetails Connection
db VersionRangeChat
vr User {UserId
userId :: User -> UserId
userId :: UserId
userId, UserId
userContactId :: User -> UserId
userContactId :: UserId
userContactId} Maybe UserId
_contactId_ Maybe LocalAlias
search_ = do
  (GroupInfoRow -> GroupInfo) -> [GroupInfoRow] -> [GroupInfo]
forall a b. (a -> b) -> [a] -> [b]
map (VersionRangeChat -> UserId -> [UserId] -> GroupInfoRow -> GroupInfo
toGroupInfo VersionRangeChat
vr UserId
userContactId [])
    ([GroupInfoRow] -> [GroupInfo])
-> IO [GroupInfoRow] -> IO [GroupInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (UserId, UserId, LocalAlias, LocalAlias, LocalAlias, LocalAlias)
-> IO [GroupInfoRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
groupInfoQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" " Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
condition) (UserId
userId, UserId
userContactId, LocalAlias
search, LocalAlias
search, LocalAlias
search, LocalAlias
search)
  where
    condition :: Query
condition =
      [sql|
        WHERE g.user_id = ? AND mu.contact_id = ?
          AND (LOWER(gp.display_name) LIKE '%' || ? || '%'
            OR LOWER(gp.full_name) LIKE '%' || ? || '%'
            OR LOWER(gp.short_descr) LIKE '%' || ? || '%'
            OR LOWER(gp.description) LIKE '%' || ? || '%'
          )
      |]
    search :: LocalAlias
search = LocalAlias
-> (LocalAlias -> LocalAlias) -> Maybe LocalAlias -> LocalAlias
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LocalAlias
"" ((Char -> Char) -> LocalAlias -> LocalAlias
T.map Char -> Char
toLower) Maybe LocalAlias
search_

getContactGroupPreferences :: DB.Connection -> User -> Contact -> IO [(GroupMemberRole, FullGroupPreferences)]
getContactGroupPreferences :: Connection
-> User -> Contact -> IO [(GroupMemberRole, FullGroupPreferences)]
getContactGroupPreferences Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} Contact {UserId
contactId :: Contact -> UserId
contactId :: UserId
contactId} = do
  ((GroupMemberRole, Maybe GroupPreferences)
 -> (GroupMemberRole, FullGroupPreferences))
-> [(GroupMemberRole, Maybe GroupPreferences)]
-> [(GroupMemberRole, FullGroupPreferences)]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe GroupPreferences -> FullGroupPreferences)
-> (GroupMemberRole, Maybe GroupPreferences)
-> (GroupMemberRole, FullGroupPreferences)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Maybe GroupPreferences -> FullGroupPreferences
mergeGroupPreferences)
    ([(GroupMemberRole, Maybe GroupPreferences)]
 -> [(GroupMemberRole, FullGroupPreferences)])
-> IO [(GroupMemberRole, Maybe GroupPreferences)]
-> IO [(GroupMemberRole, FullGroupPreferences)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (UserId, UserId)
-> IO [(GroupMemberRole, Maybe GroupPreferences)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT m.member_role, gp.preferences
        FROM groups g
        JOIN group_profiles gp USING (group_profile_id)
        JOIN group_members m USING (group_id)
        WHERE g.user_id = ? AND m.contact_id = ?
      |]
      (UserId
userId, UserId
contactId)

getGroupInfoByName :: DB.Connection -> VersionRangeChat -> User -> GroupName -> ExceptT StoreError IO GroupInfo
getGroupInfoByName :: Connection
-> VersionRangeChat
-> User
-> LocalAlias
-> ExceptT StoreError IO GroupInfo
getGroupInfoByName Connection
db VersionRangeChat
vr User
user LocalAlias
gName = do
  UserId
gId <- Connection -> User -> LocalAlias -> ExceptT StoreError IO UserId
getGroupIdByName Connection
db User
user LocalAlias
gName
  Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user UserId
gId

getGroupMember :: DB.Connection -> VersionRangeChat -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO GroupMember
getGroupMember :: Connection
-> VersionRangeChat
-> User
-> UserId
-> UserId
-> ExceptT StoreError IO GroupMember
getGroupMember Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} UserId
groupId UserId
groupMemberId =
  IO (Either StoreError GroupMember)
-> ExceptT StoreError IO GroupMember
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError GroupMember)
 -> ExceptT StoreError IO GroupMember)
-> (IO [GroupMemberRow :. MaybeConnectionRow]
    -> IO (Either StoreError GroupMember))
-> IO [GroupMemberRow :. MaybeConnectionRow]
-> ExceptT StoreError IO GroupMember
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((GroupMemberRow :. MaybeConnectionRow) -> GroupMember)
-> StoreError
-> IO [GroupMemberRow :. MaybeConnectionRow]
-> IO (Either StoreError GroupMember)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (VersionRangeChat
-> User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember
toContactMember VersionRangeChat
vr User
user) (UserId -> StoreError
SEGroupMemberNotFound UserId
groupMemberId) (IO [GroupMemberRow :. MaybeConnectionRow]
 -> ExceptT StoreError IO GroupMember)
-> IO [GroupMemberRow :. MaybeConnectionRow]
-> ExceptT StoreError IO GroupMember
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (UserId, UserId, UserId)
-> IO [GroupMemberRow :. MaybeConnectionRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      (Query
groupMemberQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE m.group_id = ? AND m.group_member_id = ? AND m.user_id = ?")
      (UserId
groupId, UserId
groupMemberId, UserId
userId)

getHostMember :: DB.Connection -> VersionRangeChat -> User -> GroupId -> ExceptT StoreError IO GroupMember
getHostMember :: Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupMember
getHostMember Connection
db VersionRangeChat
vr User
user UserId
groupId =
  IO (Either StoreError GroupMember)
-> ExceptT StoreError IO GroupMember
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError GroupMember)
 -> ExceptT StoreError IO GroupMember)
-> (IO [GroupMemberRow :. MaybeConnectionRow]
    -> IO (Either StoreError GroupMember))
-> IO [GroupMemberRow :. MaybeConnectionRow]
-> ExceptT StoreError IO GroupMember
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((GroupMemberRow :. MaybeConnectionRow) -> GroupMember)
-> StoreError
-> IO [GroupMemberRow :. MaybeConnectionRow]
-> IO (Either StoreError GroupMember)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (VersionRangeChat
-> User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember
toContactMember VersionRangeChat
vr User
user) (UserId -> StoreError
SEGroupHostMemberNotFound UserId
groupId) (IO [GroupMemberRow :. MaybeConnectionRow]
 -> ExceptT StoreError IO GroupMember)
-> IO [GroupMemberRow :. MaybeConnectionRow]
-> ExceptT StoreError IO GroupMember
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (UserId, GroupMemberCategory)
-> IO [GroupMemberRow :. MaybeConnectionRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      (Query
groupMemberQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE m.group_id = ? AND m.member_category = ?")
      (UserId
groupId, GroupMemberCategory
GCHostMember)

getMentionedGroupMember :: DB.Connection -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO CIMention
getMentionedGroupMember :: Connection
-> User -> UserId -> UserId -> ExceptT StoreError IO CIMention
getMentionedGroupMember Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} UserId
groupId UserId
gmId =
  IO (Either StoreError CIMention) -> ExceptT StoreError IO CIMention
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError CIMention)
 -> ExceptT StoreError IO CIMention)
-> IO (Either StoreError CIMention)
-> ExceptT StoreError IO CIMention
forall a b. (a -> b) -> a -> b
$
    ((UserId, MemberId, GroupMemberRole, LocalAlias, Maybe LocalAlias)
 -> CIMention)
-> StoreError
-> IO
     [(UserId, MemberId, GroupMemberRole, LocalAlias, Maybe LocalAlias)]
-> IO (Either StoreError CIMention)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (UserId, MemberId, GroupMemberRole, LocalAlias, Maybe LocalAlias)
-> CIMention
toMentionedMember (UserId -> StoreError
SEGroupMemberNotFound UserId
gmId) (IO
   [(UserId, MemberId, GroupMemberRole, LocalAlias, Maybe LocalAlias)]
 -> IO (Either StoreError CIMention))
-> IO
     [(UserId, MemberId, GroupMemberRole, LocalAlias, Maybe LocalAlias)]
-> IO (Either StoreError CIMention)
forall a b. (a -> b) -> a -> b
$
      Connection
-> Query
-> (UserId, UserId, UserId)
-> IO
     [(UserId, MemberId, GroupMemberRole, LocalAlias, Maybe LocalAlias)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        (Query
mentionedMemberQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE m.group_id = ? AND m.group_member_id = ? AND m.user_id = ?")
        (UserId
groupId, UserId
gmId, UserId
userId)

getMentionedMemberByMemberId :: DB.Connection -> User -> GroupId -> MsgMention -> IO CIMention
getMentionedMemberByMemberId :: Connection -> User -> UserId -> MsgMention -> IO CIMention
getMentionedMemberByMemberId Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} UserId
groupId MsgMention {MemberId
memberId :: MemberId
memberId :: MsgMention -> MemberId
memberId} =
  (Maybe CIMention -> CIMention)
-> IO (Maybe CIMention) -> IO CIMention
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CIMention -> Maybe CIMention -> CIMention
forall a. a -> Maybe a -> a
fromMaybe CIMention
mentionedMember) (IO (Maybe CIMention) -> IO CIMention)
-> IO (Maybe CIMention) -> IO CIMention
forall a b. (a -> b) -> a -> b
$
    ((UserId, MemberId, GroupMemberRole, LocalAlias, Maybe LocalAlias)
 -> CIMention)
-> IO
     [(UserId, MemberId, GroupMemberRole, LocalAlias, Maybe LocalAlias)]
-> IO (Maybe CIMention)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow (UserId, MemberId, GroupMemberRole, LocalAlias, Maybe LocalAlias)
-> CIMention
toMentionedMember (IO
   [(UserId, MemberId, GroupMemberRole, LocalAlias, Maybe LocalAlias)]
 -> IO (Maybe CIMention))
-> IO
     [(UserId, MemberId, GroupMemberRole, LocalAlias, Maybe LocalAlias)]
-> IO (Maybe CIMention)
forall a b. (a -> b) -> a -> b
$
      Connection
-> Query
-> (UserId, MemberId, UserId)
-> IO
     [(UserId, MemberId, GroupMemberRole, LocalAlias, Maybe LocalAlias)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        (Query
mentionedMemberQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE m.group_id = ? AND m.member_id = ? AND m.user_id = ?")
        (UserId
groupId, MemberId
memberId, UserId
userId)
  where
    mentionedMember :: CIMention
mentionedMember = CIMention {MemberId
memberId :: MemberId
memberId :: MemberId
memberId, memberRef :: Maybe CIMentionMember
memberRef = Maybe CIMentionMember
forall a. Maybe a
Nothing}

mentionedMemberQuery :: Query
mentionedMemberQuery :: Query
mentionedMemberQuery =
  [sql|
    SELECT m.group_member_id, m.member_id, m.member_role, p.display_name, p.local_alias
    FROM group_members m
    JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
  |]

toMentionedMember :: (GroupMemberId, MemberId, GroupMemberRole, Text, Maybe Text) -> CIMention
toMentionedMember :: (UserId, MemberId, GroupMemberRole, LocalAlias, Maybe LocalAlias)
-> CIMention
toMentionedMember (UserId
groupMemberId, MemberId
memberId, GroupMemberRole
memberRole, LocalAlias
displayName, Maybe LocalAlias
localAlias) =
  let memberRef :: Maybe CIMentionMember
memberRef = CIMentionMember -> Maybe CIMentionMember
forall a. a -> Maybe a
Just CIMentionMember {UserId
groupMemberId :: UserId
groupMemberId :: UserId
groupMemberId, LocalAlias
displayName :: LocalAlias
displayName :: LocalAlias
displayName, Maybe LocalAlias
localAlias :: Maybe LocalAlias
localAlias :: Maybe LocalAlias
localAlias, GroupMemberRole
memberRole :: GroupMemberRole
memberRole :: GroupMemberRole
memberRole}
   in CIMention {MemberId
memberId :: MemberId
memberId :: MemberId
memberId, Maybe CIMentionMember
memberRef :: Maybe CIMentionMember
memberRef :: Maybe CIMentionMember
memberRef}

getGroupMemberById :: DB.Connection -> VersionRangeChat -> User -> GroupMemberId -> ExceptT StoreError IO GroupMember
getGroupMemberById :: Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupMember
getGroupMemberById Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} UserId
groupMemberId =
  IO (Either StoreError GroupMember)
-> ExceptT StoreError IO GroupMember
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError GroupMember)
 -> ExceptT StoreError IO GroupMember)
-> (IO [GroupMemberRow :. MaybeConnectionRow]
    -> IO (Either StoreError GroupMember))
-> IO [GroupMemberRow :. MaybeConnectionRow]
-> ExceptT StoreError IO GroupMember
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((GroupMemberRow :. MaybeConnectionRow) -> GroupMember)
-> StoreError
-> IO [GroupMemberRow :. MaybeConnectionRow]
-> IO (Either StoreError GroupMember)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (VersionRangeChat
-> User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember
toContactMember VersionRangeChat
vr User
user) (UserId -> StoreError
SEGroupMemberNotFound UserId
groupMemberId) (IO [GroupMemberRow :. MaybeConnectionRow]
 -> ExceptT StoreError IO GroupMember)
-> IO [GroupMemberRow :. MaybeConnectionRow]
-> ExceptT StoreError IO GroupMember
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (UserId, UserId)
-> IO [GroupMemberRow :. MaybeConnectionRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      (Query
groupMemberQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE m.group_member_id = ? AND m.user_id = ?")
      (UserId
groupMemberId, UserId
userId)

getGroupMemberByIndex :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> Int64 -> ExceptT StoreError IO GroupMember
getGroupMemberByIndex :: Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> UserId
-> ExceptT StoreError IO GroupMember
getGroupMemberByIndex Connection
db VersionRangeChat
vr User
user GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} UserId
indexInGroup =
  IO (Either StoreError GroupMember)
-> ExceptT StoreError IO GroupMember
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError GroupMember)
 -> ExceptT StoreError IO GroupMember)
-> (IO [GroupMemberRow :. MaybeConnectionRow]
    -> IO (Either StoreError GroupMember))
-> IO [GroupMemberRow :. MaybeConnectionRow]
-> ExceptT StoreError IO GroupMember
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((GroupMemberRow :. MaybeConnectionRow) -> GroupMember)
-> StoreError
-> IO [GroupMemberRow :. MaybeConnectionRow]
-> IO (Either StoreError GroupMember)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (VersionRangeChat
-> User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember
toContactMember VersionRangeChat
vr User
user) (UserId -> StoreError
SEGroupMemberNotFoundByIndex UserId
indexInGroup) (IO [GroupMemberRow :. MaybeConnectionRow]
 -> ExceptT StoreError IO GroupMember)
-> IO [GroupMemberRow :. MaybeConnectionRow]
-> ExceptT StoreError IO GroupMember
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (UserId, UserId)
-> IO [GroupMemberRow :. MaybeConnectionRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      (Query
groupMemberQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE m.group_id = ? AND m.index_in_group = ?")
      (UserId
groupId, UserId
indexInGroup)

getSupportScopeMemberByIndex :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMemberId -> Int64 -> ExceptT StoreError IO GroupMember
getSupportScopeMemberByIndex :: Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> UserId
-> UserId
-> ExceptT StoreError IO GroupMember
getSupportScopeMemberByIndex Connection
db VersionRangeChat
vr User
user GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} UserId
scopeGMId UserId
indexInGroup =
  IO (Either StoreError GroupMember)
-> ExceptT StoreError IO GroupMember
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError GroupMember)
 -> ExceptT StoreError IO GroupMember)
-> (IO [GroupMemberRow :. MaybeConnectionRow]
    -> IO (Either StoreError GroupMember))
-> IO [GroupMemberRow :. MaybeConnectionRow]
-> ExceptT StoreError IO GroupMember
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((GroupMemberRow :. MaybeConnectionRow) -> GroupMember)
-> StoreError
-> IO [GroupMemberRow :. MaybeConnectionRow]
-> IO (Either StoreError GroupMember)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (VersionRangeChat
-> User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember
toContactMember VersionRangeChat
vr User
user) (UserId -> StoreError
SEGroupMemberNotFoundByIndex UserId
indexInGroup) (IO [GroupMemberRow :. MaybeConnectionRow]
 -> ExceptT StoreError IO GroupMember)
-> IO [GroupMemberRow :. MaybeConnectionRow]
-> ExceptT StoreError IO GroupMember
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (UserId, UserId, GroupMemberRole, GroupMemberRole,
    GroupMemberRole, UserId)
-> IO [GroupMemberRow :. MaybeConnectionRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      (Query
groupMemberQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE m.group_id = ? AND m.index_in_group = ? AND (m.member_role IN (?,?,?) OR m.group_member_id = ?)")
      (UserId
groupId, UserId
indexInGroup, GroupMemberRole
GRModerator, GroupMemberRole
GRAdmin, GroupMemberRole
GROwner, UserId
scopeGMId)

getGroupMemberByMemberId :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> MemberId -> ExceptT StoreError IO GroupMember
getGroupMemberByMemberId :: Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> MemberId
-> ExceptT StoreError IO GroupMember
getGroupMemberByMemberId Connection
db VersionRangeChat
vr User
user GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} MemberId
memberId =
  IO (Either StoreError GroupMember)
-> ExceptT StoreError IO GroupMember
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError GroupMember)
 -> ExceptT StoreError IO GroupMember)
-> (IO [GroupMemberRow :. MaybeConnectionRow]
    -> IO (Either StoreError GroupMember))
-> IO [GroupMemberRow :. MaybeConnectionRow]
-> ExceptT StoreError IO GroupMember
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((GroupMemberRow :. MaybeConnectionRow) -> GroupMember)
-> StoreError
-> IO [GroupMemberRow :. MaybeConnectionRow]
-> IO (Either StoreError GroupMember)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (VersionRangeChat
-> User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember
toContactMember VersionRangeChat
vr User
user) (MemberId -> StoreError
SEGroupMemberNotFoundByMemberId MemberId
memberId) (IO [GroupMemberRow :. MaybeConnectionRow]
 -> ExceptT StoreError IO GroupMember)
-> IO [GroupMemberRow :. MaybeConnectionRow]
-> ExceptT StoreError IO GroupMember
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (UserId, MemberId)
-> IO [GroupMemberRow :. MaybeConnectionRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      (Query
groupMemberQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE m.group_id = ? AND m.member_id = ?")
      (UserId
groupId, MemberId
memberId)

getScopeMemberIdViaMemberId :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberId -> ExceptT StoreError IO GroupMemberId
getScopeMemberIdViaMemberId :: Connection
-> User
-> GroupInfo
-> GroupMember
-> MemberId
-> ExceptT StoreError IO UserId
getScopeMemberIdViaMemberId Connection
db User
user g :: GroupInfo
g@GroupInfo {GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} GroupMember
sender MemberId
scopeMemberId
  | MemberId
scopeMemberId MemberId -> MemberId -> Bool
forall a. Eq a => a -> a -> Bool
== GroupMember -> MemberId
memberId' GroupMember
membership = UserId -> ExceptT StoreError IO UserId
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserId -> ExceptT StoreError IO UserId)
-> UserId -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$ GroupMember -> UserId
groupMemberId' GroupMember
membership
  | MemberId
scopeMemberId MemberId -> MemberId -> Bool
forall a. Eq a => a -> a -> Bool
== GroupMember -> MemberId
memberId' GroupMember
sender = UserId -> ExceptT StoreError IO UserId
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserId -> ExceptT StoreError IO UserId)
-> UserId -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$ GroupMember -> UserId
groupMemberId' GroupMember
sender
  | Bool
otherwise = Connection
-> User -> GroupInfo -> MemberId -> ExceptT StoreError IO UserId
getGroupMemberIdViaMemberId Connection
db User
user GroupInfo
g MemberId
scopeMemberId

getGroupMemberIdViaMemberId :: DB.Connection -> User -> GroupInfo -> MemberId -> ExceptT StoreError IO GroupMemberId
getGroupMemberIdViaMemberId :: Connection
-> User -> GroupInfo -> MemberId -> ExceptT StoreError IO UserId
getGroupMemberIdViaMemberId Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} MemberId
memberId =
  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 (MemberId -> StoreError
SEGroupMemberNotFoundByMemberId MemberId
memberId) (IO [Only UserId] -> ExceptT StoreError IO UserId)
-> IO [Only UserId] -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query -> (UserId, UserId, MemberId) -> IO [Only UserId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      Query
"SELECT group_member_id FROM group_members WHERE user_id = ? AND group_id = ? AND member_id = ?"
      (UserId
userId, UserId
groupId, MemberId
memberId)

getGroupMembers :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupMembers :: Connection
-> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupMembers Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId, UserId
userContactId :: User -> UserId
userContactId :: UserId
userContactId} GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} =
  ((GroupMemberRow :. MaybeConnectionRow) -> GroupMember)
-> [GroupMemberRow :. MaybeConnectionRow] -> [GroupMember]
forall a b. (a -> b) -> [a] -> [b]
map (VersionRangeChat
-> User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember
toContactMember VersionRangeChat
vr User
user)
    ([GroupMemberRow :. MaybeConnectionRow] -> [GroupMember])
-> IO [GroupMemberRow :. MaybeConnectionRow] -> IO [GroupMember]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (UserId, UserId, UserId)
-> IO [GroupMemberRow :. MaybeConnectionRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      (Query
groupMemberQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?)")
      (UserId
userId, UserId
groupId, UserId
userContactId)

getGroupMembersByIndexes :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> [Int64] -> IO [GroupMember]
getGroupMembersByIndexes :: Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> [UserId]
-> IO [GroupMember]
getGroupMembersByIndexes Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo [UserId]
indexesInGroup = do
#if defined(dbPostgres)
  let GroupInfo {groupId} = gInfo
  map (toContactMember vr user) <$>
    DB.query
      db
      (groupMemberQuery <> " WHERE m.group_id = ? AND m.index_in_group IN ?")
      (groupId, In indexesInGroup)
#else
  [Either StoreError GroupMember] -> [GroupMember]
forall a b. [Either a b] -> [b]
rights ([Either StoreError GroupMember] -> [GroupMember])
-> IO [Either StoreError GroupMember] -> IO [GroupMember]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UserId -> IO (Either StoreError GroupMember))
-> [UserId] -> IO [Either StoreError GroupMember]
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 GroupMember
-> IO (Either StoreError GroupMember)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO GroupMember
 -> IO (Either StoreError GroupMember))
-> (UserId -> ExceptT StoreError IO GroupMember)
-> UserId
-> IO (Either StoreError GroupMember)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> UserId
-> ExceptT StoreError IO GroupMember
getGroupMemberByIndex Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo) [UserId]
indexesInGroup
#endif

getSupportScopeMembersByIndexes :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMemberId -> [Int64] -> IO [GroupMember]
getSupportScopeMembersByIndexes :: Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> UserId
-> [UserId]
-> IO [GroupMember]
getSupportScopeMembersByIndexes Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo UserId
scopeGMId [UserId]
indexesInGroup = do
#if defined(dbPostgres)
  let GroupInfo {groupId} = gInfo
  map (toContactMember vr user) <$>
    DB.query
      db
      (groupMemberQuery <> " WHERE m.group_id = ? AND m.index_in_group IN ? AND (m.member_role IN (?,?,?) OR m.group_member_id = ?)")
      (groupId, In indexesInGroup, GRModerator, GRAdmin, GROwner, scopeGMId)
#else
  [Either StoreError GroupMember] -> [GroupMember]
forall a b. [Either a b] -> [b]
rights ([Either StoreError GroupMember] -> [GroupMember])
-> IO [Either StoreError GroupMember] -> IO [GroupMember]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UserId -> IO (Either StoreError GroupMember))
-> [UserId] -> IO [Either StoreError GroupMember]
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 GroupMember
-> IO (Either StoreError GroupMember)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO GroupMember
 -> IO (Either StoreError GroupMember))
-> (UserId -> ExceptT StoreError IO GroupMember)
-> UserId
-> IO (Either StoreError GroupMember)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> UserId
-> UserId
-> ExceptT StoreError IO GroupMember
getSupportScopeMemberByIndex Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo UserId
scopeGMId) [UserId]
indexesInGroup
#endif

getGroupModerators :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupModerators :: Connection
-> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupModerators Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId, UserId
userContactId :: User -> UserId
userContactId :: UserId
userContactId} GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} = do
  ((GroupMemberRow :. MaybeConnectionRow) -> GroupMember)
-> [GroupMemberRow :. MaybeConnectionRow] -> [GroupMember]
forall a b. (a -> b) -> [a] -> [b]
map (VersionRangeChat
-> User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember
toContactMember VersionRangeChat
vr User
user)
    ([GroupMemberRow :. MaybeConnectionRow] -> [GroupMember])
-> IO [GroupMemberRow :. MaybeConnectionRow] -> IO [GroupMember]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (UserId, UserId, UserId, GroupMemberRole, GroupMemberRole,
    GroupMemberRole)
-> IO [GroupMemberRow :. MaybeConnectionRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      (Query
groupMemberQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role IN (?,?,?)")
      (UserId
userId, UserId
groupId, UserId
userContactId, GroupMemberRole
GRModerator, GroupMemberRole
GRAdmin, GroupMemberRole
GROwner)

-- TODO [channels fwd] retrieve relays based on knowledge about member from protocol, not role (isMemberRelay)
getGroupRelays :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupRelays :: Connection
-> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupRelays Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId, UserId
userContactId :: User -> UserId
userContactId :: UserId
userContactId} GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} = do
  ((GroupMemberRow :. MaybeConnectionRow) -> GroupMember)
-> [GroupMemberRow :. MaybeConnectionRow] -> [GroupMember]
forall a b. (a -> b) -> [a] -> [b]
map (VersionRangeChat
-> User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember
toContactMember VersionRangeChat
vr User
user)
    ([GroupMemberRow :. MaybeConnectionRow] -> [GroupMember])
-> IO [GroupMemberRow :. MaybeConnectionRow] -> IO [GroupMember]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (UserId, UserId, UserId, GroupMemberRole)
-> IO [GroupMemberRow :. MaybeConnectionRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      (Query
groupMemberQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE m.user_id = ? AND m.group_id = ? AND m.contact_id IS DISTINCT FROM ? AND m.member_role = ?")
      (UserId
userId, UserId
groupId, UserId
userContactId, GroupMemberRole
GRAdmin)

getGroupMembersForExpiration :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupMembersForExpiration :: Connection
-> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupMembersForExpiration Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId, UserId
userContactId :: User -> UserId
userContactId :: UserId
userContactId} GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} = do
  ((GroupMemberRow :. MaybeConnectionRow) -> GroupMember)
-> [GroupMemberRow :. MaybeConnectionRow] -> [GroupMember]
forall a b. (a -> b) -> [a] -> [b]
map (VersionRangeChat
-> User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember
toContactMember VersionRangeChat
vr User
user)
    ([GroupMemberRow :. MaybeConnectionRow] -> [GroupMember])
-> IO [GroupMemberRow :. MaybeConnectionRow] -> IO [GroupMember]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (UserId, UserId, UserId, GroupMemberStatus, GroupMemberStatus,
    GroupMemberStatus, GroupMemberStatus)
-> IO [GroupMemberRow :. MaybeConnectionRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      ( Query
groupMemberQuery
          Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" "
          Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> [sql|
                WHERE m.group_id = ? AND m.user_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?)
                  AND m.member_status IN (?, ?, ?, ?)
                  AND m.group_member_id NOT IN (
                    SELECT DISTINCT group_member_id FROM chat_items
                  )
              |]
      )
      (UserId
groupId, UserId
userId, UserId
userContactId, GroupMemberStatus
GSMemRemoved, GroupMemberStatus
GSMemLeft, GroupMemberStatus
GSMemGroupDeleted, GroupMemberStatus
GSMemUnknown)

getGroupCurrentMembersCount :: DB.Connection -> User -> GroupInfo -> IO Int
getGroupCurrentMembersCount :: Connection -> User -> GroupInfo -> IO Int
getGroupCurrentMembersCount Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} = do
  [GroupMemberStatus]
statuses :: [GroupMemberStatus] <-
    (Only GroupMemberStatus -> GroupMemberStatus)
-> [Only GroupMemberStatus] -> [GroupMemberStatus]
forall a b. (a -> b) -> [a] -> [b]
map Only GroupMemberStatus -> GroupMemberStatus
forall a. Only a -> a
fromOnly
      ([Only GroupMemberStatus] -> [GroupMemberStatus])
-> IO [Only GroupMemberStatus] -> IO [GroupMemberStatus]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query -> (UserId, UserId) -> IO [Only GroupMemberStatus]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT member_status
          FROM group_members
          WHERE group_id = ? AND user_id = ?
        |]
        (UserId
groupId, UserId
userId)
  Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ [GroupMemberStatus] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([GroupMemberStatus] -> Int) -> [GroupMemberStatus] -> Int
forall a b. (a -> b) -> a -> b
$ (GroupMemberStatus -> Bool)
-> [GroupMemberStatus] -> [GroupMemberStatus]
forall a. (a -> Bool) -> [a] -> [a]
filter GroupMemberStatus -> Bool
memberCurrent' [GroupMemberStatus]
statuses

getGroupInvitation :: DB.Connection -> VersionRangeChat -> User -> GroupId -> ExceptT StoreError IO ReceivedGroupInvitation
getGroupInvitation :: Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO ReceivedGroupInvitation
getGroupInvitation Connection
db VersionRangeChat
vr User
user UserId
groupId =
  User -> ExceptT StoreError IO (Maybe ConnReqInvitation)
getConnRec_ User
user ExceptT StoreError IO (Maybe ConnReqInvitation)
-> (Maybe ConnReqInvitation
    -> ExceptT StoreError IO ReceivedGroupInvitation)
-> ExceptT StoreError IO ReceivedGroupInvitation
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 ConnReqInvitation
connRequest -> do
      groupInfo :: GroupInfo
groupInfo@GroupInfo {GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} <- Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user UserId
groupId
      Bool -> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GroupMember -> GroupMemberStatus
memberStatus GroupMember
membership GroupMemberStatus -> GroupMemberStatus -> Bool
forall a. Eq a => a -> a -> Bool
/= GroupMemberStatus
GSMemInvited) (ExceptT StoreError IO () -> ExceptT StoreError IO ())
-> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ StoreError -> ExceptT StoreError IO ()
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError StoreError
SEGroupAlreadyJoined
      UserId
hostId <- Connection -> User -> UserId -> ExceptT StoreError IO UserId
getHostMemberId_ Connection
db User
user UserId
groupId
      GroupMember
fromMember <- Connection
-> VersionRangeChat
-> User
-> UserId
-> UserId
-> ExceptT StoreError IO GroupMember
getGroupMember Connection
db VersionRangeChat
vr User
user UserId
groupId UserId
hostId
      ReceivedGroupInvitation
-> ExceptT StoreError IO ReceivedGroupInvitation
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReceivedGroupInvitation {GroupMember
fromMember :: GroupMember
fromMember :: GroupMember
fromMember, ConnReqInvitation
connRequest :: ConnReqInvitation
connRequest :: ConnReqInvitation
connRequest, GroupInfo
groupInfo :: GroupInfo
groupInfo :: GroupInfo
groupInfo}
    Maybe ConnReqInvitation
_ -> StoreError -> ExceptT StoreError IO ReceivedGroupInvitation
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError StoreError
SEGroupInvitationNotFound
  where
    getConnRec_ :: User -> ExceptT StoreError IO (Maybe ConnReqInvitation)
    getConnRec_ :: User -> ExceptT StoreError IO (Maybe ConnReqInvitation)
getConnRec_ User {UserId
userId :: User -> UserId
userId :: UserId
userId} = IO (Either StoreError (Maybe ConnReqInvitation))
-> ExceptT StoreError IO (Maybe ConnReqInvitation)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (Maybe ConnReqInvitation))
 -> ExceptT StoreError IO (Maybe ConnReqInvitation))
-> IO (Either StoreError (Maybe ConnReqInvitation))
-> ExceptT StoreError IO (Maybe ConnReqInvitation)
forall a b. (a -> b) -> a -> b
$ do
      (Only (Maybe ConnReqInvitation) -> Maybe ConnReqInvitation)
-> StoreError
-> IO [Only (Maybe ConnReqInvitation)]
-> IO (Either StoreError (Maybe ConnReqInvitation))
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only (Maybe ConnReqInvitation) -> Maybe ConnReqInvitation
forall a. Only a -> a
fromOnly (UserId -> StoreError
SEGroupNotFound UserId
groupId) (IO [Only (Maybe ConnReqInvitation)]
 -> IO (Either StoreError (Maybe ConnReqInvitation)))
-> IO [Only (Maybe ConnReqInvitation)]
-> IO (Either StoreError (Maybe ConnReqInvitation))
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query -> (UserId, UserId) -> IO [Only (Maybe ConnReqInvitation)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT g.inv_queue_info FROM groups g WHERE g.group_id = ? AND g.user_id = ?" (UserId
groupId, UserId
userId)

createNewContactMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> Contact -> GroupMemberRole -> ConnId -> ConnReqInvitation -> SubscriptionMode -> ExceptT StoreError IO GroupMember
createNewContactMember :: Connection
-> TVar ChaChaDRG
-> User
-> GroupInfo
-> Contact
-> GroupMemberRole
-> ConnId
-> ConnReqInvitation
-> SubscriptionMode
-> ExceptT StoreError IO GroupMember
createNewContactMember Connection
_ TVar ChaChaDRG
_ User
_ GroupInfo
_ Contact {LocalAlias
localDisplayName :: Contact -> LocalAlias
localDisplayName :: LocalAlias
localDisplayName, activeConn :: Contact -> Maybe Connection
activeConn = Maybe Connection
Nothing} GroupMemberRole
_ ConnId
_ ConnReqInvitation
_ SubscriptionMode
_ = StoreError -> ExceptT StoreError IO GroupMember
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO GroupMember)
-> StoreError -> ExceptT StoreError IO GroupMember
forall a b. (a -> b) -> a -> b
$ LocalAlias -> StoreError
SEContactNotReady LocalAlias
localDisplayName
createNewContactMember Connection
db TVar ChaChaDRG
gVar User {UserId
userId :: User -> UserId
userId :: UserId
userId, UserId
userContactId :: User -> UserId
userContactId :: UserId
userContactId} GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId, GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} Contact {UserId
contactId :: Contact -> UserId
contactId :: UserId
contactId, LocalAlias
localDisplayName :: Contact -> LocalAlias
localDisplayName :: LocalAlias
localDisplayName, LocalProfile
profile :: Contact -> LocalProfile
profile :: LocalProfile
profile, activeConn :: Contact -> Maybe Connection
activeConn = Just Connection {VersionChat
connChatVersion :: VersionChat
connChatVersion :: Connection -> VersionChat
connChatVersion, VersionRangeChat
peerChatVRange :: Connection -> VersionRangeChat
peerChatVRange :: VersionRangeChat
peerChatVRange}} GroupMemberRole
memberRole ConnId
agentConnId ConnReqInvitation
connRequest SubscriptionMode
subMode =
  TVar ChaChaDRG
-> (ConnId -> IO (Either StoreError GroupMember))
-> ExceptT StoreError IO GroupMember
forall a.
TVar ChaChaDRG
-> (ConnId -> IO (Either StoreError a)) -> ExceptT StoreError IO a
createWithRandomId' TVar ChaChaDRG
gVar ((ConnId -> IO (Either StoreError GroupMember))
 -> ExceptT StoreError IO GroupMember)
-> (ConnId -> IO (Either StoreError GroupMember))
-> ExceptT StoreError IO GroupMember
forall a b. (a -> b) -> a -> b
$ \ConnId
memId -> ExceptT StoreError IO GroupMember
-> IO (Either StoreError GroupMember)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO GroupMember
 -> IO (Either StoreError GroupMember))
-> ExceptT StoreError IO GroupMember
-> IO (Either StoreError GroupMember)
forall a b. (a -> b) -> a -> b
$ do
    UTCTime
createdAt <- 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
    member :: GroupMember
member@GroupMember {UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId} <- MemberId -> UTCTime -> ExceptT StoreError IO GroupMember
createMember_ (ConnId -> MemberId
MemberId ConnId
memId) UTCTime
createdAt
    ExceptT StoreError IO Connection -> ExceptT StoreError IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT StoreError IO Connection -> ExceptT StoreError IO ())
-> ExceptT StoreError IO Connection -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ IO Connection -> ExceptT StoreError IO Connection
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Connection -> ExceptT StoreError IO Connection)
-> IO Connection -> ExceptT StoreError IO Connection
forall a b. (a -> b) -> a -> b
$ Connection
-> UserId
-> UserId
-> ConnId
-> VersionChat
-> VersionRangeChat
-> Maybe UserId
-> Int
-> UTCTime
-> SubscriptionMode
-> IO Connection
createMemberConnection_ Connection
db UserId
userId UserId
groupMemberId ConnId
agentConnId VersionChat
connChatVersion VersionRangeChat
peerChatVRange Maybe UserId
forall a. Maybe a
Nothing Int
0 UTCTime
createdAt SubscriptionMode
subMode
    GroupMember -> ExceptT StoreError IO GroupMember
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupMember
member
  where
    VersionRange VersionChat
minV VersionChat
maxV = VersionRangeChat
peerChatVRange
    invitedByGroupMemberId :: UserId
invitedByGroupMemberId = GroupMember -> UserId
groupMemberId' GroupMember
membership
    createMember_ :: MemberId -> UTCTime -> ExceptT StoreError IO GroupMember
createMember_ MemberId
memberId UTCTime
createdAt = do
      UserId
indexInGroup <- ExceptT StoreError IO UserId
insertMember_
      UserId
groupMemberId <- IO UserId -> ExceptT StoreError IO UserId
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserId -> ExceptT StoreError IO UserId)
-> IO UserId -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$ Connection -> IO UserId
insertedRowId Connection
db
      GroupMember -> ExceptT StoreError IO GroupMember
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        GroupMember
          { UserId
groupMemberId :: UserId
groupMemberId :: UserId
groupMemberId,
            UserId
groupId :: UserId
groupId :: UserId
groupId,
            UserId
indexInGroup :: UserId
indexInGroup :: UserId
indexInGroup,
            MemberId
memberId :: MemberId
memberId :: MemberId
memberId,
            GroupMemberRole
memberRole :: GroupMemberRole
memberRole :: GroupMemberRole
memberRole,
            memberCategory :: GroupMemberCategory
memberCategory = GroupMemberCategory
GCInviteeMember,
            memberStatus :: GroupMemberStatus
memberStatus = GroupMemberStatus
GSMemInvited,
            memberSettings :: GroupMemberSettings
memberSettings = GroupMemberSettings
defaultMemberSettings,
            blockedByAdmin :: Bool
blockedByAdmin = Bool
False,
            invitedBy :: InvitedBy
invitedBy = InvitedBy
IBUser,
            invitedByGroupMemberId :: Maybe UserId
invitedByGroupMemberId = UserId -> Maybe UserId
forall a. a -> Maybe a
Just UserId
invitedByGroupMemberId,
            LocalAlias
localDisplayName :: LocalAlias
localDisplayName :: LocalAlias
localDisplayName,
            memberProfile :: LocalProfile
memberProfile = LocalProfile
profile,
            memberContactId :: Maybe UserId
memberContactId = UserId -> Maybe UserId
forall a. a -> Maybe a
Just UserId
contactId,
            memberContactProfileId :: UserId
memberContactProfileId = LocalProfile -> UserId
localProfileId LocalProfile
profile,
            activeConn :: Maybe Connection
activeConn = Maybe Connection
forall a. Maybe a
Nothing,
            memberChatVRange :: VersionRangeChat
memberChatVRange = VersionRangeChat
peerChatVRange,
            UTCTime
createdAt :: UTCTime
createdAt :: UTCTime
createdAt,
            updatedAt :: UTCTime
updatedAt = UTCTime
createdAt,
            supportChat :: Maybe GroupSupportChat
supportChat = Maybe GroupSupportChat
forall a. Maybe a
Nothing
          }
      where
        insertMember_ :: ExceptT StoreError IO UserId
insertMember_ = do
          UserId
indexInGroup <- Connection -> UserId -> ExceptT StoreError IO UserId
getUpdateNextIndexInGroup_ Connection
db UserId
groupId
          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
-> ((UserId, UserId, MemberId, GroupMemberRole,
     GroupMemberCategory, GroupMemberStatus, Binary ConnId,
     Maybe UserId, UserId)
    :. ((UserId, LocalAlias, UserId, UserId, ConnReqInvitation,
         UTCTime, UTCTime)
        :. (VersionChat, VersionChat)))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
              Connection
db
              [sql|
                INSERT INTO group_members
                  ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by, invited_by_group_member_id,
                    user_id, local_display_name, contact_id, contact_profile_id, sent_inv_queue_info, created_at, updated_at,
                    peer_chat_min_version, peer_chat_max_version)
                VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
              |]
              ( (UserId
groupId, UserId
indexInGroup, MemberId
memberId, GroupMemberRole
memberRole, GroupMemberCategory
GCInviteeMember, GroupMemberStatus
GSMemInvited, ConnId -> Binary ConnId
forall a. a -> Binary a
Binary ConnId
B.empty, UserId -> InvitedBy -> Maybe UserId
fromInvitedBy UserId
userContactId InvitedBy
IBUser, UserId
invitedByGroupMemberId)
                  (UserId, UserId, MemberId, GroupMemberRole, GroupMemberCategory,
 GroupMemberStatus, Binary ConnId, Maybe UserId, UserId)
-> ((UserId, LocalAlias, UserId, UserId, ConnReqInvitation,
     UTCTime, UTCTime)
    :. (VersionChat, VersionChat))
-> (UserId, UserId, MemberId, GroupMemberRole, GroupMemberCategory,
    GroupMemberStatus, Binary ConnId, Maybe UserId, UserId)
   :. ((UserId, LocalAlias, UserId, UserId, ConnReqInvitation,
        UTCTime, UTCTime)
       :. (VersionChat, VersionChat))
forall h t. h -> t -> h :. t
:. (UserId
userId, LocalAlias
localDisplayName, UserId
contactId, LocalProfile -> UserId
localProfileId LocalProfile
profile, ConnReqInvitation
connRequest, UTCTime
createdAt, UTCTime
createdAt)
                  (UserId, LocalAlias, UserId, UserId, ConnReqInvitation, UTCTime,
 UTCTime)
-> (VersionChat, VersionChat)
-> (UserId, LocalAlias, UserId, UserId, ConnReqInvitation, UTCTime,
    UTCTime)
   :. (VersionChat, VersionChat)
forall h t. h -> t -> h :. t
:. (VersionChat
minV, VersionChat
maxV)
              )
          UserId -> ExceptT StoreError IO UserId
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UserId
indexInGroup

createNewContactMemberAsync :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> Contact -> GroupMemberRole -> (CommandId, ConnId) -> VersionChat -> VersionRangeChat -> SubscriptionMode -> ExceptT StoreError IO ()
createNewContactMemberAsync :: Connection
-> TVar ChaChaDRG
-> User
-> GroupInfo
-> Contact
-> GroupMemberRole
-> (UserId, ConnId)
-> VersionChat
-> VersionRangeChat
-> SubscriptionMode
-> ExceptT StoreError IO ()
createNewContactMemberAsync Connection
db TVar ChaChaDRG
gVar user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId, UserId
userContactId :: User -> UserId
userContactId :: UserId
userContactId} GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId, GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} Contact {UserId
contactId :: Contact -> UserId
contactId :: UserId
contactId, LocalAlias
localDisplayName :: Contact -> LocalAlias
localDisplayName :: LocalAlias
localDisplayName, LocalProfile
profile :: Contact -> LocalProfile
profile :: LocalProfile
profile} GroupMemberRole
memberRole (UserId
cmdId, ConnId
agentConnId) VersionChat
chatV VersionRangeChat
peerChatVRange SubscriptionMode
subMode =
  TVar ChaChaDRG
-> (ConnId -> IO (Either StoreError ()))
-> ExceptT StoreError IO ()
forall a.
TVar ChaChaDRG
-> (ConnId -> IO (Either StoreError a)) -> ExceptT StoreError IO a
createWithRandomId' TVar ChaChaDRG
gVar ((ConnId -> IO (Either StoreError ())) -> ExceptT StoreError IO ())
-> (ConnId -> IO (Either StoreError ()))
-> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ \ConnId
memId -> ExceptT StoreError IO () -> IO (Either StoreError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO () -> IO (Either StoreError ()))
-> ExceptT StoreError IO () -> IO (Either StoreError ())
forall a b. (a -> b) -> a -> b
$ do
    UTCTime
createdAt <- 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
    MemberId -> UTCTime -> ExceptT StoreError IO ()
forall {c} {f}.
(ToField c, ToField f) =>
c -> f -> ExceptT StoreError IO ()
insertMember_ (ConnId -> MemberId
MemberId ConnId
memId) UTCTime
createdAt
    UserId
groupMemberId <- IO UserId -> ExceptT StoreError IO UserId
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserId -> ExceptT StoreError IO UserId)
-> IO UserId -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$ Connection -> IO UserId
insertedRowId Connection
db
    Connection {UserId
connId :: Connection -> UserId
connId :: UserId
connId} <- IO Connection -> ExceptT StoreError IO Connection
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Connection -> ExceptT StoreError IO Connection)
-> IO Connection -> ExceptT StoreError IO Connection
forall a b. (a -> b) -> a -> b
$ Connection
-> UserId
-> UserId
-> ConnId
-> VersionChat
-> VersionRangeChat
-> Maybe UserId
-> Int
-> UTCTime
-> SubscriptionMode
-> IO Connection
createMemberConnection_ Connection
db UserId
userId UserId
groupMemberId ConnId
agentConnId VersionChat
chatV VersionRangeChat
peerChatVRange Maybe UserId
forall a. Maybe a
Nothing Int
0 UTCTime
createdAt SubscriptionMode
subMode
    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 -> User -> UserId -> UserId -> IO ()
setCommandConnId Connection
db User
user UserId
cmdId UserId
connId
  where
    VersionRange VersionChat
minV VersionChat
maxV = VersionRangeChat
peerChatVRange
    insertMember_ :: c -> f -> ExceptT StoreError IO ()
insertMember_ c
memberId f
createdAt = do
      UserId
indexInGroup <- Connection -> UserId -> ExceptT StoreError IO UserId
getUpdateNextIndexInGroup_ Connection
db UserId
groupId
      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
-> ((UserId, UserId, c, GroupMemberRole, GroupMemberCategory,
     GroupMemberStatus, Binary ConnId, Maybe UserId, UserId)
    :. ((UserId, LocalAlias, UserId, UserId, f, f)
        :. (VersionChat, VersionChat)))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
          Connection
db
          [sql|
            INSERT INTO group_members
              ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by, invited_by_group_member_id,
                user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
                peer_chat_min_version, peer_chat_max_version)
            VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
          |]
          ( (UserId
groupId, UserId
indexInGroup, c
memberId, GroupMemberRole
memberRole, GroupMemberCategory
GCInviteeMember, GroupMemberStatus
GSMemInvited, ConnId -> Binary ConnId
forall a. a -> Binary a
Binary ConnId
B.empty, UserId -> InvitedBy -> Maybe UserId
fromInvitedBy UserId
userContactId InvitedBy
IBUser, GroupMember -> UserId
groupMemberId' GroupMember
membership)
              (UserId, UserId, c, GroupMemberRole, GroupMemberCategory,
 GroupMemberStatus, Binary ConnId, Maybe UserId, UserId)
-> ((UserId, LocalAlias, UserId, UserId, f, f)
    :. (VersionChat, VersionChat))
-> (UserId, UserId, c, GroupMemberRole, GroupMemberCategory,
    GroupMemberStatus, Binary ConnId, Maybe UserId, UserId)
   :. ((UserId, LocalAlias, UserId, UserId, f, f)
       :. (VersionChat, VersionChat))
forall h t. h -> t -> h :. t
:. (UserId
userId, LocalAlias
localDisplayName, UserId
contactId, LocalProfile -> UserId
localProfileId LocalProfile
profile, f
createdAt, f
createdAt)
              (UserId, LocalAlias, UserId, UserId, f, f)
-> (VersionChat, VersionChat)
-> (UserId, LocalAlias, UserId, UserId, f, f)
   :. (VersionChat, VersionChat)
forall h t. h -> t -> h :. t
:. (VersionChat
minV, VersionChat
maxV)
          )

createJoiningMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe SharedMsgId -> GroupMemberRole -> GroupMemberStatus -> ExceptT StoreError IO (GroupMemberId, MemberId)
createJoiningMember :: Connection
-> TVar ChaChaDRG
-> User
-> GroupInfo
-> VersionRangeChat
-> Profile
-> Maybe XContactId
-> Maybe SharedMsgId
-> GroupMemberRole
-> GroupMemberStatus
-> ExceptT StoreError IO (UserId, MemberId)
createJoiningMember
  Connection
db
  TVar ChaChaDRG
gVar
  User {UserId
userId :: User -> UserId
userId :: UserId
userId, UserId
userContactId :: User -> UserId
userContactId :: UserId
userContactId}
  GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId, GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership}
  VersionRangeChat
cReqChatVRange
  Profile {LocalAlias
displayName :: LocalAlias
displayName :: Profile -> LocalAlias
displayName, LocalAlias
fullName :: LocalAlias
fullName :: Profile -> LocalAlias
fullName, Maybe LocalAlias
shortDescr :: Maybe LocalAlias
shortDescr :: Profile -> Maybe LocalAlias
shortDescr, Maybe ImageData
image :: Maybe ImageData
image :: Profile -> Maybe ImageData
image, Maybe ConnLinkContact
contactLink :: Maybe ConnLinkContact
contactLink :: Profile -> Maybe ConnLinkContact
contactLink, Maybe Preferences
preferences :: Maybe Preferences
preferences :: Profile -> Maybe Preferences
preferences}
  Maybe XContactId
cReqXContactId_
  Maybe SharedMsgId
welcomeMsgId_
  GroupMemberRole
memberRole
  GroupMemberStatus
memberStatus = do
    UTCTime
currentTs <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    IO (Either StoreError (UserId, MemberId))
-> ExceptT StoreError IO (UserId, MemberId)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (UserId, MemberId))
 -> ExceptT StoreError IO (UserId, MemberId))
-> ((LocalAlias -> IO (Either StoreError (UserId, MemberId)))
    -> IO (Either StoreError (UserId, MemberId)))
-> (LocalAlias -> IO (Either StoreError (UserId, MemberId)))
-> ExceptT StoreError IO (UserId, MemberId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError (UserId, MemberId)))
-> IO (Either StoreError (UserId, MemberId))
forall a.
Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError a))
-> IO (Either StoreError a)
withLocalDisplayName Connection
db UserId
userId LocalAlias
displayName ((LocalAlias -> IO (Either StoreError (UserId, MemberId)))
 -> ExceptT StoreError IO (UserId, MemberId))
-> (LocalAlias -> IO (Either StoreError (UserId, MemberId)))
-> ExceptT StoreError IO (UserId, MemberId)
forall a b. (a -> b) -> a -> b
$ \LocalAlias
ldn -> ExceptT StoreError IO (UserId, MemberId)
-> IO (Either StoreError (UserId, MemberId))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO (UserId, MemberId)
 -> IO (Either StoreError (UserId, MemberId)))
-> ExceptT StoreError IO (UserId, MemberId)
-> IO (Either StoreError (UserId, MemberId))
forall a b. (a -> b) -> a -> b
$ do
      IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> (LocalAlias, LocalAlias, Maybe LocalAlias, Maybe ImageData,
    Maybe ConnLinkContact, UserId, Maybe Preferences, UTCTime, UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
          Connection
db
          Query
"INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
          (LocalAlias
displayName, LocalAlias
fullName, Maybe LocalAlias
shortDescr, Maybe ImageData
image, Maybe ConnLinkContact
contactLink, UserId
userId, Maybe Preferences
preferences, UTCTime
currentTs, UTCTime
currentTs)
      UserId
profileId <- IO UserId -> ExceptT StoreError IO UserId
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserId -> ExceptT StoreError IO UserId)
-> IO UserId -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$ Connection -> IO UserId
insertedRowId Connection
db
      TVar ChaChaDRG
-> (ConnId -> IO (Either StoreError (UserId, MemberId)))
-> ExceptT StoreError IO (UserId, MemberId)
forall a.
TVar ChaChaDRG
-> (ConnId -> IO (Either StoreError a)) -> ExceptT StoreError IO a
createWithRandomId' TVar ChaChaDRG
gVar ((ConnId -> IO (Either StoreError (UserId, MemberId)))
 -> ExceptT StoreError IO (UserId, MemberId))
-> (ConnId -> IO (Either StoreError (UserId, MemberId)))
-> ExceptT StoreError IO (UserId, MemberId)
forall a b. (a -> b) -> a -> b
$ \ConnId
memId -> ExceptT StoreError IO (UserId, MemberId)
-> IO (Either StoreError (UserId, MemberId))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO (UserId, MemberId)
 -> IO (Either StoreError (UserId, MemberId)))
-> ExceptT StoreError IO (UserId, MemberId)
-> IO (Either StoreError (UserId, MemberId))
forall a b. (a -> b) -> a -> b
$ do
        LocalAlias
-> UserId -> MemberId -> UTCTime -> ExceptT StoreError IO ()
forall {c} {b} {d} {h}.
(ToField c, ToField b, ToField d, ToField h) =>
b -> d -> c -> h -> ExceptT StoreError IO ()
insertMember_ LocalAlias
ldn UserId
profileId (ConnId -> MemberId
MemberId ConnId
memId) UTCTime
currentTs
        UserId
groupMemberId <- IO UserId -> ExceptT StoreError IO UserId
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserId -> ExceptT StoreError IO UserId)
-> IO UserId -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$ Connection -> IO UserId
insertedRowId Connection
db
        (UserId, MemberId) -> ExceptT StoreError IO (UserId, MemberId)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserId
groupMemberId, ConnId -> MemberId
MemberId ConnId
memId)
    where
      VersionRange VersionChat
minV VersionChat
maxV = VersionRangeChat
cReqChatVRange
      insertMember_ :: b -> d -> c -> h -> ExceptT StoreError IO ()
insertMember_ b
ldn d
profileId c
memberId h
currentTs = do
        UserId
indexInGroup <- Connection -> UserId -> ExceptT StoreError IO UserId
getUpdateNextIndexInGroup_ Connection
db UserId
groupId
        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
-> ((UserId, UserId, c, GroupMemberRole, GroupMemberCategory,
     GroupMemberStatus, Binary ConnId, Maybe UserId, UserId)
    :. ((UserId, b, Maybe UserId, d, Maybe XContactId,
         Maybe SharedMsgId, h, h)
        :. (VersionChat, VersionChat)))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
            Connection
db
            [sql|
              INSERT INTO group_members
                ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by, invited_by_group_member_id,
                  user_id, local_display_name, contact_id, contact_profile_id, member_xcontact_id, member_welcome_shared_msg_id, created_at, updated_at,
                  peer_chat_min_version, peer_chat_max_version)
              VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
            |]
            ( (UserId
groupId, UserId
indexInGroup, c
memberId, GroupMemberRole
memberRole, GroupMemberCategory
GCInviteeMember, GroupMemberStatus
memberStatus, ConnId -> Binary ConnId
forall a. a -> Binary a
Binary ConnId
B.empty, UserId -> InvitedBy -> Maybe UserId
fromInvitedBy UserId
userContactId InvitedBy
IBUser, GroupMember -> UserId
groupMemberId' GroupMember
membership)
                (UserId, UserId, c, GroupMemberRole, GroupMemberCategory,
 GroupMemberStatus, Binary ConnId, Maybe UserId, UserId)
-> ((UserId, b, Maybe UserId, d, Maybe XContactId,
     Maybe SharedMsgId, h, h)
    :. (VersionChat, VersionChat))
-> (UserId, UserId, c, GroupMemberRole, GroupMemberCategory,
    GroupMemberStatus, Binary ConnId, Maybe UserId, UserId)
   :. ((UserId, b, Maybe UserId, d, Maybe XContactId,
        Maybe SharedMsgId, h, h)
       :. (VersionChat, VersionChat))
forall h t. h -> t -> h :. t
:. (UserId
userId, b
ldn, Maybe UserId
forall a. Maybe a
Nothing :: (Maybe Int64), d
profileId, Maybe XContactId
cReqXContactId_, Maybe SharedMsgId
welcomeMsgId_, h
currentTs, h
currentTs)
                (UserId, b, Maybe UserId, d, Maybe XContactId, Maybe SharedMsgId,
 h, h)
-> (VersionChat, VersionChat)
-> (UserId, b, Maybe UserId, d, Maybe XContactId,
    Maybe SharedMsgId, h, h)
   :. (VersionChat, VersionChat)
forall h t. h -> t -> h :. t
:. (VersionChat
minV, VersionChat
maxV)
            )

getMemberJoinRequest :: DB.Connection -> User -> GroupInfo -> GroupMember -> IO (Maybe (Maybe XContactId, Maybe SharedMsgId))
getMemberJoinRequest :: Connection
-> User
-> GroupInfo
-> GroupMember
-> IO (Maybe (Maybe XContactId, Maybe SharedMsgId))
getMemberJoinRequest Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} GroupMember {groupMemberId :: GroupMember -> UserId
groupMemberId = UserId
mId} =
  ((Maybe XContactId, Maybe SharedMsgId)
 -> (Maybe XContactId, Maybe SharedMsgId))
-> IO [(Maybe XContactId, Maybe SharedMsgId)]
-> IO (Maybe (Maybe XContactId, Maybe SharedMsgId))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow (Maybe XContactId, Maybe SharedMsgId)
-> (Maybe XContactId, Maybe SharedMsgId)
forall a. a -> a
id (IO [(Maybe XContactId, Maybe SharedMsgId)]
 -> IO (Maybe (Maybe XContactId, Maybe SharedMsgId)))
-> IO [(Maybe XContactId, Maybe SharedMsgId)]
-> IO (Maybe (Maybe XContactId, Maybe SharedMsgId))
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (UserId, UserId, UserId)
-> IO [(Maybe XContactId, Maybe SharedMsgId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT member_xcontact_id, member_welcome_shared_msg_id FROM group_members WHERE user_id = ? AND group_id = ? AND group_member_id = ?" (UserId
userId, UserId
groupId, UserId
mId)

createJoiningMemberConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> VersionChat -> VersionRangeChat -> GroupMemberId -> SubscriptionMode -> IO ()
createJoiningMemberConnection :: Connection
-> User
-> UserId
-> (UserId, ConnId)
-> VersionChat
-> VersionRangeChat
-> UserId
-> SubscriptionMode
-> IO ()
createJoiningMemberConnection
  Connection
db
  user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId}
  UserId
uclId
  (UserId
cmdId, ConnId
agentConnId)
  VersionChat
chatV
  VersionRangeChat
cReqChatVRange
  UserId
groupMemberId
  SubscriptionMode
subMode = do
    UTCTime
createdAt <- IO UTCTime -> IO UTCTime
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    Connection {UserId
connId :: Connection -> UserId
connId :: UserId
connId} <- Connection
-> UserId
-> ConnType
-> Maybe UserId
-> ConnId
-> ConnStatus
-> VersionChat
-> VersionRangeChat
-> Maybe UserId
-> Maybe UserId
-> Maybe UserId
-> Int
-> UTCTime
-> SubscriptionMode
-> PQSupport
-> IO Connection
createConnection_ Connection
db UserId
userId ConnType
ConnMember (UserId -> Maybe UserId
forall a. a -> Maybe a
Just UserId
groupMemberId) ConnId
agentConnId ConnStatus
ConnNew VersionChat
chatV VersionRangeChat
cReqChatVRange Maybe UserId
forall a. Maybe a
Nothing (UserId -> Maybe UserId
forall a. a -> Maybe a
Just UserId
uclId) Maybe UserId
forall a. Maybe a
Nothing Int
0 UTCTime
createdAt SubscriptionMode
subMode PQSupport
PQSupportOff
    Connection -> User -> UserId -> UserId -> IO ()
setCommandConnId Connection
db User
user UserId
cmdId UserId
connId

createBusinessRequestGroup :: DB.Connection -> VersionRangeChat -> TVar ChaChaDRG -> User -> VersionRangeChat -> Profile -> Int64 -> Text -> GroupPreferences -> ExceptT StoreError IO (GroupInfo, GroupMember)
createBusinessRequestGroup :: Connection
-> VersionRangeChat
-> TVar ChaChaDRG
-> User
-> VersionRangeChat
-> Profile
-> UserId
-> LocalAlias
-> GroupPreferences
-> ExceptT StoreError IO (GroupInfo, GroupMember)
createBusinessRequestGroup
  Connection
db
  VersionRangeChat
vr
  TVar ChaChaDRG
gVar
  user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId, UserId
userContactId :: User -> UserId
userContactId :: UserId
userContactId}
  VersionRangeChat
cReqChatVRange
  Profile {LocalAlias
displayName :: Profile -> LocalAlias
displayName :: LocalAlias
displayName, LocalAlias
fullName :: Profile -> LocalAlias
fullName :: LocalAlias
fullName, Maybe LocalAlias
shortDescr :: Profile -> Maybe LocalAlias
shortDescr :: Maybe LocalAlias
shortDescr, Maybe ImageData
image :: Profile -> Maybe ImageData
image :: Maybe ImageData
image}
  UserId
profileId -- contact request profile id, to be used for member profile
  LocalAlias
ldn -- contact request local display name, to be used for group local display name
  GroupPreferences
groupPreferences = 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
    (UserId
groupId, membership :: GroupMember
membership@GroupMember {memberId :: GroupMember -> MemberId
memberId = MemberId
userMemberId}) <- UTCTime -> ExceptT StoreError IO (UserId, GroupMember)
insertGroup_ UTCTime
currentTs
    (UserId
groupMemberId, MemberId
memberId) <- UTCTime
-> UserId
-> GroupMember
-> ExceptT StoreError IO (UserId, MemberId)
forall {f}.
ToField f =>
f
-> UserId
-> GroupMember
-> ExceptT StoreError IO (UserId, MemberId)
insertClientMember_ UTCTime
currentTs UserId
groupId GroupMember
membership
    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 -> (MemberId, MemberId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE groups SET business_member_id = ?, customer_member_id = ? WHERE group_id = ?" (MemberId
userMemberId, MemberId
memberId, UserId
groupId)
    GroupInfo
groupInfo <- Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user UserId
groupId
    GroupMember
clientMember <- Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupMember
getGroupMemberById Connection
db VersionRangeChat
vr User
user UserId
groupMemberId
    (GroupInfo, GroupMember)
-> ExceptT StoreError IO (GroupInfo, GroupMember)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupInfo
groupInfo, GroupMember
clientMember)
    where
      insertGroup_ :: UTCTime -> ExceptT StoreError IO (UserId, GroupMember)
insertGroup_ UTCTime
currentTs = do
        IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
          Connection
-> Query
-> (LocalAlias, LocalAlias, Maybe LocalAlias, Maybe ImageData,
    UserId, GroupPreferences, UTCTime, UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
            Connection
db
            Query
"INSERT INTO group_profiles (display_name, full_name, short_descr, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
            (LocalAlias
displayName, LocalAlias
fullName, Maybe LocalAlias
shortDescr, Maybe ImageData
image, UserId
userId, GroupPreferences
groupPreferences, UTCTime
currentTs, UTCTime
currentTs)
        UserId
groupProfileId <- IO UserId -> ExceptT StoreError IO UserId
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserId -> ExceptT StoreError IO UserId)
-> IO UserId -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$ Connection -> IO UserId
insertedRowId Connection
db
        IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
          Connection
-> Query
-> (UserId, LocalAlias, UserId, BoolInt, UTCTime, UTCTime, UTCTime,
    UTCTime, BusinessChatType)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
            Connection
db
            [sql|
              INSERT INTO groups
                (group_profile_id, local_display_name, user_id, enable_ntfs,
                  created_at, updated_at, chat_ts, user_member_profile_sent_at, business_chat)
              VALUES (?,?,?,?,?,?,?,?,?)
            |]
            (UserId
groupProfileId, LocalAlias
ldn, UserId
userId, Bool -> BoolInt
BI Bool
True, UTCTime
currentTs, UTCTime
currentTs, UTCTime
currentTs, UTCTime
currentTs, BusinessChatType
BCCustomer)
        UserId
groupId <- IO UserId -> ExceptT StoreError IO UserId
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserId -> ExceptT StoreError IO UserId)
-> IO UserId -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$ Connection -> IO UserId
insertedRowId Connection
db
        ConnId
memberId <- IO ConnId -> ExceptT StoreError IO ConnId
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ConnId -> ExceptT StoreError IO ConnId)
-> IO ConnId -> ExceptT StoreError IO ConnId
forall a b. (a -> b) -> a -> b
$ TVar ChaChaDRG -> Int -> IO ConnId
encodedRandomBytes TVar ChaChaDRG
gVar Int
12
        GroupMember
membership <- Connection
-> User
-> UserId
-> Maybe UserId
-> User
-> MemberIdRole
-> GroupMemberCategory
-> GroupMemberStatus
-> InvitedBy
-> Maybe UserId
-> UTCTime
-> VersionRangeChat
-> ExceptT StoreError IO GroupMember
forall a.
IsContact a =>
Connection
-> User
-> UserId
-> Maybe UserId
-> a
-> MemberIdRole
-> GroupMemberCategory
-> GroupMemberStatus
-> InvitedBy
-> Maybe UserId
-> UTCTime
-> VersionRangeChat
-> ExceptT StoreError IO GroupMember
createContactMemberInv_ Connection
db User
user UserId
groupId Maybe UserId
forall a. Maybe a
Nothing User
user (MemberId -> GroupMemberRole -> MemberIdRole
MemberIdRole (ConnId -> MemberId
MemberId ConnId
memberId) GroupMemberRole
GROwner) GroupMemberCategory
GCUserMember GroupMemberStatus
GSMemCreator InvitedBy
IBUser Maybe UserId
forall a. Maybe a
Nothing UTCTime
currentTs VersionRangeChat
vr
        (UserId, GroupMember)
-> ExceptT StoreError IO (UserId, GroupMember)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserId
groupId, GroupMember
membership)
      VersionRange VersionChat
minV VersionChat
maxV = VersionRangeChat
cReqChatVRange
      insertClientMember_ :: f
-> UserId
-> GroupMember
-> ExceptT StoreError IO (UserId, MemberId)
insertClientMember_ f
currentTs UserId
groupId GroupMember
membership =
        IO (Either StoreError (UserId, MemberId))
-> ExceptT StoreError IO (UserId, MemberId)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (UserId, MemberId))
 -> ExceptT StoreError IO (UserId, MemberId))
-> ((LocalAlias -> IO (Either StoreError (UserId, MemberId)))
    -> IO (Either StoreError (UserId, MemberId)))
-> (LocalAlias -> IO (Either StoreError (UserId, MemberId)))
-> ExceptT StoreError IO (UserId, MemberId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError (UserId, MemberId)))
-> IO (Either StoreError (UserId, MemberId))
forall a.
Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError a))
-> IO (Either StoreError a)
withLocalDisplayName Connection
db UserId
userId LocalAlias
displayName ((LocalAlias -> IO (Either StoreError (UserId, MemberId)))
 -> ExceptT StoreError IO (UserId, MemberId))
-> (LocalAlias -> IO (Either StoreError (UserId, MemberId)))
-> ExceptT StoreError IO (UserId, MemberId)
forall a b. (a -> b) -> a -> b
$ \LocalAlias
localDisplayName -> ExceptT StoreError IO (UserId, MemberId)
-> IO (Either StoreError (UserId, MemberId))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO (UserId, MemberId)
 -> IO (Either StoreError (UserId, MemberId)))
-> ExceptT StoreError IO (UserId, MemberId)
-> IO (Either StoreError (UserId, MemberId))
forall a b. (a -> b) -> a -> b
$ do
          TVar ChaChaDRG
-> (ConnId -> IO (Either StoreError (UserId, MemberId)))
-> ExceptT StoreError IO (UserId, MemberId)
forall a.
TVar ChaChaDRG
-> (ConnId -> IO (Either StoreError a)) -> ExceptT StoreError IO a
createWithRandomId' TVar ChaChaDRG
gVar ((ConnId -> IO (Either StoreError (UserId, MemberId)))
 -> ExceptT StoreError IO (UserId, MemberId))
-> (ConnId -> IO (Either StoreError (UserId, MemberId)))
-> ExceptT StoreError IO (UserId, MemberId)
forall a b. (a -> b) -> a -> b
$ \ConnId
memId -> ExceptT StoreError IO (UserId, MemberId)
-> IO (Either StoreError (UserId, MemberId))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO (UserId, MemberId)
 -> IO (Either StoreError (UserId, MemberId)))
-> ExceptT StoreError IO (UserId, MemberId)
-> IO (Either StoreError (UserId, MemberId))
forall a b. (a -> b) -> a -> b
$ do
            UserId
indexInGroup <- Connection -> UserId -> ExceptT StoreError IO UserId
getUpdateNextIndexInGroup_ Connection
db UserId
groupId
            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
-> ((UserId, UserId, MemberId, GroupMemberRole,
     GroupMemberCategory, GroupMemberStatus, Binary ConnId,
     Maybe UserId, UserId)
    :. ((UserId, LocalAlias, Maybe UserId, UserId, f, f)
        :. (VersionChat, VersionChat)))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
                Connection
db
                [sql|
                  INSERT INTO group_members
                    ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by, invited_by_group_member_id,
                      user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
                      peer_chat_min_version, peer_chat_max_version)
                  VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
                |]
                ( (UserId
groupId, UserId
indexInGroup, ConnId -> MemberId
MemberId ConnId
memId, GroupMemberRole
GRMember, GroupMemberCategory
GCInviteeMember, GroupMemberStatus
GSMemAccepted, ConnId -> Binary ConnId
forall a. a -> Binary a
Binary ConnId
B.empty, UserId -> InvitedBy -> Maybe UserId
fromInvitedBy UserId
userContactId InvitedBy
IBUser, GroupMember -> UserId
groupMemberId' GroupMember
membership)
                    (UserId, UserId, MemberId, GroupMemberRole, GroupMemberCategory,
 GroupMemberStatus, Binary ConnId, Maybe UserId, UserId)
-> ((UserId, LocalAlias, Maybe UserId, UserId, f, f)
    :. (VersionChat, VersionChat))
-> (UserId, UserId, MemberId, GroupMemberRole, GroupMemberCategory,
    GroupMemberStatus, Binary ConnId, Maybe UserId, UserId)
   :. ((UserId, LocalAlias, Maybe UserId, UserId, f, f)
       :. (VersionChat, VersionChat))
forall h t. h -> t -> h :. t
:. (UserId
userId, LocalAlias
localDisplayName, Maybe UserId
forall a. Maybe a
Nothing :: (Maybe Int64), UserId
profileId, f
currentTs, f
currentTs)
                    (UserId, LocalAlias, Maybe UserId, UserId, f, f)
-> (VersionChat, VersionChat)
-> (UserId, LocalAlias, Maybe UserId, UserId, f, f)
   :. (VersionChat, VersionChat)
forall h t. h -> t -> h :. t
:. (VersionChat
minV, VersionChat
maxV)
                )
            UserId
groupMemberId <- IO UserId -> ExceptT StoreError IO UserId
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserId -> ExceptT StoreError IO UserId)
-> IO UserId -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$ Connection -> IO UserId
insertedRowId Connection
db
            (UserId, MemberId) -> ExceptT StoreError IO (UserId, MemberId)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserId
groupMemberId, ConnId -> MemberId
MemberId ConnId
memId)

getContactViaMember :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> ExceptT StoreError IO Contact
getContactViaMember :: Connection
-> VersionRangeChat
-> User
-> GroupMember
-> ExceptT StoreError IO Contact
getContactViaMember Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupMember {UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId} = do
  UserId
contactId <-
    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 (Either StoreError UserId) -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$
      (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 (UserId -> StoreError
SEContactNotFoundByMemberId UserId
groupMemberId) (IO [Only UserId] -> IO (Either StoreError UserId))
-> IO [Only UserId] -> IO (Either StoreError UserId)
forall a b. (a -> b) -> a -> b
$
        Connection -> Query -> (UserId, UserId) -> IO [Only UserId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT ct.contact_id
            FROM group_members m
            JOIN contacts ct ON ct.contact_id = m.contact_id
            WHERE m.user_id = ? AND m.group_member_id = ? AND ct.deleted = 0
            LIMIT 1
          |]
          (UserId
userId, UserId
groupMemberId)
  Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user UserId
contactId

setNewContactMemberConnRequest :: DB.Connection -> User -> GroupMember -> ConnReqInvitation -> IO ()
setNewContactMemberConnRequest :: Connection -> User -> GroupMember -> ConnReqInvitation -> IO ()
setNewContactMemberConnRequest Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupMember {UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId} ConnReqInvitation
connRequest = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection
-> Query -> (ConnReqInvitation, UTCTime, UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE group_members SET sent_inv_queue_info = ?, updated_at = ? WHERE user_id = ? AND group_member_id = ?" (ConnReqInvitation
connRequest, UTCTime
currentTs, UserId
userId, UserId
groupMemberId)

getMemberInvitation :: DB.Connection -> User -> Int64 -> IO (Maybe ConnReqInvitation)
getMemberInvitation :: Connection -> User -> UserId -> IO (Maybe ConnReqInvitation)
getMemberInvitation Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} UserId
groupMemberId =
  (Maybe (Maybe ConnReqInvitation) -> Maybe ConnReqInvitation)
-> IO (Maybe (Maybe ConnReqInvitation))
-> IO (Maybe ConnReqInvitation)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe ConnReqInvitation) -> Maybe ConnReqInvitation
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (Maybe (Maybe ConnReqInvitation))
 -> IO (Maybe ConnReqInvitation))
-> (IO [Only (Maybe ConnReqInvitation)]
    -> IO (Maybe (Maybe ConnReqInvitation)))
-> IO [Only (Maybe ConnReqInvitation)]
-> IO (Maybe ConnReqInvitation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only (Maybe ConnReqInvitation) -> Maybe ConnReqInvitation)
-> IO [Only (Maybe ConnReqInvitation)]
-> IO (Maybe (Maybe ConnReqInvitation))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only (Maybe ConnReqInvitation) -> Maybe ConnReqInvitation
forall a. Only a -> a
fromOnly (IO [Only (Maybe ConnReqInvitation)]
 -> IO (Maybe ConnReqInvitation))
-> IO [Only (Maybe ConnReqInvitation)]
-> IO (Maybe ConnReqInvitation)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query -> (UserId, UserId) -> IO [Only (Maybe ConnReqInvitation)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT sent_inv_queue_info FROM group_members WHERE group_member_id = ? AND user_id = ?" (UserId
groupMemberId, UserId
userId)

createMemberConnection :: DB.Connection -> UserId -> GroupMember -> ConnId -> VersionChat -> VersionRangeChat -> SubscriptionMode -> IO Connection
createMemberConnection :: Connection
-> UserId
-> GroupMember
-> ConnId
-> VersionChat
-> VersionRangeChat
-> SubscriptionMode
-> IO Connection
createMemberConnection Connection
db UserId
userId GroupMember {UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId} ConnId
agentConnId VersionChat
chatV VersionRangeChat
peerChatVRange SubscriptionMode
subMode = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection
-> UserId
-> UserId
-> ConnId
-> VersionChat
-> VersionRangeChat
-> Maybe UserId
-> Int
-> UTCTime
-> SubscriptionMode
-> IO Connection
createMemberConnection_ Connection
db UserId
userId UserId
groupMemberId ConnId
agentConnId VersionChat
chatV VersionRangeChat
peerChatVRange Maybe UserId
forall a. Maybe a
Nothing Int
0 UTCTime
currentTs SubscriptionMode
subMode

createMemberConnectionAsync :: DB.Connection -> User -> GroupMemberId -> (CommandId, ConnId) -> VersionChat -> VersionRangeChat -> SubscriptionMode -> IO ()
createMemberConnectionAsync :: Connection
-> User
-> UserId
-> (UserId, ConnId)
-> VersionChat
-> VersionRangeChat
-> SubscriptionMode
-> IO ()
createMemberConnectionAsync Connection
db user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} UserId
groupMemberId (UserId
cmdId, ConnId
agentConnId) VersionChat
chatV VersionRangeChat
peerChatVRange SubscriptionMode
subMode = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection {UserId
connId :: Connection -> UserId
connId :: UserId
connId} <- Connection
-> UserId
-> UserId
-> ConnId
-> VersionChat
-> VersionRangeChat
-> Maybe UserId
-> Int
-> UTCTime
-> SubscriptionMode
-> IO Connection
createMemberConnection_ Connection
db UserId
userId UserId
groupMemberId ConnId
agentConnId VersionChat
chatV VersionRangeChat
peerChatVRange Maybe UserId
forall a. Maybe a
Nothing Int
0 UTCTime
currentTs SubscriptionMode
subMode
  Connection -> User -> UserId -> UserId -> IO ()
setCommandConnId Connection
db User
user UserId
cmdId UserId
connId

updateGroupMemberStatus :: DB.Connection -> UserId -> GroupMember -> GroupMemberStatus -> IO ()
updateGroupMemberStatus :: Connection -> UserId -> GroupMember -> GroupMemberStatus -> IO ()
updateGroupMemberStatus Connection
db UserId
userId GroupMember {UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId} = Connection -> UserId -> UserId -> GroupMemberStatus -> IO ()
updateGroupMemberStatusById Connection
db UserId
userId UserId
groupMemberId

updateGroupMemberStatusById :: DB.Connection -> UserId -> GroupMemberId -> GroupMemberStatus -> IO ()
updateGroupMemberStatusById :: Connection -> UserId -> UserId -> GroupMemberStatus -> IO ()
updateGroupMemberStatusById Connection
db UserId
userId UserId
groupMemberId GroupMemberStatus
memStatus = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection
-> Query -> (GroupMemberStatus, UTCTime, UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE group_members
      SET member_status = ?, updated_at = ?
      WHERE user_id = ? AND group_member_id = ?
    |]
    (GroupMemberStatus
memStatus, UTCTime
currentTs, UserId
userId, UserId
groupMemberId)

updateGroupMemberAccepted :: DB.Connection -> User -> GroupMember -> GroupMemberStatus -> GroupMemberRole -> IO GroupMember
updateGroupMemberAccepted :: Connection
-> User
-> GroupMember
-> GroupMemberStatus
-> GroupMemberRole
-> IO GroupMember
updateGroupMemberAccepted Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} m :: GroupMember
m@GroupMember {UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId} GroupMemberStatus
status GroupMemberRole
role = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection
-> Query
-> (GroupMemberStatus, GroupMemberRole, UTCTime, UserId, UserId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE group_members
      SET member_status = ?, member_role = ?, updated_at = ?
      WHERE user_id = ? AND group_member_id = ?
    |]
    (GroupMemberStatus
status, GroupMemberRole
role, UTCTime
currentTs, UserId
userId, UserId
groupMemberId)
  GroupMember -> IO GroupMember
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupMember
m {memberStatus = status, memberRole = role, updatedAt = currentTs}

deleteGroupMemberSupportChat :: DB.Connection -> GroupMember -> IO GroupMember
deleteGroupMemberSupportChat :: Connection -> GroupMember -> IO GroupMember
deleteGroupMemberSupportChat Connection
db m :: GroupMember
m@GroupMember {UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId} = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection -> Query -> Only UserId -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      DELETE FROM chat_items
      WHERE group_scope_group_member_id = ?
    |]
    (UserId -> Only UserId
forall a. a -> Only a
Only UserId
groupMemberId)
  Connection -> Query -> (UTCTime, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE group_members
      SET support_chat_ts = NULL,
          support_chat_items_unread = 0,
          support_chat_items_member_attention = 0,
          support_chat_items_mentions = 0,
          support_chat_last_msg_from_member_ts = NULL,
          updated_at = ?
      WHERE group_member_id = ?
    |]
    (UTCTime
currentTs, UserId
groupMemberId)
  GroupMember -> IO GroupMember
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupMember
m {supportChat = Nothing, updatedAt = currentTs}

updateGroupMembersRequireAttention :: DB.Connection -> User -> GroupInfo -> GroupMember -> GroupMember -> IO GroupInfo
updateGroupMembersRequireAttention :: Connection
-> User -> GroupInfo -> GroupMember -> GroupMember -> IO GroupInfo
updateGroupMembersRequireAttention Connection
db User
user GroupInfo
g GroupMember
member GroupMember
member'
  | Bool
nowRequires Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
didRequire =
      Connection -> User -> GroupInfo -> IO GroupInfo
increaseGroupMembersRequireAttention Connection
db User
user GroupInfo
g
  | Bool -> Bool
not Bool
nowRequires Bool -> Bool -> Bool
&& Bool
didRequire =
      Connection -> User -> GroupInfo -> IO GroupInfo
decreaseGroupMembersRequireAttention Connection
db User
user GroupInfo
g
  | Bool
otherwise = GroupInfo -> IO GroupInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupInfo
g
  where
    didRequire :: Bool
didRequire = GroupMember -> Bool
gmRequiresAttention GroupMember
member
    nowRequires :: Bool
nowRequires = GroupMember -> Bool
gmRequiresAttention GroupMember
member'

decreaseGroupMembersRequireAttention :: DB.Connection -> User -> GroupInfo -> IO GroupInfo
decreaseGroupMembersRequireAttention :: Connection -> User -> GroupInfo -> IO GroupInfo
decreaseGroupMembersRequireAttention Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} g :: GroupInfo
g@GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId, Int
membersRequireAttention :: GroupInfo -> Int
membersRequireAttention :: Int
membersRequireAttention} = do
  Connection -> Query -> (UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
#if defined(dbPostgres)
    [sql|
      UPDATE groups
      SET members_require_attention = GREATEST(0, members_require_attention - 1)
      WHERE user_id = ? AND group_id = ?
    |]
#else
    [sql|
      UPDATE groups
      SET members_require_attention = MAX(0, members_require_attention - 1)
      WHERE user_id = ? AND group_id = ?
    |]
#endif
    (UserId
userId, UserId
groupId)
  GroupInfo -> IO GroupInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupInfo
g {membersRequireAttention = max 0 (membersRequireAttention - 1)}

increaseGroupMembersRequireAttention :: DB.Connection -> User -> GroupInfo -> IO GroupInfo
increaseGroupMembersRequireAttention :: Connection -> User -> GroupInfo -> IO GroupInfo
increaseGroupMembersRequireAttention Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} g :: GroupInfo
g@GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId, Int
membersRequireAttention :: GroupInfo -> Int
membersRequireAttention :: Int
membersRequireAttention} = do
  Connection -> Query -> (UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE groups
      SET members_require_attention = members_require_attention + 1
      WHERE user_id = ? AND group_id = ?
    |]
    (UserId
userId, UserId
groupId)
  GroupInfo -> IO GroupInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupInfo
g {membersRequireAttention = membersRequireAttention + 1}

-- | add new member with profile
createNewGroupMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberInfo -> GroupMemberCategory -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
createNewGroupMember :: Connection
-> User
-> GroupInfo
-> GroupMember
-> MemberInfo
-> GroupMemberCategory
-> GroupMemberStatus
-> ExceptT StoreError IO GroupMember
createNewGroupMember Connection
db User
user GroupInfo
gInfo GroupMember
invitingMember memInfo :: MemberInfo
memInfo@MemberInfo {Profile
profile :: Profile
profile :: MemberInfo -> Profile
profile} GroupMemberCategory
memCategory GroupMemberStatus
memStatus = 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
  (LocalAlias
localDisplayName, UserId
memProfileId) <- Connection
-> User
-> Profile
-> UTCTime
-> ExceptT StoreError IO (LocalAlias, UserId)
createNewMemberProfile_ Connection
db User
user Profile
profile UTCTime
currentTs
  let newMember :: NewGroupMember
newMember =
        NewGroupMember
          { MemberInfo
memInfo :: MemberInfo
memInfo :: MemberInfo
memInfo,
            GroupMemberCategory
memCategory :: GroupMemberCategory
memCategory :: GroupMemberCategory
memCategory,
            GroupMemberStatus
memStatus :: GroupMemberStatus
memStatus :: GroupMemberStatus
memStatus,
            memRestriction :: Maybe MemberRestrictionStatus
memRestriction = Maybe MemberRestrictionStatus
forall a. Maybe a
Nothing,
            memInvitedBy :: InvitedBy
memInvitedBy = InvitedBy
IBUnknown,
            memInvitedByGroupMemberId :: Maybe UserId
memInvitedByGroupMemberId = UserId -> Maybe UserId
forall a. a -> Maybe a
Just (UserId -> Maybe UserId) -> UserId -> Maybe UserId
forall a b. (a -> b) -> a -> b
$ GroupMember -> UserId
groupMemberId' GroupMember
invitingMember,
            LocalAlias
localDisplayName :: LocalAlias
localDisplayName :: LocalAlias
localDisplayName,
            memContactId :: Maybe UserId
memContactId = Maybe UserId
forall a. Maybe a
Nothing,
            UserId
memProfileId :: UserId
memProfileId :: UserId
memProfileId
          }
  Connection
-> User
-> GroupInfo
-> NewGroupMember
-> UTCTime
-> ExceptT StoreError IO GroupMember
createNewMember_ Connection
db User
user GroupInfo
gInfo NewGroupMember
newMember UTCTime
currentTs

createNewMemberProfile_ :: DB.Connection -> User -> Profile -> UTCTime -> ExceptT StoreError IO (Text, ProfileId)
createNewMemberProfile_ :: Connection
-> User
-> Profile
-> UTCTime
-> ExceptT StoreError IO (LocalAlias, UserId)
createNewMemberProfile_ Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} Profile {LocalAlias
displayName :: Profile -> LocalAlias
displayName :: LocalAlias
displayName, LocalAlias
fullName :: Profile -> LocalAlias
fullName :: LocalAlias
fullName, Maybe LocalAlias
shortDescr :: Profile -> Maybe LocalAlias
shortDescr :: Maybe LocalAlias
shortDescr, Maybe ImageData
image :: Profile -> Maybe ImageData
image :: Maybe ImageData
image, Maybe ConnLinkContact
contactLink :: Profile -> Maybe ConnLinkContact
contactLink :: Maybe ConnLinkContact
contactLink, Maybe Preferences
preferences :: Profile -> Maybe Preferences
preferences :: Maybe Preferences
preferences} UTCTime
createdAt =
  IO (Either StoreError (LocalAlias, UserId))
-> ExceptT StoreError IO (LocalAlias, UserId)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (LocalAlias, UserId))
 -> ExceptT StoreError IO (LocalAlias, UserId))
-> ((LocalAlias -> IO (Either StoreError (LocalAlias, UserId)))
    -> IO (Either StoreError (LocalAlias, UserId)))
-> (LocalAlias -> IO (Either StoreError (LocalAlias, UserId)))
-> ExceptT StoreError IO (LocalAlias, UserId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError (LocalAlias, UserId)))
-> IO (Either StoreError (LocalAlias, UserId))
forall a.
Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError a))
-> IO (Either StoreError a)
withLocalDisplayName Connection
db UserId
userId LocalAlias
displayName ((LocalAlias -> IO (Either StoreError (LocalAlias, UserId)))
 -> ExceptT StoreError IO (LocalAlias, UserId))
-> (LocalAlias -> IO (Either StoreError (LocalAlias, UserId)))
-> ExceptT StoreError IO (LocalAlias, UserId)
forall a b. (a -> b) -> a -> b
$ \LocalAlias
ldn -> do
    Connection
-> Query
-> (LocalAlias, LocalAlias, Maybe LocalAlias, Maybe ImageData,
    Maybe ConnLinkContact, UserId, Maybe Preferences, UTCTime, UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      Query
"INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
      (LocalAlias
displayName, LocalAlias
fullName, Maybe LocalAlias
shortDescr, Maybe ImageData
image, Maybe ConnLinkContact
contactLink, UserId
userId, Maybe Preferences
preferences, UTCTime
createdAt, UTCTime
createdAt)
    UserId
profileId <- Connection -> IO UserId
insertedRowId Connection
db
    Either StoreError (LocalAlias, UserId)
-> IO (Either StoreError (LocalAlias, UserId))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError (LocalAlias, UserId)
 -> IO (Either StoreError (LocalAlias, UserId)))
-> Either StoreError (LocalAlias, UserId)
-> IO (Either StoreError (LocalAlias, UserId))
forall a b. (a -> b) -> a -> b
$ (LocalAlias, UserId) -> Either StoreError (LocalAlias, UserId)
forall a b. b -> Either a b
Right (LocalAlias
ldn, UserId
profileId)

createNewMember_ :: DB.Connection -> User -> GroupInfo -> NewGroupMember -> UTCTime -> ExceptT StoreError IO GroupMember
createNewMember_ :: Connection
-> User
-> GroupInfo
-> NewGroupMember
-> UTCTime
-> ExceptT StoreError IO GroupMember
createNewMember_
  Connection
db
  User {UserId
userId :: User -> UserId
userId :: UserId
userId, UserId
userContactId :: User -> UserId
userContactId :: UserId
userContactId}
  GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId}
  NewGroupMember
    { memInfo :: NewGroupMember -> MemberInfo
memInfo = MemberInfo MemberId
memberId GroupMemberRole
memberRole Maybe ChatVersionRange
memChatVRange Profile
memberProfile,
      memCategory :: NewGroupMember -> GroupMemberCategory
memCategory = GroupMemberCategory
memberCategory,
      memStatus :: NewGroupMember -> GroupMemberStatus
memStatus = GroupMemberStatus
memberStatus,
      Maybe MemberRestrictionStatus
memRestriction :: NewGroupMember -> Maybe MemberRestrictionStatus
memRestriction :: Maybe MemberRestrictionStatus
memRestriction,
      memInvitedBy :: NewGroupMember -> InvitedBy
memInvitedBy = InvitedBy
invitedBy,
      Maybe UserId
memInvitedByGroupMemberId :: NewGroupMember -> Maybe UserId
memInvitedByGroupMemberId :: Maybe UserId
memInvitedByGroupMemberId,
      LocalAlias
localDisplayName :: NewGroupMember -> LocalAlias
localDisplayName :: LocalAlias
localDisplayName,
      memContactId :: NewGroupMember -> Maybe UserId
memContactId = Maybe UserId
memberContactId,
      memProfileId :: NewGroupMember -> UserId
memProfileId = UserId
memberContactProfileId
    }
  UTCTime
createdAt = do
    let invitedById :: Maybe UserId
invitedById = UserId -> InvitedBy -> Maybe UserId
fromInvitedBy UserId
userContactId InvitedBy
invitedBy
        activeConn :: Maybe a
activeConn = Maybe a
forall a. Maybe a
Nothing
        memberChatVRange :: VersionRangeChat
memberChatVRange@(VersionRange VersionChat
minV VersionChat
maxV) = VersionRangeChat
-> (ChatVersionRange -> VersionRangeChat)
-> Maybe ChatVersionRange
-> VersionRangeChat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe VersionRangeChat
chatInitialVRange ChatVersionRange -> VersionRangeChat
fromChatVRange Maybe ChatVersionRange
memChatVRange
    UserId
indexInGroup <- Connection -> UserId -> ExceptT StoreError IO UserId
getUpdateNextIndexInGroup_ Connection
db UserId
groupId
    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
-> ((UserId, UserId, MemberId, GroupMemberRole,
     GroupMemberCategory, GroupMemberStatus, Binary ConnId,
     Maybe MemberRestrictionStatus, Maybe UserId, Maybe UserId)
    :. ((UserId, LocalAlias, Maybe UserId, UserId, UTCTime, UTCTime)
        :. (VersionChat, VersionChat)))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        [sql|
          INSERT INTO group_members
            (group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, member_restriction, invited_by, invited_by_group_member_id,
            user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
            peer_chat_min_version, peer_chat_max_version)
            VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
        |]
        ( (UserId
groupId, UserId
indexInGroup, MemberId
memberId, GroupMemberRole
memberRole, GroupMemberCategory
memberCategory, GroupMemberStatus
memberStatus, ConnId -> Binary ConnId
forall a. a -> Binary a
Binary ConnId
B.empty, Maybe MemberRestrictionStatus
memRestriction, Maybe UserId
invitedById, Maybe UserId
memInvitedByGroupMemberId)
            (UserId, UserId, MemberId, GroupMemberRole, GroupMemberCategory,
 GroupMemberStatus, Binary ConnId, Maybe MemberRestrictionStatus,
 Maybe UserId, Maybe UserId)
-> ((UserId, LocalAlias, Maybe UserId, UserId, UTCTime, UTCTime)
    :. (VersionChat, VersionChat))
-> (UserId, UserId, MemberId, GroupMemberRole, GroupMemberCategory,
    GroupMemberStatus, Binary ConnId, Maybe MemberRestrictionStatus,
    Maybe UserId, Maybe UserId)
   :. ((UserId, LocalAlias, Maybe UserId, UserId, UTCTime, UTCTime)
       :. (VersionChat, VersionChat))
forall h t. h -> t -> h :. t
:. (UserId
userId, LocalAlias
localDisplayName, Maybe UserId
memberContactId, UserId
memberContactProfileId, UTCTime
createdAt, UTCTime
createdAt)
            (UserId, LocalAlias, Maybe UserId, UserId, UTCTime, UTCTime)
-> (VersionChat, VersionChat)
-> (UserId, LocalAlias, Maybe UserId, UserId, UTCTime, UTCTime)
   :. (VersionChat, VersionChat)
forall h t. h -> t -> h :. t
:. (VersionChat
minV, VersionChat
maxV)
        )
    UserId
groupMemberId <- IO UserId -> ExceptT StoreError IO UserId
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserId -> ExceptT StoreError IO UserId)
-> IO UserId -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$ Connection -> IO UserId
insertedRowId Connection
db
    GroupMember -> ExceptT StoreError IO GroupMember
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      GroupMember
        { UserId
groupMemberId :: UserId
groupMemberId :: UserId
groupMemberId,
          UserId
groupId :: UserId
groupId :: UserId
groupId,
          UserId
indexInGroup :: UserId
indexInGroup :: UserId
indexInGroup,
          MemberId
memberId :: MemberId
memberId :: MemberId
memberId,
          GroupMemberRole
memberRole :: GroupMemberRole
memberRole :: GroupMemberRole
memberRole,
          GroupMemberCategory
memberCategory :: GroupMemberCategory
memberCategory :: GroupMemberCategory
memberCategory,
          GroupMemberStatus
memberStatus :: GroupMemberStatus
memberStatus :: GroupMemberStatus
memberStatus,
          memberSettings :: GroupMemberSettings
memberSettings = GroupMemberSettings
defaultMemberSettings,
          blockedByAdmin :: Bool
blockedByAdmin = Bool
-> (MemberRestrictionStatus -> Bool)
-> Maybe MemberRestrictionStatus
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False MemberRestrictionStatus -> Bool
mrsBlocked Maybe MemberRestrictionStatus
memRestriction,
          InvitedBy
invitedBy :: InvitedBy
invitedBy :: InvitedBy
invitedBy,
          invitedByGroupMemberId :: Maybe UserId
invitedByGroupMemberId = Maybe UserId
memInvitedByGroupMemberId,
          LocalAlias
localDisplayName :: LocalAlias
localDisplayName :: LocalAlias
localDisplayName,
          memberProfile :: LocalProfile
memberProfile = UserId -> Profile -> LocalAlias -> LocalProfile
toLocalProfile UserId
memberContactProfileId Profile
memberProfile LocalAlias
"",
          Maybe UserId
memberContactId :: Maybe UserId
memberContactId :: Maybe UserId
memberContactId,
          UserId
memberContactProfileId :: UserId
memberContactProfileId :: UserId
memberContactProfileId,
          Maybe Connection
forall a. Maybe a
activeConn :: Maybe Connection
activeConn :: forall a. Maybe a
activeConn,
          VersionRangeChat
memberChatVRange :: VersionRangeChat
memberChatVRange :: VersionRangeChat
memberChatVRange,
          UTCTime
createdAt :: UTCTime
createdAt :: UTCTime
createdAt,
          updatedAt :: UTCTime
updatedAt = UTCTime
createdAt,
          supportChat :: Maybe GroupSupportChat
supportChat = Maybe GroupSupportChat
forall a. Maybe a
Nothing
        }

checkGroupMemberHasItems :: DB.Connection -> User -> GroupMember -> IO (Maybe ChatItemId)
checkGroupMemberHasItems :: Connection -> User -> GroupMember -> IO (Maybe UserId)
checkGroupMemberHasItems Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupMember {UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId, UserId
groupId :: GroupMember -> UserId
groupId :: UserId
groupId} =
  (Only UserId -> UserId) -> IO [Only UserId] -> IO (Maybe UserId)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only UserId -> UserId
forall a. Only a -> a
fromOnly (IO [Only UserId] -> IO (Maybe UserId))
-> IO [Only UserId] -> IO (Maybe UserId)
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> (UserId, UserId, UserId) -> IO [Only UserId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT chat_item_id FROM chat_items WHERE user_id = ? AND group_id = ? AND group_member_id = ? LIMIT 1" (UserId
userId, UserId
groupId, UserId
groupMemberId)

deleteGroupMember :: DB.Connection -> User -> GroupMember -> IO ()
deleteGroupMember :: Connection -> User -> GroupMember -> IO ()
deleteGroupMember Connection
db user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} m :: GroupMember
m@GroupMember {UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId, UserId
groupId :: GroupMember -> UserId
groupId :: UserId
groupId, LocalProfile
memberProfile :: GroupMember -> LocalProfile
memberProfile :: LocalProfile
memberProfile} = do
  Connection -> User -> GroupMember -> IO ()
deleteGroupMemberConnection Connection
db User
user GroupMember
m
  Connection -> Query -> (UserId, UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM chat_items WHERE user_id = ? AND group_id = ? AND group_member_id = ?" (UserId
userId, UserId
groupId, UserId
groupMemberId)
  Connection -> Query -> (UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM group_members WHERE user_id = ? AND group_member_id = ?" (UserId
userId, UserId
groupMemberId)
  Connection -> User -> GroupMember -> IO ()
cleanupMemberProfileAndName_ Connection
db User
user GroupMember
m
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GroupMember -> Bool
memberIncognito GroupMember
m) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> User -> UserId -> IO ()
deleteUnusedIncognitoProfileById_ Connection
db User
user (UserId -> IO ()) -> UserId -> IO ()
forall a b. (a -> b) -> a -> b
$ LocalProfile -> UserId
localProfileId LocalProfile
memberProfile

cleanupMemberProfileAndName_ :: DB.Connection -> User -> GroupMember -> IO ()
cleanupMemberProfileAndName_ :: Connection -> User -> GroupMember -> IO ()
cleanupMemberProfileAndName_ Connection
db user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupMember {UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId, Maybe UserId
memberContactId :: GroupMember -> Maybe UserId
memberContactId :: Maybe UserId
memberContactId, UserId
memberContactProfileId :: GroupMember -> UserId
memberContactProfileId :: UserId
memberContactProfileId, LocalAlias
localDisplayName :: GroupMember -> LocalAlias
localDisplayName :: LocalAlias
localDisplayName} =
  -- check record has no memberContactId (contact_id) - it means contact has been deleted and doesn't use profile & ldn
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe UserId -> Bool
forall a. Maybe a -> Bool
isNothing Maybe UserId
memberContactId) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    -- check other group member records don't use profile & ldn
    Maybe UserId
sameProfileMember :: (Maybe GroupMemberId) <- (Only UserId -> UserId) -> IO [Only UserId] -> IO (Maybe UserId)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only UserId -> UserId
forall a. Only a -> a
fromOnly (IO [Only UserId] -> IO (Maybe UserId))
-> IO [Only UserId] -> IO (Maybe UserId)
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> (UserId, UserId, UserId) -> IO [Only UserId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT group_member_id FROM group_members WHERE user_id = ? AND contact_profile_id = ? AND group_member_id != ? LIMIT 1" (UserId
userId, UserId
memberContactProfileId, UserId
groupMemberId)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe UserId -> Bool
forall a. Maybe a -> Bool
isNothing Maybe UserId
sameProfileMember) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Connection -> Query -> (UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM contact_profiles WHERE user_id = ? AND contact_profile_id = ?" (UserId
userId, UserId
memberContactProfileId)
      Connection -> User -> LocalAlias -> IO ()
safeDeleteLDN Connection
db User
user LocalAlias
localDisplayName

deleteGroupMemberConnection :: DB.Connection -> User -> GroupMember -> IO ()
deleteGroupMemberConnection :: Connection -> User -> GroupMember -> IO ()
deleteGroupMemberConnection Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupMember {UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId} =
  Connection -> Query -> (UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM connections WHERE user_id = ? AND group_member_id = ?" (UserId
userId, UserId
groupMemberId)

updateGroupMemberRole :: DB.Connection -> User -> GroupMember -> GroupMemberRole -> IO ()
updateGroupMemberRole :: Connection -> User -> GroupMember -> GroupMemberRole -> IO ()
updateGroupMemberRole Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupMember {UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId} GroupMemberRole
memRole =
  Connection -> Query -> (GroupMemberRole, UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE group_members SET member_role = ? WHERE user_id = ? AND group_member_id = ?" (GroupMemberRole
memRole, UserId
userId, UserId
groupMemberId)

setMemberVectorNewRelations :: DB.Connection -> GroupMember -> [(Int64, (IntroductionDirection, MemberRelation))] -> IO ()
setMemberVectorNewRelations :: Connection
-> GroupMember
-> [(UserId, (IntroductionDirection, MemberRelation))]
-> IO ()
setMemberVectorNewRelations Connection
db GroupMember {UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId} [(UserId, (IntroductionDirection, MemberRelation))]
relations = do
  Maybe ConnId
v_ <- (Only ConnId -> ConnId) -> IO [Only ConnId] -> IO (Maybe ConnId)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only ConnId -> ConnId
forall a. Only a -> a
fromOnly (IO [Only ConnId] -> IO (Maybe ConnId))
-> IO [Only ConnId] -> IO (Maybe ConnId)
forall a b. (a -> b) -> a -> b
$
    Connection -> Query -> Only UserId -> IO [Only ConnId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
#if defined(dbPostgres)
      "SELECT member_relations_vector FROM group_members WHERE group_member_id = ? FOR UPDATE"
#else
      Query
"SELECT member_relations_vector FROM group_members WHERE group_member_id = ?"
#endif
      (UserId -> Only UserId
forall a. a -> Only a
Only UserId
groupMemberId)
  let v' :: ConnId
v' = [(UserId, (IntroductionDirection, MemberRelation))]
-> ConnId -> ConnId
setNewRelations [(UserId, (IntroductionDirection, MemberRelation))]
relations (ConnId -> ConnId) -> ConnId -> ConnId
forall a b. (a -> b) -> a -> b
$ ConnId -> Maybe ConnId -> ConnId
forall a. a -> Maybe a -> a
fromMaybe ConnId
B.empty Maybe ConnId
v_
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection -> Query -> (Binary ConnId, UTCTime, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE group_members
      SET member_relations_vector = ?, updated_at = ?
      WHERE group_member_id = ?
    |]
    (ConnId -> Binary ConnId
forall a. a -> Binary a
Binary ConnId
v', UTCTime
currentTs, UserId
groupMemberId)

setMembersVectorsNewRelation :: DB.Connection -> [GroupMember] -> Int64 -> IntroductionDirection -> MemberRelation -> IO ()
setMembersVectorsNewRelation :: Connection
-> [GroupMember]
-> UserId
-> IntroductionDirection
-> MemberRelation
-> IO ()
setMembersVectorsNewRelation Connection
db [GroupMember]
members UserId
idx IntroductionDirection
dir MemberRelation
status = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
#if defined(dbPostgres)
  let memberIds = map groupMemberId' members
  DB.execute
    db
    "UPDATE group_members SET member_relations_vector = set_member_vector_new_relation(member_relations_vector, ?, ?, ?), updated_at = ? WHERE group_member_id IN ?"
    (idx, toIntroDirInt dir, toRelationInt status, currentTs, In memberIds)
#else
  [GroupMember] -> (GroupMember -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GroupMember]
members ((GroupMember -> IO ()) -> IO ())
-> (GroupMember -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \GroupMember {UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId} ->
    Connection
-> Query -> (UserId, Word8, Word8, UTCTime, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      Query
"UPDATE group_members SET member_relations_vector = set_member_vector_new_relation(member_relations_vector, ?, ?, ?), updated_at = ? WHERE group_member_id = ?"
      (UserId
idx, IntroductionDirection -> Word8
toIntroDirInt IntroductionDirection
dir, MemberRelation -> Word8
toRelationInt MemberRelation
status, UTCTime
currentTs, UserId
groupMemberId)
#endif

setMemberVectorRelationConnected :: DB.Connection -> GroupMember -> GroupMember -> MemberRelation -> ExceptT StoreError IO ()
setMemberVectorRelationConnected :: Connection
-> GroupMember
-> GroupMember
-> MemberRelation
-> ExceptT StoreError IO ()
setMemberVectorRelationConnected Connection
db GroupMember {UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId} GroupMember {UserId
indexInGroup :: GroupMember -> UserId
indexInGroup :: UserId
indexInGroup} MemberRelation
newStatus = do
  Bool -> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MemberRelation
newStatus MemberRelation -> MemberRelation -> Bool
forall a. Eq a => a -> a -> Bool
/= MemberRelation
MRSubjectConnected Bool -> Bool -> Bool
&& MemberRelation
newStatus MemberRelation -> MemberRelation -> Bool
forall a. Eq a => a -> a -> Bool
/= MemberRelation
MRReferencedConnected) (ExceptT StoreError IO () -> ExceptT StoreError IO ())
-> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
    StoreError -> ExceptT StoreError IO ()
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError StoreError
SEInvalidMemberRelationUpdate
  ConnId
v <- IO (Either StoreError ConnId) -> ExceptT StoreError IO ConnId
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError ConnId) -> ExceptT StoreError IO ConnId)
-> IO (Either StoreError ConnId) -> ExceptT StoreError IO ConnId
forall a b. (a -> b) -> a -> b
$
    (Only ConnId -> ConnId)
-> StoreError -> IO [Only ConnId] -> IO (Either StoreError ConnId)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only ConnId -> ConnId
forall a. Only a -> a
fromOnly (UserId -> StoreError
SEMemberRelationsVectorNotFound UserId
groupMemberId) (IO [Only ConnId] -> IO (Either StoreError ConnId))
-> IO [Only ConnId] -> IO (Either StoreError ConnId)
forall a b. (a -> b) -> a -> b
$
      Connection -> Query -> Only UserId -> IO [Only ConnId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
#if defined(dbPostgres)
        "SELECT member_relations_vector FROM group_members WHERE group_member_id = ? AND member_relations_vector IS NOT NULL FOR UPDATE"
#else
        Query
"SELECT member_relations_vector FROM group_members WHERE group_member_id = ? AND member_relations_vector IS NOT NULL"
#endif
        (UserId -> Only UserId
forall a. a -> Only a
Only UserId
groupMemberId)
  let v' :: ConnId
v' = UserId -> MemberRelation -> ConnId -> ConnId
setRelationConnected UserId
indexInGroup MemberRelation
newStatus ConnId
v
  UTCTime
currentTs <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> (Binary ConnId, UTCTime, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE group_members
      SET member_relations_vector = ?, updated_at = ?
      WHERE group_member_id = ?
    |]
    (ConnId -> Binary ConnId
forall a. a -> Binary a
Binary ConnId
v', UTCTime
currentTs, UserId
groupMemberId)

getMemberRelationsVector :: DB.Connection -> GroupMember -> ExceptT StoreError IO ByteString
getMemberRelationsVector :: Connection -> GroupMember -> ExceptT StoreError IO ConnId
getMemberRelationsVector Connection
db GroupMember {UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId} =
  IO (Either StoreError ConnId) -> ExceptT StoreError IO ConnId
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError ConnId) -> ExceptT StoreError IO ConnId)
-> (IO [Only ConnId] -> IO (Either StoreError ConnId))
-> IO [Only ConnId]
-> ExceptT StoreError IO ConnId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only ConnId -> ConnId)
-> StoreError -> IO [Only ConnId] -> IO (Either StoreError ConnId)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only ConnId -> ConnId
forall a. Only a -> a
fromOnly (UserId -> StoreError
SEGroupMemberNotFound UserId
groupMemberId) (IO [Only ConnId] -> ExceptT StoreError IO ConnId)
-> IO [Only ConnId] -> ExceptT StoreError IO ConnId
forall a b. (a -> b) -> a -> b
$
    Connection -> Query -> Only UserId -> IO [Only ConnId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      Query
"SELECT member_relations_vector FROM group_members WHERE group_member_id = ?"
      (UserId -> Only UserId
forall a. a -> Only a
Only UserId
groupMemberId)

createIntroReMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> VersionChat -> MemberInfo -> Maybe MemberRestrictions -> (CommandId, ConnId) -> SubscriptionMode -> ExceptT StoreError IO GroupMember
createIntroReMember :: Connection
-> User
-> GroupInfo
-> GroupMember
-> VersionChat
-> MemberInfo
-> Maybe MemberRestrictions
-> (UserId, ConnId)
-> SubscriptionMode
-> ExceptT StoreError IO GroupMember
createIntroReMember
  Connection
db
  user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId}
  GroupInfo
gInfo
  _host :: GroupMember
_host@GroupMember {Maybe UserId
memberContactId :: GroupMember -> Maybe UserId
memberContactId :: Maybe UserId
memberContactId, Maybe Connection
activeConn :: GroupMember -> Maybe Connection
activeConn :: Maybe Connection
activeConn}
  VersionChat
chatV
  memInfo :: MemberInfo
memInfo@(MemberInfo MemberId
_ GroupMemberRole
_ Maybe ChatVersionRange
memChatVRange Profile
memberProfile)
  Maybe MemberRestrictions
memRestrictions_
  (UserId
groupCmdId, ConnId
groupAgentConnId)
  SubscriptionMode
subMode = do
    let mcvr :: VersionRangeChat
mcvr = VersionRangeChat
-> (ChatVersionRange -> VersionRangeChat)
-> Maybe ChatVersionRange
-> VersionRangeChat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe VersionRangeChat
chatInitialVRange ChatVersionRange -> VersionRangeChat
fromChatVRange Maybe ChatVersionRange
memChatVRange
        cLevel :: Int
cLevel = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> (Connection -> Int) -> Maybe Connection -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (\Connection {Int
connLevel :: Int
connLevel :: Connection -> Int
connLevel} -> Int
connLevel) Maybe Connection
activeConn
        memRestriction :: Maybe MemberRestrictionStatus
memRestriction = MemberRestrictions -> MemberRestrictionStatus
restriction (MemberRestrictions -> MemberRestrictionStatus)
-> Maybe MemberRestrictions -> Maybe MemberRestrictionStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MemberRestrictions
memRestrictions_
    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
    (LocalAlias
localDisplayName, UserId
memProfileId) <- Connection
-> User
-> Profile
-> UTCTime
-> ExceptT StoreError IO (LocalAlias, UserId)
createNewMemberProfile_ Connection
db User
user Profile
memberProfile UTCTime
currentTs
    let newMember :: NewGroupMember
newMember = NewGroupMember {MemberInfo
memInfo :: MemberInfo
memInfo :: MemberInfo
memInfo, memCategory :: GroupMemberCategory
memCategory = GroupMemberCategory
GCPreMember, memStatus :: GroupMemberStatus
memStatus = GroupMemberStatus
GSMemIntroduced, Maybe MemberRestrictionStatus
memRestriction :: Maybe MemberRestrictionStatus
memRestriction :: Maybe MemberRestrictionStatus
memRestriction, memInvitedBy :: InvitedBy
memInvitedBy = InvitedBy
IBUnknown, memInvitedByGroupMemberId :: Maybe UserId
memInvitedByGroupMemberId = Maybe UserId
forall a. Maybe a
Nothing, LocalAlias
localDisplayName :: LocalAlias
localDisplayName :: LocalAlias
localDisplayName, memContactId :: Maybe UserId
memContactId = Maybe UserId
forall a. Maybe a
Nothing, UserId
memProfileId :: UserId
memProfileId :: UserId
memProfileId}
    GroupMember
member <- Connection
-> User
-> GroupInfo
-> NewGroupMember
-> UTCTime
-> ExceptT StoreError IO GroupMember
createNewMember_ Connection
db User
user GroupInfo
gInfo NewGroupMember
newMember UTCTime
currentTs
    conn :: Connection
conn@Connection {connId :: Connection -> UserId
connId = UserId
groupConnId} <- IO Connection -> ExceptT StoreError IO Connection
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Connection -> ExceptT StoreError IO Connection)
-> IO Connection -> ExceptT StoreError IO Connection
forall a b. (a -> b) -> a -> b
$ Connection
-> UserId
-> UserId
-> ConnId
-> VersionChat
-> VersionRangeChat
-> Maybe UserId
-> Int
-> UTCTime
-> SubscriptionMode
-> IO Connection
createMemberConnection_ Connection
db UserId
userId (GroupMember -> UserId
groupMemberId' GroupMember
member) ConnId
groupAgentConnId VersionChat
chatV VersionRangeChat
mcvr Maybe UserId
memberContactId Int
cLevel UTCTime
currentTs SubscriptionMode
subMode
    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 -> User -> UserId -> UserId -> IO ()
setCommandConnId Connection
db User
user UserId
groupCmdId UserId
groupConnId
    GroupMember -> ExceptT StoreError IO GroupMember
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupMember
member :: GroupMember) {activeConn = Just conn}

createIntroToMemberContact :: DB.Connection -> User -> GroupMember -> GroupMember -> VersionChat -> VersionRangeChat -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> IO ()
createIntroToMemberContact :: Connection
-> User
-> GroupMember
-> GroupMember
-> VersionChat
-> VersionRangeChat
-> (UserId, ConnId)
-> Maybe (UserId, ConnId)
-> Maybe UserId
-> SubscriptionMode
-> IO ()
createIntroToMemberContact Connection
db user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupMember {memberContactId :: GroupMember -> Maybe UserId
memberContactId = Maybe UserId
viaContactId, Maybe Connection
activeConn :: GroupMember -> Maybe Connection
activeConn :: Maybe Connection
activeConn} _to :: GroupMember
_to@GroupMember {UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId, LocalAlias
localDisplayName :: GroupMember -> LocalAlias
localDisplayName :: LocalAlias
localDisplayName} VersionChat
chatV VersionRangeChat
mcvr (UserId
groupCmdId, ConnId
groupAgentConnId) Maybe (UserId, ConnId)
directConnIds Maybe UserId
customUserProfileId SubscriptionMode
subMode = do
  let cLevel :: Int
cLevel = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> (Connection -> Int) -> Maybe Connection -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (\Connection {Int
connLevel :: Connection -> Int
connLevel :: Int
connLevel} -> Int
connLevel) Maybe Connection
activeConn
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection {connId :: Connection -> UserId
connId = UserId
groupConnId} <- Connection
-> UserId
-> UserId
-> ConnId
-> VersionChat
-> VersionRangeChat
-> Maybe UserId
-> Int
-> UTCTime
-> SubscriptionMode
-> IO Connection
createMemberConnection_ Connection
db UserId
userId UserId
groupMemberId ConnId
groupAgentConnId VersionChat
chatV VersionRangeChat
mcvr Maybe UserId
viaContactId Int
cLevel UTCTime
currentTs SubscriptionMode
subMode
  Connection -> User -> UserId -> UserId -> IO ()
setCommandConnId Connection
db User
user UserId
groupCmdId UserId
groupConnId
  Maybe (UserId, ConnId) -> ((UserId, ConnId) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (UserId, ConnId)
directConnIds (((UserId, ConnId) -> IO ()) -> IO ())
-> ((UserId, ConnId) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(UserId
directCmdId, ConnId
directAgentConnId) -> do
    Connection {connId :: Connection -> UserId
connId = UserId
directConnId} <- Connection
-> UserId
-> ConnType
-> Maybe UserId
-> ConnId
-> ConnStatus
-> VersionChat
-> VersionRangeChat
-> Maybe UserId
-> Maybe UserId
-> Maybe UserId
-> Int
-> UTCTime
-> SubscriptionMode
-> PQSupport
-> IO Connection
createConnection_ Connection
db UserId
userId ConnType
ConnContact Maybe UserId
forall a. Maybe a
Nothing ConnId
directAgentConnId ConnStatus
ConnNew VersionChat
chatV VersionRangeChat
mcvr Maybe UserId
viaContactId Maybe UserId
forall a. Maybe a
Nothing Maybe UserId
customUserProfileId Int
cLevel UTCTime
currentTs SubscriptionMode
subMode PQSupport
PQSupportOff
    Connection -> User -> UserId -> UserId -> IO ()
setCommandConnId Connection
db User
user UserId
directCmdId UserId
directConnId
    UserId
contactId <- UserId -> UTCTime -> IO UserId
createMemberContact_ UserId
directConnId UTCTime
currentTs
    UserId -> UTCTime -> IO ()
updateMember_ UserId
contactId UTCTime
currentTs
  where
    createMemberContact_ :: Int64 -> UTCTime -> IO Int64
    createMemberContact_ :: UserId -> UTCTime -> IO UserId
createMemberContact_ UserId
connId UTCTime
ts = do
      Connection
-> Query
-> (LocalAlias, UserId, UTCTime, UTCTime, UTCTime, UserId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        [sql|
          INSERT INTO contacts (contact_profile_id local_display_name, user_id, created_at, updated_at, chat_ts)
          SELECT contact_profile_id, ?, ?, ?, ?, ?
          FROM group_members
          WHERE group_member_id = ?
        |]
        (LocalAlias
localDisplayName, UserId
userId, UTCTime
ts, UTCTime
ts, UTCTime
ts, UserId
groupMemberId)
      UserId
contactId <- Connection -> IO UserId
insertedRowId Connection
db
      Connection -> Query -> (UserId, UTCTime, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (UserId
contactId, UTCTime
ts, UserId
connId)
      UserId -> IO UserId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UserId
contactId
    updateMember_ :: Int64 -> UTCTime -> IO ()
    updateMember_ :: UserId -> UTCTime -> IO ()
updateMember_ UserId
contactId UTCTime
ts =
      Connection -> Query -> (UserId, UTCTime, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        [sql|
          UPDATE group_members
          SET contact_id = ?, updated_at = ?
          WHERE group_member_id = ?
        |]
        (UserId
contactId, UTCTime
ts, UserId
groupMemberId)

createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> VersionChat -> VersionRangeChat -> Maybe Int64 -> Int -> UTCTime -> SubscriptionMode -> IO Connection
createMemberConnection_ :: Connection
-> UserId
-> UserId
-> ConnId
-> VersionChat
-> VersionRangeChat
-> Maybe UserId
-> Int
-> UTCTime
-> SubscriptionMode
-> IO Connection
createMemberConnection_ Connection
db UserId
userId UserId
groupMemberId ConnId
agentConnId VersionChat
chatV VersionRangeChat
peerChatVRange Maybe UserId
viaContact Int
connLevel UTCTime
currentTs SubscriptionMode
subMode =
  Connection
-> UserId
-> ConnType
-> Maybe UserId
-> ConnId
-> ConnStatus
-> VersionChat
-> VersionRangeChat
-> Maybe UserId
-> Maybe UserId
-> Maybe UserId
-> Int
-> UTCTime
-> SubscriptionMode
-> PQSupport
-> IO Connection
createConnection_ Connection
db UserId
userId ConnType
ConnMember (UserId -> Maybe UserId
forall a. a -> Maybe a
Just UserId
groupMemberId) ConnId
agentConnId ConnStatus
ConnNew VersionChat
chatV VersionRangeChat
peerChatVRange Maybe UserId
viaContact Maybe UserId
forall a. Maybe a
Nothing Maybe UserId
forall a. Maybe a
Nothing Int
connLevel UTCTime
currentTs SubscriptionMode
subMode PQSupport
PQSupportOff

updateGroupProfile :: DB.Connection -> User -> GroupInfo -> GroupProfile -> ExceptT StoreError IO GroupInfo
updateGroupProfile :: Connection
-> User
-> GroupInfo
-> GroupProfile
-> ExceptT StoreError IO GroupInfo
updateGroupProfile Connection
db user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} g :: GroupInfo
g@GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId, LocalAlias
localDisplayName :: GroupInfo -> LocalAlias
localDisplayName :: LocalAlias
localDisplayName, groupProfile :: GroupInfo -> GroupProfile
groupProfile = GroupProfile {LocalAlias
displayName :: GroupProfile -> LocalAlias
displayName :: LocalAlias
displayName}} p' :: GroupProfile
p'@GroupProfile {displayName :: GroupProfile -> LocalAlias
displayName = LocalAlias
newName, LocalAlias
fullName :: GroupProfile -> LocalAlias
fullName :: LocalAlias
fullName, Maybe LocalAlias
shortDescr :: GroupProfile -> Maybe LocalAlias
shortDescr :: Maybe LocalAlias
shortDescr, Maybe LocalAlias
description :: GroupProfile -> Maybe LocalAlias
description :: Maybe LocalAlias
description, Maybe ImageData
image :: GroupProfile -> Maybe ImageData
image :: Maybe ImageData
image, Maybe GroupPreferences
groupPreferences :: GroupProfile -> Maybe GroupPreferences
groupPreferences :: Maybe GroupPreferences
groupPreferences, Maybe GroupMemberAdmission
memberAdmission :: GroupProfile -> Maybe GroupMemberAdmission
memberAdmission :: Maybe GroupMemberAdmission
memberAdmission}
  | LocalAlias
displayName LocalAlias -> LocalAlias -> Bool
forall a. Eq a => a -> a -> Bool
== LocalAlias
newName = IO GroupInfo -> ExceptT StoreError IO GroupInfo
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GroupInfo -> ExceptT StoreError IO GroupInfo)
-> IO GroupInfo -> ExceptT StoreError IO GroupInfo
forall a b. (a -> b) -> a -> b
$ do
      UTCTime
currentTs <- IO UTCTime
getCurrentTime
      UTCTime -> IO ()
forall {d}. ToField d => d -> IO ()
updateGroupProfile_ UTCTime
currentTs
      GroupInfo -> IO GroupInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupInfo
g :: GroupInfo) {groupProfile = p', fullGroupPreferences}
  | Bool
otherwise =
      IO (Either StoreError GroupInfo) -> ExceptT StoreError IO GroupInfo
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError GroupInfo)
 -> ExceptT StoreError IO GroupInfo)
-> ((LocalAlias -> IO (Either StoreError GroupInfo))
    -> IO (Either StoreError GroupInfo))
-> (LocalAlias -> IO (Either StoreError GroupInfo))
-> ExceptT StoreError IO GroupInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError GroupInfo))
-> IO (Either StoreError GroupInfo)
forall a.
Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError a))
-> IO (Either StoreError a)
withLocalDisplayName Connection
db UserId
userId LocalAlias
newName ((LocalAlias -> IO (Either StoreError GroupInfo))
 -> ExceptT StoreError IO GroupInfo)
-> (LocalAlias -> IO (Either StoreError GroupInfo))
-> ExceptT StoreError IO GroupInfo
forall a b. (a -> b) -> a -> b
$ \LocalAlias
ldn -> do
        UTCTime
currentTs <- IO UTCTime
getCurrentTime
        UTCTime -> IO ()
forall {d}. ToField d => d -> IO ()
updateGroupProfile_ UTCTime
currentTs
        LocalAlias -> UTCTime -> IO ()
forall {a} {b}. (ToField a, ToField b) => a -> b -> IO ()
updateGroup_ LocalAlias
ldn UTCTime
currentTs
        Either StoreError GroupInfo -> IO (Either StoreError GroupInfo)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError GroupInfo -> IO (Either StoreError GroupInfo))
-> Either StoreError GroupInfo -> IO (Either StoreError GroupInfo)
forall a b. (a -> b) -> a -> b
$ GroupInfo -> Either StoreError GroupInfo
forall a b. b -> Either a b
Right (GroupInfo
g :: GroupInfo) {localDisplayName = ldn, groupProfile = p', fullGroupPreferences}
  where
    fullGroupPreferences :: FullGroupPreferences
fullGroupPreferences = Maybe GroupPreferences -> FullGroupPreferences
mergeGroupPreferences Maybe GroupPreferences
groupPreferences
    updateGroupProfile_ :: h -> IO ()
updateGroupProfile_ h
currentTs =
      Connection
-> Query
-> (LocalAlias, LocalAlias, Maybe LocalAlias, Maybe LocalAlias,
    Maybe ImageData, Maybe GroupPreferences,
    Maybe GroupMemberAdmission, h, UserId, UserId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        [sql|
          UPDATE group_profiles
          SET display_name = ?, full_name = ?, short_descr = ?, description = ?, image = ?, preferences = ?, member_admission = ?, updated_at = ?
          WHERE group_profile_id IN (
            SELECT group_profile_id
            FROM groups
            WHERE user_id = ? AND group_id = ?
          )
        |]
        (LocalAlias
newName, LocalAlias
fullName, Maybe LocalAlias
shortDescr, Maybe LocalAlias
description, Maybe ImageData
image, Maybe GroupPreferences
groupPreferences, Maybe GroupMemberAdmission
memberAdmission, h
currentTs, UserId
userId, UserId
groupId)
    updateGroup_ :: a -> b -> IO ()
updateGroup_ a
ldn b
currentTs = do
      Connection -> Query -> (a, b, UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        Query
"UPDATE groups SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND group_id = ?"
        (a
ldn, b
currentTs, UserId
userId, UserId
groupId)
      Connection -> User -> LocalAlias -> IO ()
safeDeleteLDN Connection
db User
user LocalAlias
localDisplayName

updateGroupPreferences :: DB.Connection -> User -> GroupInfo -> GroupPreferences -> IO GroupInfo
updateGroupPreferences :: Connection -> User -> GroupInfo -> GroupPreferences -> IO GroupInfo
updateGroupPreferences Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} g :: GroupInfo
g@GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId, groupProfile :: GroupInfo -> GroupProfile
groupProfile = GroupProfile
p} GroupPreferences
ps = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection
-> Query -> (GroupPreferences, UTCTime, UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE group_profiles
      SET preferences = ?, updated_at = ?
      WHERE group_profile_id IN (
        SELECT group_profile_id
        FROM groups
        WHERE user_id = ? AND group_id = ?
      )
    |]
    (GroupPreferences
ps, UTCTime
currentTs, UserId
userId, UserId
groupId)
  GroupInfo -> IO GroupInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupInfo
g :: GroupInfo) {groupProfile = p {groupPreferences = Just ps}, fullGroupPreferences = mergeGroupPreferences $ Just ps}

updateGroupProfileFromMember :: DB.Connection -> User -> GroupInfo -> Profile -> ExceptT StoreError IO GroupInfo
updateGroupProfileFromMember :: Connection
-> User -> GroupInfo -> Profile -> ExceptT StoreError IO GroupInfo
updateGroupProfileFromMember Connection
db User
user g :: GroupInfo
g@GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} Profile {displayName :: Profile -> LocalAlias
displayName = LocalAlias
n, fullName :: Profile -> LocalAlias
fullName = LocalAlias
fn, shortDescr :: Profile -> Maybe LocalAlias
shortDescr = Maybe LocalAlias
sd, image :: Profile -> Maybe ImageData
image = Maybe ImageData
img} = do
  GroupProfile
p <- ExceptT StoreError IO GroupProfile
getGroupProfile -- to avoid any race conditions with UI
  let g' :: GroupInfo
g' = GroupInfo
g {groupProfile = p} :: GroupInfo
      p' :: GroupProfile
p' = GroupProfile
p {displayName = n, fullName = fn, shortDescr = sd, image = img} :: GroupProfile
  Connection
-> User
-> GroupInfo
-> GroupProfile
-> ExceptT StoreError IO GroupInfo
updateGroupProfile Connection
db User
user GroupInfo
g' GroupProfile
p'
  where
    getGroupProfile :: ExceptT StoreError IO GroupProfile
getGroupProfile =
      IO (Either StoreError GroupProfile)
-> ExceptT StoreError IO GroupProfile
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError GroupProfile)
 -> ExceptT StoreError IO GroupProfile)
-> IO (Either StoreError GroupProfile)
-> ExceptT StoreError IO GroupProfile
forall a b. (a -> b) -> a -> b
$
        ((LocalAlias, LocalAlias, Maybe LocalAlias, Maybe LocalAlias,
  Maybe ImageData, Maybe GroupPreferences,
  Maybe GroupMemberAdmission)
 -> GroupProfile)
-> StoreError
-> IO
     [(LocalAlias, LocalAlias, Maybe LocalAlias, Maybe LocalAlias,
       Maybe ImageData, Maybe GroupPreferences,
       Maybe GroupMemberAdmission)]
-> IO (Either StoreError GroupProfile)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (LocalAlias, LocalAlias, Maybe LocalAlias, Maybe LocalAlias,
 Maybe ImageData, Maybe GroupPreferences,
 Maybe GroupMemberAdmission)
-> GroupProfile
toGroupProfile (UserId -> StoreError
SEGroupNotFound UserId
groupId) (IO
   [(LocalAlias, LocalAlias, Maybe LocalAlias, Maybe LocalAlias,
     Maybe ImageData, Maybe GroupPreferences,
     Maybe GroupMemberAdmission)]
 -> IO (Either StoreError GroupProfile))
-> IO
     [(LocalAlias, LocalAlias, Maybe LocalAlias, Maybe LocalAlias,
       Maybe ImageData, Maybe GroupPreferences,
       Maybe GroupMemberAdmission)]
-> IO (Either StoreError GroupProfile)
forall a b. (a -> b) -> a -> b
$
          Connection
-> Query
-> Only UserId
-> IO
     [(LocalAlias, LocalAlias, Maybe LocalAlias, Maybe LocalAlias,
       Maybe ImageData, Maybe GroupPreferences,
       Maybe GroupMemberAdmission)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
            Connection
db
            [sql|
            SELECT gp.display_name, gp.full_name, gp.short_descr, gp.description, gp.image, gp.preferences, gp.member_admission
            FROM group_profiles gp
            JOIN groups g ON gp.group_profile_id = g.group_profile_id
            WHERE g.group_id = ?
          |]
            (UserId -> Only UserId
forall a. a -> Only a
Only UserId
groupId)
    toGroupProfile :: (LocalAlias, LocalAlias, Maybe LocalAlias, Maybe LocalAlias,
 Maybe ImageData, Maybe GroupPreferences,
 Maybe GroupMemberAdmission)
-> GroupProfile
toGroupProfile (LocalAlias
displayName, LocalAlias
fullName, Maybe LocalAlias
shortDescr, Maybe LocalAlias
description, Maybe ImageData
image, Maybe GroupPreferences
groupPreferences, Maybe GroupMemberAdmission
memberAdmission) =
      GroupProfile {LocalAlias
displayName :: LocalAlias
displayName :: LocalAlias
displayName, LocalAlias
fullName :: LocalAlias
fullName :: LocalAlias
fullName, Maybe LocalAlias
shortDescr :: Maybe LocalAlias
shortDescr :: Maybe LocalAlias
shortDescr, Maybe LocalAlias
description :: Maybe LocalAlias
description :: Maybe LocalAlias
description, Maybe ImageData
image :: Maybe ImageData
image :: Maybe ImageData
image, Maybe GroupPreferences
groupPreferences :: Maybe GroupPreferences
groupPreferences :: Maybe GroupPreferences
groupPreferences, Maybe GroupMemberAdmission
memberAdmission :: Maybe GroupMemberAdmission
memberAdmission :: Maybe GroupMemberAdmission
memberAdmission}

getGroupInfo :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO GroupInfo
getGroupInfo :: Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User {UserId
userId :: User -> UserId
userId :: UserId
userId, UserId
userContactId :: User -> UserId
userContactId :: UserId
userContactId} UserId
groupId = IO (Either StoreError GroupInfo) -> ExceptT StoreError IO GroupInfo
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError GroupInfo)
 -> ExceptT StoreError IO GroupInfo)
-> IO (Either StoreError GroupInfo)
-> ExceptT StoreError IO GroupInfo
forall a b. (a -> b) -> a -> b
$ do
  [UserId]
chatTags <- Connection -> UserId -> IO [UserId]
getGroupChatTags Connection
db UserId
groupId
  (GroupInfoRow -> GroupInfo)
-> StoreError
-> IO [GroupInfoRow]
-> IO (Either StoreError GroupInfo)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (VersionRangeChat -> UserId -> [UserId] -> GroupInfoRow -> GroupInfo
toGroupInfo VersionRangeChat
vr UserId
userContactId [UserId]
chatTags) (UserId -> StoreError
SEGroupNotFound UserId
groupId) (IO [GroupInfoRow] -> IO (Either StoreError GroupInfo))
-> IO [GroupInfoRow] -> IO (Either StoreError GroupInfo)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query -> (UserId, UserId, UserId) -> IO [GroupInfoRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      (Query
groupInfoQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE g.group_id = ? AND g.user_id = ? AND mu.contact_id = ?")
      (UserId
groupId, UserId
userId, UserId
userContactId)

getGroupInfoByUserContactLinkConnReq :: DB.Connection -> VersionRangeChat -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe GroupInfo)
getGroupInfoByUserContactLinkConnReq :: Connection
-> VersionRangeChat
-> User
-> (ConnReqContact, ConnReqContact)
-> IO (Maybe GroupInfo)
getGroupInfoByUserContactLinkConnReq Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} (ConnReqContact
cReqSchema1, ConnReqContact
cReqSchema2) = do
  -- fmap join is to support group_id = NULL if non-group contact request is sent to this function (e.g., if client data is appended).
  Maybe UserId
groupId_ <-
    (Maybe (Maybe UserId) -> Maybe UserId)
-> IO (Maybe (Maybe UserId)) -> IO (Maybe UserId)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe UserId) -> Maybe UserId
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (Maybe (Maybe UserId)) -> IO (Maybe UserId))
-> (IO [Only (Maybe UserId)] -> IO (Maybe (Maybe UserId)))
-> IO [Only (Maybe UserId)]
-> IO (Maybe UserId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only (Maybe UserId) -> Maybe UserId)
-> IO [Only (Maybe UserId)] -> IO (Maybe (Maybe UserId))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only (Maybe UserId) -> Maybe UserId
forall a. Only a -> a
fromOnly (IO [Only (Maybe UserId)] -> IO (Maybe UserId))
-> IO [Only (Maybe UserId)] -> IO (Maybe UserId)
forall a b. (a -> b) -> a -> b
$
      Connection
-> Query
-> (UserId, ConnReqContact, ConnReqContact)
-> IO [Only (Maybe UserId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT group_id
          FROM user_contact_links
          WHERE user_id = ? AND conn_req_contact IN (?,?)
        |]
        (UserId
userId, ConnReqContact
cReqSchema1, ConnReqContact
cReqSchema2)
  IO (Maybe GroupInfo)
-> (UserId -> IO (Maybe GroupInfo))
-> Maybe UserId
-> IO (Maybe GroupInfo)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe GroupInfo -> IO (Maybe GroupInfo)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe GroupInfo
forall a. Maybe a
Nothing) ((Either StoreError GroupInfo -> Maybe GroupInfo)
-> IO (Either StoreError GroupInfo) -> IO (Maybe GroupInfo)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either StoreError GroupInfo -> Maybe GroupInfo
forall a b. Either a b -> Maybe b
eitherToMaybe (IO (Either StoreError GroupInfo) -> IO (Maybe GroupInfo))
-> (UserId -> IO (Either StoreError GroupInfo))
-> UserId
-> IO (Maybe GroupInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT StoreError IO GroupInfo -> IO (Either StoreError GroupInfo)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO GroupInfo
 -> IO (Either StoreError GroupInfo))
-> (UserId -> ExceptT StoreError IO GroupInfo)
-> UserId
-> IO (Either StoreError GroupInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user) Maybe UserId
groupId_

getGroupInfoViaUserShortLink :: DB.Connection -> VersionRangeChat -> User -> ShortLinkContact -> IO (Maybe (ConnReqContact, GroupInfo))
getGroupInfoViaUserShortLink :: Connection
-> VersionRangeChat
-> User
-> ShortLinkContact
-> IO (Maybe (ConnReqContact, GroupInfo))
getGroupInfoViaUserShortLink Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} ShortLinkContact
shortLink = (Either StoreError (ConnReqContact, GroupInfo)
 -> Maybe (ConnReqContact, GroupInfo))
-> IO (Either StoreError (ConnReqContact, GroupInfo))
-> IO (Maybe (ConnReqContact, GroupInfo))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either StoreError (ConnReqContact, GroupInfo)
-> Maybe (ConnReqContact, GroupInfo)
forall a b. Either a b -> Maybe b
eitherToMaybe (IO (Either StoreError (ConnReqContact, GroupInfo))
 -> IO (Maybe (ConnReqContact, GroupInfo)))
-> IO (Either StoreError (ConnReqContact, GroupInfo))
-> IO (Maybe (ConnReqContact, GroupInfo))
forall a b. (a -> b) -> a -> b
$ ExceptT StoreError IO (ConnReqContact, GroupInfo)
-> IO (Either StoreError (ConnReqContact, GroupInfo))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO (ConnReqContact, GroupInfo)
 -> IO (Either StoreError (ConnReqContact, GroupInfo)))
-> ExceptT StoreError IO (ConnReqContact, GroupInfo)
-> IO (Either StoreError (ConnReqContact, GroupInfo))
forall a b. (a -> b) -> a -> b
$ do
  (ConnReqContact
cReq, UserId
groupId) <- IO (Either StoreError (ConnReqContact, UserId))
-> ExceptT StoreError IO (ConnReqContact, UserId)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT IO (Either StoreError (ConnReqContact, UserId))
getConnReqGroup
  (ConnReqContact
cReq,) (GroupInfo -> (ConnReqContact, GroupInfo))
-> ExceptT StoreError IO GroupInfo
-> ExceptT StoreError IO (ConnReqContact, GroupInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user UserId
groupId
  where
    getConnReqGroup :: IO (Either StoreError (ConnReqContact, UserId))
getConnReqGroup =
      ((ConnReqContact, Maybe UserId)
 -> Either StoreError (ConnReqContact, UserId))
-> StoreError
-> IO [(ConnReqContact, Maybe UserId)]
-> IO (Either StoreError (ConnReqContact, UserId))
forall a e b. (a -> Either e b) -> e -> IO [a] -> IO (Either e b)
firstRow' (ConnReqContact, Maybe UserId)
-> Either StoreError (ConnReqContact, UserId)
forall {a} {b}. (a, Maybe b) -> Either StoreError (a, b)
toConnReqGroupId (String -> StoreError
SEInternalError String
"group link not found") (IO [(ConnReqContact, Maybe UserId)]
 -> IO (Either StoreError (ConnReqContact, UserId)))
-> IO [(ConnReqContact, Maybe UserId)]
-> IO (Either StoreError (ConnReqContact, UserId))
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> (UserId, ShortLinkContact)
-> 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 short_link_contact = ?
          |]
          (UserId
userId, ShortLinkContact
shortLink)
    toConnReqGroupId :: (a, Maybe b) -> Either StoreError (a, b)
toConnReqGroupId = \case
      -- cReq is "not null", group_id is nullable
      (a
cReq, Just b
groupId) -> (a, b) -> Either StoreError (a, b)
forall a b. b -> Either a b
Right (a
cReq, b
groupId)
      (a, Maybe 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 conn req or group ID"

getGroupViaShortLinkToConnect :: DB.Connection -> VersionRangeChat -> User -> ShortLinkContact -> ExceptT StoreError IO (Maybe (ConnReqContact, GroupInfo))
getGroupViaShortLinkToConnect :: Connection
-> VersionRangeChat
-> User
-> ShortLinkContact
-> ExceptT StoreError IO (Maybe (ConnReqContact, GroupInfo))
getGroupViaShortLinkToConnect Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} ShortLinkContact
shortLink =
  IO (Maybe (UserId, Maybe ConnReqContact))
-> ExceptT StoreError IO (Maybe (UserId, Maybe ConnReqContact))
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (((UserId, Maybe ConnReqContact) -> (UserId, Maybe ConnReqContact))
-> IO [(UserId, Maybe ConnReqContact)]
-> IO (Maybe (UserId, Maybe ConnReqContact))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow (UserId, Maybe ConnReqContact) -> (UserId, Maybe ConnReqContact)
forall a. a -> a
id (IO [(UserId, Maybe ConnReqContact)]
 -> IO (Maybe (UserId, Maybe ConnReqContact)))
-> IO [(UserId, Maybe ConnReqContact)]
-> IO (Maybe (UserId, Maybe ConnReqContact))
forall a b. (a -> b) -> a -> b
$ Connection
-> Query
-> (UserId, ShortLinkContact)
-> IO [(UserId, Maybe ConnReqContact)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT group_id, conn_full_link_to_connect FROM groups WHERE user_id = ? AND conn_short_link_to_connect = ?" (UserId
userId, ShortLinkContact
shortLink)) ExceptT StoreError IO (Maybe (UserId, Maybe ConnReqContact))
-> (Maybe (UserId, Maybe ConnReqContact)
    -> ExceptT StoreError IO (Maybe (ConnReqContact, GroupInfo)))
-> ExceptT StoreError IO (Maybe (ConnReqContact, GroupInfo))
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 (UserId
gId :: Int64, Just ConnReqContact
cReq) -> (ConnReqContact, GroupInfo) -> Maybe (ConnReqContact, GroupInfo)
forall a. a -> Maybe a
Just ((ConnReqContact, GroupInfo) -> Maybe (ConnReqContact, GroupInfo))
-> (GroupInfo -> (ConnReqContact, GroupInfo))
-> GroupInfo
-> Maybe (ConnReqContact, GroupInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConnReqContact
cReq,) (GroupInfo -> Maybe (ConnReqContact, GroupInfo))
-> ExceptT StoreError IO GroupInfo
-> ExceptT StoreError IO (Maybe (ConnReqContact, GroupInfo))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user UserId
gId
    Maybe (UserId, Maybe ConnReqContact)
_ -> Maybe (ConnReqContact, GroupInfo)
-> ExceptT StoreError IO (Maybe (ConnReqContact, GroupInfo))
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ConnReqContact, GroupInfo)
forall a. Maybe a
Nothing

getGroupInfoByGroupLinkHash :: DB.Connection -> VersionRangeChat -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe GroupInfo)
getGroupInfoByGroupLinkHash :: Connection
-> VersionRangeChat
-> User
-> (ConnReqUriHash, ConnReqUriHash)
-> IO (Maybe GroupInfo)
getGroupInfoByGroupLinkHash Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId, UserId
userContactId :: User -> UserId
userContactId :: UserId
userContactId} (ConnReqUriHash
groupLinkHash1, ConnReqUriHash
groupLinkHash2) = do
  Maybe UserId
groupId_ <-
    (Only UserId -> UserId) -> IO [Only UserId] -> IO (Maybe UserId)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only UserId -> UserId
forall a. Only a -> a
fromOnly (IO [Only UserId] -> IO (Maybe UserId))
-> IO [Only UserId] -> IO (Maybe UserId)
forall a b. (a -> b) -> a -> b
$
      Connection
-> Query
-> (UserId, ConnReqUriHash, ConnReqUriHash, UserId,
    GroupMemberStatus, GroupMemberStatus, GroupMemberStatus,
    GroupMemberStatus)
-> IO [Only UserId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT g.group_id
          FROM groups g
          JOIN group_members mu ON mu.group_id = g.group_id
          WHERE g.user_id = ? AND g.via_group_link_uri_hash IN (?,?)
            AND mu.contact_id = ? AND mu.member_status NOT IN (?,?,?,?)
          LIMIT 1
        |]
        (UserId
userId, ConnReqUriHash
groupLinkHash1, ConnReqUriHash
groupLinkHash2, UserId
userContactId, GroupMemberStatus
GSMemRemoved, GroupMemberStatus
GSMemLeft, GroupMemberStatus
GSMemGroupDeleted, GroupMemberStatus
GSMemUnknown)
  IO (Maybe GroupInfo)
-> (UserId -> IO (Maybe GroupInfo))
-> Maybe UserId
-> IO (Maybe GroupInfo)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe GroupInfo -> IO (Maybe GroupInfo)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe GroupInfo
forall a. Maybe a
Nothing) ((Either StoreError GroupInfo -> Maybe GroupInfo)
-> IO (Either StoreError GroupInfo) -> IO (Maybe GroupInfo)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either StoreError GroupInfo -> Maybe GroupInfo
forall a b. Either a b -> Maybe b
eitherToMaybe (IO (Either StoreError GroupInfo) -> IO (Maybe GroupInfo))
-> (UserId -> IO (Either StoreError GroupInfo))
-> UserId
-> IO (Maybe GroupInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT StoreError IO GroupInfo -> IO (Either StoreError GroupInfo)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO GroupInfo
 -> IO (Either StoreError GroupInfo))
-> (UserId -> ExceptT StoreError IO GroupInfo)
-> UserId
-> IO (Either StoreError GroupInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user) Maybe UserId
groupId_

getGroupIdByName :: DB.Connection -> User -> GroupName -> ExceptT StoreError IO GroupId
getGroupIdByName :: Connection -> User -> LocalAlias -> ExceptT StoreError IO UserId
getGroupIdByName Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} LocalAlias
gName =
  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 (LocalAlias -> StoreError
SEGroupNotFoundByName LocalAlias
gName) (IO [Only UserId] -> ExceptT StoreError IO UserId)
-> IO [Only UserId] -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$
    Connection -> Query -> (UserId, LocalAlias) -> IO [Only UserId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT group_id FROM groups WHERE user_id = ? AND local_display_name = ?" (UserId
userId, LocalAlias
gName)

getGroupMemberIdByName :: DB.Connection -> User -> GroupId -> ContactName -> ExceptT StoreError IO GroupMemberId
getGroupMemberIdByName :: Connection
-> User -> UserId -> LocalAlias -> ExceptT StoreError IO UserId
getGroupMemberIdByName Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} UserId
groupId LocalAlias
groupMemberName =
  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 (UserId -> LocalAlias -> StoreError
SEGroupMemberNameNotFound UserId
groupId LocalAlias
groupMemberName) (IO [Only UserId] -> ExceptT StoreError IO UserId)
-> IO [Only UserId] -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query -> (UserId, UserId, LocalAlias) -> IO [Only UserId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT group_member_id FROM group_members WHERE user_id = ? AND group_id = ? AND local_display_name = ?" (UserId
userId, UserId
groupId, LocalAlias
groupMemberName)

getActiveMembersByName :: DB.Connection -> VersionRangeChat -> User -> ContactName -> ExceptT StoreError IO [(GroupInfo, GroupMember)]
getActiveMembersByName :: Connection
-> VersionRangeChat
-> User
-> LocalAlias
-> ExceptT StoreError IO [(GroupInfo, GroupMember)]
getActiveMembersByName Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} LocalAlias
groupMemberName = do
  [(UserId, UserId)]
groupMemberIds :: [(GroupId, GroupMemberId)] <-
    IO [(UserId, UserId)] -> ExceptT StoreError IO [(UserId, UserId)]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(UserId, UserId)] -> ExceptT StoreError IO [(UserId, UserId)])
-> IO [(UserId, UserId)]
-> ExceptT StoreError IO [(UserId, UserId)]
forall a b. (a -> b) -> a -> b
$
      Connection
-> Query
-> (UserId, LocalAlias, GroupMemberStatus, GroupMemberStatus,
    GroupMemberCategory)
-> IO [(UserId, UserId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT group_id, group_member_id
          FROM group_members
          WHERE user_id = ? AND local_display_name = ?
            AND member_status IN (?,?) AND member_category != ?
        |]
        (UserId
userId, LocalAlias
groupMemberName, GroupMemberStatus
GSMemConnected, GroupMemberStatus
GSMemComplete, GroupMemberCategory
GCUserMember)
  [(GroupInfo, GroupMember)]
possibleMembers <- [(UserId, UserId)]
-> ((UserId, UserId)
    -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> ExceptT StoreError IO [(GroupInfo, GroupMember)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(UserId, UserId)]
groupMemberIds (((UserId, UserId)
  -> ExceptT StoreError IO (GroupInfo, GroupMember))
 -> ExceptT StoreError IO [(GroupInfo, GroupMember)])
-> ((UserId, UserId)
    -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> ExceptT StoreError IO [(GroupInfo, GroupMember)]
forall a b. (a -> b) -> a -> b
$ \(UserId
groupId, UserId
groupMemberId) -> do
    GroupInfo
groupInfo <- Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user UserId
groupId
    GroupMember
groupMember <- Connection
-> VersionRangeChat
-> User
-> UserId
-> UserId
-> ExceptT StoreError IO GroupMember
getGroupMember Connection
db VersionRangeChat
vr User
user UserId
groupId UserId
groupMemberId
    (GroupInfo, GroupMember)
-> ExceptT StoreError IO (GroupInfo, GroupMember)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupInfo
groupInfo, GroupMember
groupMember)
  [(GroupInfo, GroupMember)]
-> ExceptT StoreError IO [(GroupInfo, GroupMember)]
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(GroupInfo, GroupMember)]
 -> ExceptT StoreError IO [(GroupInfo, GroupMember)])
-> [(GroupInfo, GroupMember)]
-> ExceptT StoreError IO [(GroupInfo, GroupMember)]
forall a b. (a -> b) -> a -> b
$ ((GroupInfo, GroupMember) -> Down UTCTime)
-> [(GroupInfo, GroupMember)] -> [(GroupInfo, GroupMember)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (UTCTime -> Down UTCTime
forall a. a -> Down a
Down (UTCTime -> Down UTCTime)
-> ((GroupInfo, GroupMember) -> UTCTime)
-> (GroupInfo, GroupMember)
-> Down UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupInfo -> UTCTime
ts (GroupInfo -> UTCTime)
-> ((GroupInfo, GroupMember) -> GroupInfo)
-> (GroupInfo, GroupMember)
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GroupInfo, GroupMember) -> GroupInfo
forall a b. (a, b) -> a
fst) [(GroupInfo, GroupMember)]
possibleMembers
  where
    ts :: GroupInfo -> UTCTime
ts GroupInfo {Maybe UTCTime
chatTs :: GroupInfo -> Maybe UTCTime
chatTs :: Maybe UTCTime
chatTs, UTCTime
updatedAt :: GroupInfo -> UTCTime
updatedAt :: UTCTime
updatedAt} = UTCTime -> Maybe UTCTime -> UTCTime
forall a. a -> Maybe a -> a
fromMaybe UTCTime
updatedAt Maybe UTCTime
chatTs

getMatchingContacts :: DB.Connection -> VersionRangeChat -> User -> Contact -> IO [Contact]
getMatchingContacts :: Connection -> VersionRangeChat -> User -> Contact -> IO [Contact]
getMatchingContacts Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} Contact {UserId
contactId :: Contact -> UserId
contactId :: UserId
contactId, profile :: Contact -> LocalProfile
profile = LocalProfile {LocalAlias
displayName :: LocalProfile -> LocalAlias
displayName :: LocalAlias
displayName, LocalAlias
fullName :: LocalAlias
fullName :: LocalProfile -> LocalAlias
fullName, Maybe LocalAlias
shortDescr :: Maybe LocalAlias
shortDescr :: LocalProfile -> Maybe LocalAlias
shortDescr, Maybe ImageData
image :: Maybe ImageData
image :: LocalProfile -> Maybe ImageData
image}} = do
  [UserId]
contactIds <- (Only UserId -> UserId) -> [Only UserId] -> [UserId]
forall a b. (a -> b) -> [a] -> [b]
map Only UserId -> UserId
forall a. Only a -> a
fromOnly ([Only UserId] -> [UserId]) -> IO [Only UserId] -> IO [UserId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (UserId, UserId, ContactStatus, LocalAlias, LocalAlias,
    Maybe LocalAlias, Maybe ImageData)
-> IO [Only UserId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
q (UserId
userId, UserId
contactId, ContactStatus
CSActive, LocalAlias
displayName, LocalAlias
fullName, Maybe LocalAlias
shortDescr, Maybe ImageData
image)
  [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
<$> (UserId -> IO (Either StoreError Contact))
-> [UserId] -> 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))
-> (UserId -> ExceptT StoreError IO Contact)
-> UserId
-> IO (Either StoreError Contact)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user) [UserId]
contactIds
  where
    -- this query is different from one in getMatchingMemberContacts
    -- it checks that it's not the same contact
    q :: Query
q =
      [sql|
        SELECT ct.contact_id
        FROM contacts ct
        JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id
        WHERE ct.user_id = ? AND ct.contact_id != ?
          AND ct.contact_status = ? AND ct.deleted = 0 AND ct.is_user = 0
          AND p.display_name = ? AND p.full_name = ?
          AND p.short_descr IS NOT DISTINCT FROM ? AND p.image IS NOT DISTINCT FROM ?
      |]

getMatchingMembers :: DB.Connection -> VersionRangeChat -> User -> Contact -> IO [GroupMember]
getMatchingMembers :: Connection
-> VersionRangeChat -> User -> Contact -> IO [GroupMember]
getMatchingMembers Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} Contact {profile :: Contact -> LocalProfile
profile = LocalProfile {LocalAlias
displayName :: LocalProfile -> LocalAlias
displayName :: LocalAlias
displayName, LocalAlias
fullName :: LocalProfile -> LocalAlias
fullName :: LocalAlias
fullName, Maybe LocalAlias
shortDescr :: LocalProfile -> Maybe LocalAlias
shortDescr :: Maybe LocalAlias
shortDescr, Maybe ImageData
image :: LocalProfile -> Maybe ImageData
image :: Maybe ImageData
image}} = do
  [UserId]
memberIds <- (Only UserId -> UserId) -> [Only UserId] -> [UserId]
forall a b. (a -> b) -> [a] -> [b]
map Only UserId -> UserId
forall a. Only a -> a
fromOnly ([Only UserId] -> [UserId]) -> IO [Only UserId] -> IO [UserId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (UserId, GroupMemberCategory, LocalAlias, LocalAlias,
    Maybe LocalAlias, Maybe ImageData)
-> IO [Only UserId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
q (UserId
userId, GroupMemberCategory
GCUserMember, LocalAlias
displayName, LocalAlias
fullName, Maybe LocalAlias
shortDescr, Maybe ImageData
image)
  (GroupMember -> Bool) -> [GroupMember] -> [GroupMember]
forall a. (a -> Bool) -> [a] -> [a]
filter GroupMember -> Bool
memberCurrent ([GroupMember] -> [GroupMember])
-> ([Either StoreError GroupMember] -> [GroupMember])
-> [Either StoreError GroupMember]
-> [GroupMember]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either StoreError GroupMember] -> [GroupMember]
forall a b. [Either a b] -> [b]
rights ([Either StoreError GroupMember] -> [GroupMember])
-> IO [Either StoreError GroupMember] -> IO [GroupMember]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UserId -> IO (Either StoreError GroupMember))
-> [UserId] -> IO [Either StoreError GroupMember]
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 GroupMember
-> IO (Either StoreError GroupMember)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO GroupMember
 -> IO (Either StoreError GroupMember))
-> (UserId -> ExceptT StoreError IO GroupMember)
-> UserId
-> IO (Either StoreError GroupMember)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupMember
getGroupMemberById Connection
db VersionRangeChat
vr User
user) [UserId]
memberIds
  where
    -- only match with members without associated contact
    q :: Query
q =
      [sql|
        SELECT m.group_member_id
        FROM group_members m
        JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
        WHERE m.user_id = ? AND m.contact_id IS NULL
          AND m.member_category != ?
          AND p.display_name = ? AND p.full_name = ?
          AND p.short_descr IS NOT DISTINCT FROM ? AND p.image IS NOT DISTINCT FROM ?
      |]

getMatchingMemberContacts :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> IO [Contact]
getMatchingMemberContacts :: Connection
-> VersionRangeChat -> User -> GroupMember -> IO [Contact]
getMatchingMemberContacts Connection
_ VersionRangeChat
_ User
_ GroupMember {memberContactId :: GroupMember -> Maybe UserId
memberContactId = Just UserId
_} = [Contact] -> IO [Contact]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
getMatchingMemberContacts Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupMember {memberProfile :: GroupMember -> LocalProfile
memberProfile = LocalProfile {LocalAlias
displayName :: LocalProfile -> LocalAlias
displayName :: LocalAlias
displayName, LocalAlias
fullName :: LocalProfile -> LocalAlias
fullName :: LocalAlias
fullName, Maybe LocalAlias
shortDescr :: LocalProfile -> Maybe LocalAlias
shortDescr :: Maybe LocalAlias
shortDescr, Maybe ImageData
image :: LocalProfile -> Maybe ImageData
image :: Maybe ImageData
image}} = do
  [UserId]
contactIds <- (Only UserId -> UserId) -> [Only UserId] -> [UserId]
forall a b. (a -> b) -> [a] -> [b]
map Only UserId -> UserId
forall a. Only a -> a
fromOnly ([Only UserId] -> [UserId]) -> IO [Only UserId] -> IO [UserId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (UserId, ContactStatus, LocalAlias, LocalAlias,
    Maybe LocalAlias, Maybe ImageData)
-> IO [Only UserId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
q (UserId
userId, ContactStatus
CSActive, LocalAlias
displayName, LocalAlias
fullName, Maybe LocalAlias
shortDescr, Maybe ImageData
image)
  [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
<$> (UserId -> IO (Either StoreError Contact))
-> [UserId] -> 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))
-> (UserId -> ExceptT StoreError IO Contact)
-> UserId
-> IO (Either StoreError Contact)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user) [UserId]
contactIds
  where
    q :: Query
q =
      [sql|
        SELECT ct.contact_id
        FROM contacts ct
        JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id
        WHERE ct.user_id = ?
          AND ct.contact_status = ? AND ct.deleted = 0 AND ct.is_user = 0
          AND p.display_name = ? AND p.full_name = ?
          AND p.short_descr IS NOT DISTINCT FROM ? AND p.image IS NOT DISTINCT FROM ?
      |]

createSentProbe :: DB.Connection -> TVar ChaChaDRG -> UserId -> ContactOrMember -> ExceptT StoreError IO (Probe, Int64)
createSentProbe :: Connection
-> TVar ChaChaDRG
-> UserId
-> ContactOrMember
-> ExceptT StoreError IO (Probe, UserId)
createSentProbe Connection
db TVar ChaChaDRG
gVar UserId
userId ContactOrMember
to =
  Int
-> TVar ChaChaDRG
-> (ConnId -> IO (Probe, UserId))
-> ExceptT StoreError IO (Probe, UserId)
forall a.
Int
-> TVar ChaChaDRG -> (ConnId -> IO a) -> ExceptT StoreError IO a
createWithRandomBytes Int
32 TVar ChaChaDRG
gVar ((ConnId -> IO (Probe, UserId))
 -> ExceptT StoreError IO (Probe, UserId))
-> (ConnId -> IO (Probe, UserId))
-> ExceptT StoreError IO (Probe, UserId)
forall a b. (a -> b) -> a -> b
$ \ConnId
probe -> do
    UTCTime
currentTs <- IO UTCTime
getCurrentTime
    let (Maybe UserId
ctId, Maybe UserId
gmId) = ContactOrMember -> (Maybe UserId, Maybe UserId)
contactOrMemberIds ContactOrMember
to
    Connection
-> Query
-> (Maybe UserId, Maybe UserId, Binary ConnId, UserId, UTCTime,
    UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      Query
"INSERT INTO sent_probes (contact_id, group_member_id, probe, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
      (Maybe UserId
ctId, Maybe UserId
gmId, ConnId -> Binary ConnId
forall a. a -> Binary a
Binary ConnId
probe, UserId
userId, UTCTime
currentTs, UTCTime
currentTs)
    (ConnId -> Probe
Probe ConnId
probe,) (UserId -> (Probe, UserId)) -> IO UserId -> IO (Probe, UserId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> IO UserId
insertedRowId Connection
db

createSentProbeHash :: DB.Connection -> UserId -> Int64 -> ContactOrMember -> IO ()
createSentProbeHash :: Connection -> UserId -> UserId -> ContactOrMember -> IO ()
createSentProbeHash Connection
db UserId
userId UserId
probeId ContactOrMember
to = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  let (Maybe UserId
ctId, Maybe UserId
gmId) = ContactOrMember -> (Maybe UserId, Maybe UserId)
contactOrMemberIds ContactOrMember
to
  Connection
-> Query
-> (UserId, Maybe UserId, Maybe UserId, UserId, UTCTime, UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"INSERT INTO sent_probe_hashes (sent_probe_id, contact_id, group_member_id, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
    (UserId
probeId, Maybe UserId
ctId, Maybe UserId
gmId, UserId
userId, UTCTime
currentTs, UTCTime
currentTs)

matchReceivedProbe :: DB.Connection -> VersionRangeChat -> User -> ContactOrMember -> Probe -> IO [ContactOrMember]
matchReceivedProbe :: Connection
-> VersionRangeChat
-> User
-> ContactOrMember
-> Probe
-> IO [ContactOrMember]
matchReceivedProbe Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} ContactOrMember
from (Probe ConnId
probe) = do
  let probeHash :: ConnId
probeHash = ConnId -> ConnId
C.sha256Hash ConnId
probe
  [(Maybe UserId, Maybe UserId, Maybe UserId)]
cgmIds <-
    Connection
-> Query
-> (UserId, Binary ConnId)
-> IO [(Maybe UserId, Maybe UserId, Maybe UserId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT r.contact_id, g.group_id, r.group_member_id
        FROM received_probes r
        LEFT JOIN contacts c ON r.contact_id = c.contact_id AND c.deleted = 0
        LEFT JOIN group_members m ON r.group_member_id = m.group_member_id
        LEFT JOIN groups g ON g.group_id = m.group_id
        WHERE r.user_id = ? AND r.probe_hash = ? AND r.probe IS NULL
      |]
      (UserId
userId, ConnId -> Binary ConnId
forall a. a -> Binary a
Binary ConnId
probeHash)
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  let (Maybe UserId
ctId, Maybe UserId
gmId) = ContactOrMember -> (Maybe UserId, Maybe UserId)
contactOrMemberIds ContactOrMember
from
  Connection
-> Query
-> (Maybe UserId, Maybe UserId, Binary ConnId, Binary ConnId,
    UserId, UTCTime, UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"INSERT INTO received_probes (contact_id, group_member_id, probe, probe_hash, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
    (Maybe UserId
ctId, Maybe UserId
gmId, ConnId -> Binary ConnId
forall a. a -> Binary a
Binary ConnId
probe, ConnId -> Binary ConnId
forall a. a -> Binary a
Binary ConnId
probeHash, UserId
userId, UTCTime
currentTs, UTCTime
currentTs)
  let cgmIds' :: [(Maybe UserId, Maybe UserId, Maybe UserId)]
cgmIds' = [(Maybe UserId, Maybe UserId, Maybe UserId)]
-> [(Maybe UserId, Maybe UserId, Maybe UserId)]
filterFirstContactId [(Maybe UserId, Maybe UserId, Maybe UserId)]
cgmIds
  [Maybe ContactOrMember] -> [ContactOrMember]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ContactOrMember] -> [ContactOrMember])
-> IO [Maybe ContactOrMember] -> IO [ContactOrMember]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Maybe UserId, Maybe UserId, Maybe UserId)
 -> IO (Maybe ContactOrMember))
-> [(Maybe UserId, Maybe UserId, Maybe UserId)]
-> IO [Maybe ContactOrMember]
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 (Connection
-> VersionRangeChat
-> User
-> (Maybe UserId, Maybe UserId, Maybe UserId)
-> IO (Maybe ContactOrMember)
getContactOrMember_ Connection
db VersionRangeChat
vr User
user) [(Maybe UserId, Maybe UserId, Maybe UserId)]
cgmIds'
  where
    filterFirstContactId :: [(Maybe ContactId, Maybe GroupId, Maybe GroupMemberId)] -> [(Maybe ContactId, Maybe GroupId, Maybe GroupMemberId)]
    filterFirstContactId :: [(Maybe UserId, Maybe UserId, Maybe UserId)]
-> [(Maybe UserId, Maybe UserId, Maybe UserId)]
filterFirstContactId [(Maybe UserId, Maybe UserId, Maybe UserId)]
cgmIds = do
      let ([(Maybe UserId, Maybe UserId, Maybe UserId)]
ctIds, [(Maybe UserId, Maybe UserId, Maybe UserId)]
memIds) = ((Maybe UserId, Maybe UserId, Maybe UserId) -> Bool)
-> [(Maybe UserId, Maybe UserId, Maybe UserId)]
-> ([(Maybe UserId, Maybe UserId, Maybe UserId)],
    [(Maybe UserId, Maybe UserId, Maybe UserId)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(Maybe UserId
ctId, Maybe UserId
_, Maybe UserId
_) -> Maybe UserId -> Bool
forall a. Maybe a -> Bool
isJust Maybe UserId
ctId) [(Maybe UserId, Maybe UserId, Maybe UserId)]
cgmIds
          ctIds' :: [(Maybe UserId, Maybe UserId, Maybe UserId)]
ctIds' = case [(Maybe UserId, Maybe UserId, Maybe UserId)]
ctIds of
            [] -> []
            ((Maybe UserId, Maybe UserId, Maybe UserId)
x : [(Maybe UserId, Maybe UserId, Maybe UserId)]
_) -> [(Maybe UserId, Maybe UserId, Maybe UserId)
x]
      [(Maybe UserId, Maybe UserId, Maybe UserId)]
ctIds' [(Maybe UserId, Maybe UserId, Maybe UserId)]
-> [(Maybe UserId, Maybe UserId, Maybe UserId)]
-> [(Maybe UserId, Maybe UserId, Maybe UserId)]
forall a. Semigroup a => a -> a -> a
<> [(Maybe UserId, Maybe UserId, Maybe UserId)]
memIds

matchReceivedProbeHash :: DB.Connection -> VersionRangeChat -> User -> ContactOrMember -> ProbeHash -> IO (Maybe (ContactOrMember, Probe))
matchReceivedProbeHash :: Connection
-> VersionRangeChat
-> User
-> ContactOrMember
-> ProbeHash
-> IO (Maybe (ContactOrMember, Probe))
matchReceivedProbeHash Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} ContactOrMember
from (ProbeHash ConnId
probeHash) = do
  Maybe (Only ConnId :. (Maybe UserId, Maybe UserId, Maybe UserId))
probeIds <-
    ((Only ConnId :. (Maybe UserId, Maybe UserId, Maybe UserId))
 -> Only ConnId :. (Maybe UserId, Maybe UserId, Maybe UserId))
-> IO [Only ConnId :. (Maybe UserId, Maybe UserId, Maybe UserId)]
-> IO
     (Maybe (Only ConnId :. (Maybe UserId, Maybe UserId, Maybe UserId)))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow (Only ConnId :. (Maybe UserId, Maybe UserId, Maybe UserId))
-> Only ConnId :. (Maybe UserId, Maybe UserId, Maybe UserId)
forall a. a -> a
id (IO [Only ConnId :. (Maybe UserId, Maybe UserId, Maybe UserId)]
 -> IO
      (Maybe
         (Only ConnId :. (Maybe UserId, Maybe UserId, Maybe UserId))))
-> IO [Only ConnId :. (Maybe UserId, Maybe UserId, Maybe UserId)]
-> IO
     (Maybe (Only ConnId :. (Maybe UserId, Maybe UserId, Maybe UserId)))
forall a b. (a -> b) -> a -> b
$
      Connection
-> Query
-> (UserId, Binary ConnId)
-> IO [Only ConnId :. (Maybe UserId, Maybe UserId, Maybe UserId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT r.probe, r.contact_id, g.group_id, r.group_member_id
          FROM received_probes r
          LEFT JOIN contacts c ON r.contact_id = c.contact_id AND c.deleted = 0
          LEFT JOIN group_members m ON r.group_member_id = m.group_member_id
          LEFT JOIN groups g ON g.group_id = m.group_id
          WHERE r.user_id = ? AND r.probe_hash = ? AND r.probe IS NOT NULL
        |]
        (UserId
userId, ConnId -> Binary ConnId
forall a. a -> Binary a
Binary ConnId
probeHash)
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  let (Maybe UserId
ctId, Maybe UserId
gmId) = ContactOrMember -> (Maybe UserId, Maybe UserId)
contactOrMemberIds ContactOrMember
from
  Connection
-> Query
-> (Maybe UserId, Maybe UserId, Binary ConnId, UserId, UTCTime,
    UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"INSERT INTO received_probes (contact_id, group_member_id, probe_hash, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
    (Maybe UserId
ctId, Maybe UserId
gmId, ConnId -> Binary ConnId
forall a. a -> Binary a
Binary ConnId
probeHash, UserId
userId, UTCTime
currentTs, UTCTime
currentTs)
  Maybe (Only ConnId :. (Maybe UserId, Maybe UserId, Maybe UserId))
-> IO
     (Maybe (Only ConnId :. (Maybe UserId, Maybe UserId, Maybe UserId)))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Only ConnId :. (Maybe UserId, Maybe UserId, Maybe UserId))
probeIds IO
  (Maybe (Only ConnId :. (Maybe UserId, Maybe UserId, Maybe UserId)))
-> ((Only ConnId :. (Maybe UserId, Maybe UserId, Maybe UserId))
    -> IO (Maybe (ContactOrMember, Probe)))
-> IO (Maybe (ContactOrMember, Probe))
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Monad f, Traversable f) =>
m (f a) -> (a -> m (f b)) -> m (f b)
$>>= \(Only ConnId
probe :. (Maybe UserId, Maybe UserId, Maybe UserId)
cgmIds) -> (,ConnId -> Probe
Probe ConnId
probe) (ContactOrMember -> (ContactOrMember, Probe))
-> IO (Maybe ContactOrMember)
-> IO (Maybe (ContactOrMember, Probe))
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> Connection
-> VersionRangeChat
-> User
-> (Maybe UserId, Maybe UserId, Maybe UserId)
-> IO (Maybe ContactOrMember)
getContactOrMember_ Connection
db VersionRangeChat
vr User
user (Maybe UserId, Maybe UserId, Maybe UserId)
cgmIds

matchSentProbe :: DB.Connection -> VersionRangeChat -> User -> ContactOrMember -> Probe -> IO (Maybe ContactOrMember)
matchSentProbe :: Connection
-> VersionRangeChat
-> User
-> ContactOrMember
-> Probe
-> IO (Maybe ContactOrMember)
matchSentProbe Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} ContactOrMember
_from (Probe ConnId
probe) = do
  IO (Maybe (Maybe UserId, Maybe UserId, Maybe UserId))
cgmIds IO (Maybe (Maybe UserId, Maybe UserId, Maybe UserId))
-> ((Maybe UserId, Maybe UserId, Maybe UserId)
    -> IO (Maybe ContactOrMember))
-> IO (Maybe ContactOrMember)
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Monad f, Traversable f) =>
m (f a) -> (a -> m (f b)) -> m (f b)
$>>= Connection
-> VersionRangeChat
-> User
-> (Maybe UserId, Maybe UserId, Maybe UserId)
-> IO (Maybe ContactOrMember)
getContactOrMember_ Connection
db VersionRangeChat
vr User
user
  where
    (Maybe UserId
ctId, Maybe UserId
gmId) = ContactOrMember -> (Maybe UserId, Maybe UserId)
contactOrMemberIds ContactOrMember
_from
    cgmIds :: IO (Maybe (Maybe UserId, Maybe UserId, Maybe UserId))
cgmIds =
      ((Maybe UserId, Maybe UserId, Maybe UserId)
 -> (Maybe UserId, Maybe UserId, Maybe UserId))
-> IO [(Maybe UserId, Maybe UserId, Maybe UserId)]
-> IO (Maybe (Maybe UserId, Maybe UserId, Maybe UserId))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow (Maybe UserId, Maybe UserId, Maybe UserId)
-> (Maybe UserId, Maybe UserId, Maybe UserId)
forall a. a -> a
id (IO [(Maybe UserId, Maybe UserId, Maybe UserId)]
 -> IO (Maybe (Maybe UserId, Maybe UserId, Maybe UserId)))
-> IO [(Maybe UserId, Maybe UserId, Maybe UserId)]
-> IO (Maybe (Maybe UserId, Maybe UserId, Maybe UserId))
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> (UserId, Binary ConnId, Maybe UserId, Maybe UserId)
-> IO [(Maybe UserId, Maybe UserId, Maybe UserId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT s.contact_id, g.group_id, s.group_member_id
            FROM sent_probes s
            LEFT JOIN contacts c ON s.contact_id = c.contact_id AND c.deleted = 0
            LEFT JOIN group_members m ON s.group_member_id = m.group_member_id
            LEFT JOIN groups g ON g.group_id = m.group_id
            JOIN sent_probe_hashes h ON h.sent_probe_id = s.sent_probe_id
            WHERE s.user_id = ? AND s.probe = ?
              AND (h.contact_id = ? OR h.group_member_id = ?)
          |]
          (UserId
userId, ConnId -> Binary ConnId
forall a. a -> Binary a
Binary ConnId
probe, Maybe UserId
ctId, Maybe UserId
gmId)

getContactOrMember_ :: DB.Connection -> VersionRangeChat -> User -> (Maybe ContactId, Maybe GroupId, Maybe GroupMemberId) -> IO (Maybe ContactOrMember)
getContactOrMember_ :: Connection
-> VersionRangeChat
-> User
-> (Maybe UserId, Maybe UserId, Maybe UserId)
-> IO (Maybe ContactOrMember)
getContactOrMember_ Connection
db VersionRangeChat
vr User
user (Maybe UserId, Maybe UserId, Maybe UserId)
ids =
  (Either StoreError ContactOrMember -> Maybe ContactOrMember)
-> IO (Either StoreError ContactOrMember)
-> IO (Maybe ContactOrMember)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either StoreError ContactOrMember -> Maybe ContactOrMember
forall a b. Either a b -> Maybe b
eitherToMaybe (IO (Either StoreError ContactOrMember)
 -> IO (Maybe ContactOrMember))
-> (ExceptT StoreError IO ContactOrMember
    -> IO (Either StoreError ContactOrMember))
-> ExceptT StoreError IO ContactOrMember
-> IO (Maybe ContactOrMember)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT StoreError IO ContactOrMember
-> IO (Either StoreError ContactOrMember)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO ContactOrMember
 -> IO (Maybe ContactOrMember))
-> ExceptT StoreError IO ContactOrMember
-> IO (Maybe ContactOrMember)
forall a b. (a -> b) -> a -> b
$ case (Maybe UserId, Maybe UserId, Maybe UserId)
ids of
    (Just UserId
ctId, Maybe UserId
_, Maybe UserId
_) -> Contact -> ContactOrMember
COMContact (Contact -> ContactOrMember)
-> ExceptT StoreError IO Contact
-> ExceptT StoreError IO ContactOrMember
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user UserId
ctId
    (Maybe UserId
_, Just UserId
gId, Just UserId
gmId) -> GroupMember -> ContactOrMember
COMGroupMember (GroupMember -> ContactOrMember)
-> ExceptT StoreError IO GroupMember
-> ExceptT StoreError IO ContactOrMember
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> UserId
-> UserId
-> ExceptT StoreError IO GroupMember
getGroupMember Connection
db VersionRangeChat
vr User
user UserId
gId UserId
gmId
    (Maybe UserId, Maybe UserId, Maybe UserId)
_ -> StoreError -> ExceptT StoreError IO ContactOrMember
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO ContactOrMember)
-> StoreError -> ExceptT StoreError IO ContactOrMember
forall a b. (a -> b) -> a -> b
$ String -> StoreError
SEInternalError String
""

associateMemberWithContactRecord :: DB.Connection -> User -> Contact -> GroupMember -> IO ()
associateMemberWithContactRecord :: Connection -> User -> Contact -> GroupMember -> IO ()
associateMemberWithContactRecord
  Connection
db
  User {UserId
userId :: User -> UserId
userId :: UserId
userId}
  Contact {UserId
contactId :: Contact -> UserId
contactId :: UserId
contactId, LocalAlias
localDisplayName :: Contact -> LocalAlias
localDisplayName :: LocalAlias
localDisplayName, profile :: Contact -> LocalProfile
profile = LocalProfile {UserId
profileId :: LocalProfile -> UserId
profileId :: UserId
profileId}}
  GroupMember {UserId
groupId :: GroupMember -> UserId
groupId :: UserId
groupId, UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId, localDisplayName :: GroupMember -> LocalAlias
localDisplayName = LocalAlias
memLDN, memberProfile :: GroupMember -> LocalProfile
memberProfile = LocalProfile {profileId :: LocalProfile -> UserId
profileId = UserId
memProfileId}} = do
    UTCTime
currentTs <- IO UTCTime
getCurrentTime
    Connection
-> Query
-> (UserId, LocalAlias, UserId, UTCTime, UserId, UserId, UserId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      [sql|
        UPDATE group_members
        SET contact_id = ?, local_display_name = ?, contact_profile_id = ?, updated_at = ?
        WHERE user_id = ? AND group_id = ? AND group_member_id = ?
      |]
      (UserId
contactId, LocalAlias
localDisplayName, UserId
profileId, UTCTime
currentTs, UserId
userId, UserId
groupId, UserId
groupMemberId)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UserId
memProfileId UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
/= UserId
profileId) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> UserId -> UserId -> IO ()
deleteUnusedProfile_ Connection
db UserId
userId UserId
memProfileId
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LocalAlias
memLDN LocalAlias -> LocalAlias -> Bool
forall a. Eq a => a -> a -> Bool
/= LocalAlias
localDisplayName) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> UserId -> LocalAlias -> IO ()
deleteUnusedDisplayName_ Connection
db UserId
userId LocalAlias
memLDN

associateContactWithMemberRecord :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> Contact -> ExceptT StoreError IO Contact
associateContactWithMemberRecord :: Connection
-> VersionRangeChat
-> User
-> GroupMember
-> Contact
-> ExceptT StoreError IO Contact
associateContactWithMemberRecord
  Connection
db
  VersionRangeChat
vr
  user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId}
  GroupMember {UserId
groupId :: GroupMember -> UserId
groupId :: UserId
groupId, UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId, localDisplayName :: GroupMember -> LocalAlias
localDisplayName = LocalAlias
memLDN, memberProfile :: GroupMember -> LocalProfile
memberProfile = LocalProfile {profileId :: LocalProfile -> UserId
profileId = UserId
memProfileId}}
  Contact {UserId
contactId :: Contact -> UserId
contactId :: UserId
contactId, LocalAlias
localDisplayName :: Contact -> LocalAlias
localDisplayName :: LocalAlias
localDisplayName, profile :: Contact -> LocalProfile
profile = LocalProfile {UserId
profileId :: LocalProfile -> UserId
profileId :: UserId
profileId}} = 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
      Connection
-> Query -> (UserId, UTCTime, UserId, UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        [sql|
          UPDATE group_members
          SET contact_id = ?, updated_at = ?
          WHERE user_id = ? AND group_id = ? AND group_member_id = ?
        |]
        (UserId
contactId, UTCTime
currentTs, UserId
userId, UserId
groupId, UserId
groupMemberId)
      Connection
-> Query -> (LocalAlias, UserId, UTCTime, UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        [sql|
          UPDATE contacts
          SET local_display_name = ?, contact_profile_id = ?, updated_at = ?
          WHERE user_id = ? AND contact_id = ?
        |]
        (LocalAlias
memLDN, UserId
memProfileId, UTCTime
currentTs, UserId
userId, UserId
contactId)
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UserId
profileId UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
/= UserId
memProfileId) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> UserId -> UserId -> IO ()
deleteUnusedProfile_ Connection
db UserId
userId UserId
profileId
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LocalAlias
localDisplayName LocalAlias -> LocalAlias -> Bool
forall a. Eq a => a -> a -> Bool
/= LocalAlias
memLDN) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> UserId -> LocalAlias -> IO ()
deleteUnusedDisplayName_ Connection
db UserId
userId LocalAlias
localDisplayName
    Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user UserId
contactId

deleteUnusedDisplayName_ :: DB.Connection -> UserId -> ContactName -> IO ()
deleteUnusedDisplayName_ :: Connection -> UserId -> LocalAlias -> IO ()
deleteUnusedDisplayName_ Connection
db UserId
userId LocalAlias
localDisplayName =
  Connection
-> Query
-> ((UserId, LocalAlias, LocalAlias, UserId, LocalAlias, UserId,
     LocalAlias)
    :. ((UserId, LocalAlias, UserId, LocalAlias, UserId, LocalAlias)
        :. (UserId, LocalAlias)))
-> 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 = ?
        AND 1 NOT IN (
          SELECT 1 FROM users
          WHERE local_display_name = ? LIMIT 1
        )
        AND 1 NOT IN (
          SELECT 1 FROM contacts
          WHERE user_id = ? AND local_display_name = ? LIMIT 1
        )
        AND 1 NOT IN (
          SELECT 1 FROM groups
          WHERE user_id = ? AND local_display_name = ? LIMIT 1
        )
        AND 1 NOT IN (
          SELECT 1 FROM group_members
          WHERE user_id = ? AND local_display_name = ? LIMIT 1
        )
        AND 1 NOT IN (
          SELECT 1 FROM user_contact_links
          WHERE user_id = ? AND local_display_name = ? LIMIT 1
        )
        AND 1 NOT IN (
          SELECT 1 FROM contact_requests
          WHERE user_id = ? AND local_display_name = ? LIMIT 1
        )
        AND 1 NOT IN (
          SELECT 1 FROM contact_requests
          WHERE user_id = ? AND local_display_name = ? LIMIT 1
        )
    |]
    ( (UserId
userId, LocalAlias
localDisplayName, LocalAlias
localDisplayName, UserId
userId, LocalAlias
localDisplayName, UserId
userId, LocalAlias
localDisplayName)
        (UserId, LocalAlias, LocalAlias, UserId, LocalAlias, UserId,
 LocalAlias)
-> ((UserId, LocalAlias, UserId, LocalAlias, UserId, LocalAlias)
    :. (UserId, LocalAlias))
-> (UserId, LocalAlias, LocalAlias, UserId, LocalAlias, UserId,
    LocalAlias)
   :. ((UserId, LocalAlias, UserId, LocalAlias, UserId, LocalAlias)
       :. (UserId, LocalAlias))
forall h t. h -> t -> h :. t
:. (UserId
userId, LocalAlias
localDisplayName, UserId
userId, LocalAlias
localDisplayName, UserId
userId, LocalAlias
localDisplayName)
        (UserId, LocalAlias, UserId, LocalAlias, UserId, LocalAlias)
-> (UserId, LocalAlias)
-> (UserId, LocalAlias, UserId, LocalAlias, UserId, LocalAlias)
   :. (UserId, LocalAlias)
forall h t. h -> t -> h :. t
:. (UserId
userId, LocalAlias
localDisplayName)
    )

deleteOldProbes :: DB.Connection -> UTCTime -> IO ()
deleteOldProbes :: Connection -> UTCTime -> IO ()
deleteOldProbes Connection
db UTCTime
createdAtCutoff = do
  Connection -> Query -> Only UTCTime -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM sent_probes WHERE created_at <= ?" (UTCTime -> Only UTCTime
forall a. a -> Only a
Only UTCTime
createdAtCutoff)
  Connection -> Query -> Only UTCTime -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM sent_probe_hashes WHERE created_at <= ?" (UTCTime -> Only UTCTime
forall a. a -> Only a
Only UTCTime
createdAtCutoff)
  Connection -> Query -> Only UTCTime -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM received_probes WHERE created_at <= ?" (UTCTime -> Only UTCTime
forall a. a -> Only a
Only UTCTime
createdAtCutoff)

updateGroupSettings :: DB.Connection -> User -> Int64 -> ChatSettings -> IO ()
updateGroupSettings :: Connection -> User -> UserId -> ChatSettings -> IO ()
updateGroupSettings Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} UserId
groupId ChatSettings {MsgFilter
enableNtfs :: ChatSettings -> MsgFilter
enableNtfs :: MsgFilter
enableNtfs, Maybe Bool
sendRcpts :: ChatSettings -> Maybe Bool
sendRcpts :: Maybe Bool
sendRcpts, Bool
favorite :: ChatSettings -> Bool
favorite :: Bool
favorite} =
  Connection
-> Query
-> (MsgFilter, Maybe BoolInt, BoolInt, UserId, UserId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE groups SET enable_ntfs = ?, send_rcpts = ?, favorite = ? WHERE user_id = ? AND group_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, UserId
userId, UserId
groupId)

updateGroupMemberSettings :: DB.Connection -> User -> GroupId -> GroupMemberId -> GroupMemberSettings -> IO ()
updateGroupMemberSettings :: Connection
-> User -> UserId -> UserId -> GroupMemberSettings -> IO ()
updateGroupMemberSettings Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} UserId
gId UserId
gMemberId GroupMemberSettings {Bool
showMessages :: Bool
showMessages :: GroupMemberSettings -> Bool
showMessages} = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection
-> Query -> (BoolInt, UTCTime, UserId, UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE group_members
      SET show_messages = ?, updated_at = ?
      WHERE user_id = ? AND group_id = ? AND group_member_id = ?
    |]
    (Bool -> BoolInt
BI Bool
showMessages, UTCTime
currentTs, UserId
userId, UserId
gId, UserId
gMemberId)

updateGroupMemberBlocked :: DB.Connection -> User -> GroupInfo -> MemberRestrictionStatus -> GroupMember -> IO GroupMember
updateGroupMemberBlocked :: Connection
-> User
-> GroupInfo
-> MemberRestrictionStatus
-> GroupMember
-> IO GroupMember
updateGroupMemberBlocked Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} MemberRestrictionStatus
mrs m :: GroupMember
m@GroupMember {UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId} = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection
-> Query
-> (MemberRestrictionStatus, UTCTime, UserId, UserId, UserId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE group_members
      SET member_restriction = ?, updated_at = ?
      WHERE user_id = ? AND group_id = ? AND group_member_id = ?
    |]
    (MemberRestrictionStatus
mrs, UTCTime
currentTs, UserId
userId, UserId
groupId, UserId
groupMemberId)
  GroupMember -> IO GroupMember
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupMember
m {blockedByAdmin = mrsBlocked mrs}

getHostConnId :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO GroupMemberId
getHostConnId :: Connection -> User -> UserId -> ExceptT StoreError IO UserId
getHostConnId Connection
db user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} UserId
groupId = do
  UserId
hostMemberId <- Connection -> User -> UserId -> ExceptT StoreError IO UserId
getHostMemberId_ Connection
db User
user UserId
groupId
  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 (UserId -> StoreError
SEConnectionNotFoundByMemberId UserId
hostMemberId) (IO [Only UserId] -> ExceptT StoreError IO UserId)
-> IO [Only UserId] -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$
    Connection -> Query -> (UserId, UserId) -> IO [Only UserId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT connection_id FROM connections WHERE user_id = ? AND group_member_id = ?" (UserId
userId, UserId
hostMemberId)

createMemberContact :: DB.Connection -> User -> ConnId -> ConnReqInvitation -> GroupInfo -> GroupMember -> Connection -> SubscriptionMode -> IO Contact
createMemberContact :: Connection
-> User
-> ConnId
-> ConnReqInvitation
-> GroupInfo
-> GroupMember
-> Connection
-> SubscriptionMode
-> IO Contact
createMemberContact
  Connection
db
  user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId, profile :: User -> LocalProfile
profile = LocalProfile {Maybe Preferences
preferences :: Maybe Preferences
preferences :: LocalProfile -> Maybe Preferences
preferences}}
  ConnId
acId
  ConnReqInvitation
cReq
  GroupInfo
gInfo
  GroupMember {UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId, LocalAlias
localDisplayName :: GroupMember -> LocalAlias
localDisplayName :: LocalAlias
localDisplayName, LocalProfile
memberProfile :: GroupMember -> LocalProfile
memberProfile :: LocalProfile
memberProfile, UserId
memberContactProfileId :: GroupMember -> UserId
memberContactProfileId :: UserId
memberContactProfileId}
  Connection {Int
connLevel :: Connection -> Int
connLevel :: Int
connLevel, VersionChat
connChatVersion :: Connection -> VersionChat
connChatVersion :: VersionChat
connChatVersion, peerChatVRange :: Connection -> VersionRangeChat
peerChatVRange = peerChatVRange :: VersionRangeChat
peerChatVRange@(VersionRange VersionChat
minV VersionChat
maxV)}
  SubscriptionMode
subMode = do
    UTCTime
currentTs <- IO UTCTime
getCurrentTime
    let incognitoProfile :: Maybe LocalProfile
incognitoProfile = GroupInfo -> Maybe LocalProfile
incognitoMembershipProfile GroupInfo
gInfo
        customUserProfileId :: Maybe UserId
customUserProfileId = LocalProfile -> UserId
localProfileId (LocalProfile -> UserId) -> Maybe LocalProfile -> Maybe UserId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocalProfile
incognitoProfile
        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 LocalProfile
incognitoProfile Maybe LocalProfile -> 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
-> ((UserId, LocalAlias, UserId, BoolInt, Preferences, BoolInt)
    :. (UserId, BoolInt, UTCTime, UTCTime, UTCTime))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      [sql|
        INSERT INTO contacts (
          user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, contact_used,
          contact_group_member_id, contact_grp_inv_sent, created_at, updated_at, chat_ts
        ) VALUES (?,?,?,?,?,?,?,?,?,?,?)
      |]
      ( (UserId
userId, LocalAlias
localDisplayName, UserId
memberContactProfileId, Bool -> BoolInt
BI Bool
True, Preferences
userPreferences, Bool -> BoolInt
BI Bool
True)
          (UserId, LocalAlias, UserId, BoolInt, Preferences, BoolInt)
-> (UserId, BoolInt, UTCTime, UTCTime, UTCTime)
-> (UserId, LocalAlias, UserId, BoolInt, Preferences, BoolInt)
   :. (UserId, BoolInt, UTCTime, UTCTime, UTCTime)
forall h t. h -> t -> h :. t
:. (UserId
groupMemberId, Bool -> BoolInt
BI Bool
False, UTCTime
currentTs, UTCTime
currentTs, UTCTime
currentTs)
      )
    UserId
contactId <- Connection -> IO UserId
insertedRowId Connection
db
    Connection -> Query -> (UserId, UTCTime, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      Query
"UPDATE group_members SET contact_id = ?, updated_at = ? WHERE contact_profile_id = ?"
      (UserId
contactId, UTCTime
currentTs, UserId
memberContactProfileId)
    Connection
-> Query
-> ((UserId, ConnId, ConnReqInvitation, Int, ConnStatus, ConnType,
     BoolInt, UserId, Maybe UserId)
    :. (VersionChat, VersionChat, VersionChat, UTCTime, UTCTime,
        BoolInt))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute -- why do we insert conn_req_inv here? how is it used?
      Connection
db
      [sql|
        INSERT INTO connections (
          user_id, agent_conn_id, conn_req_inv, conn_level, conn_status, conn_type, contact_conn_initiated, contact_id, custom_user_profile_id,
          conn_chat_version, peer_chat_min_version, peer_chat_max_version, created_at, updated_at, to_subscribe
        ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
      |]
      ( (UserId
userId, ConnId
acId, ConnReqInvitation
cReq, Int
connLevel, ConnStatus
ConnNew, ConnType
ConnContact, Bool -> BoolInt
BI Bool
True, UserId
contactId, Maybe UserId
customUserProfileId)
          (UserId, ConnId, ConnReqInvitation, Int, ConnStatus, ConnType,
 BoolInt, UserId, Maybe UserId)
-> (VersionChat, VersionChat, VersionChat, UTCTime, UTCTime,
    BoolInt)
-> (UserId, ConnId, ConnReqInvitation, Int, ConnStatus, ConnType,
    BoolInt, UserId, Maybe UserId)
   :. (VersionChat, VersionChat, VersionChat, UTCTime, UTCTime,
       BoolInt)
forall h t. h -> t -> h :. t
:. (VersionChat
connChatVersion, VersionChat
minV, VersionChat
maxV, UTCTime
currentTs, UTCTime
currentTs, Bool -> BoolInt
BI (SubscriptionMode
subMode SubscriptionMode -> SubscriptionMode -> Bool
forall a. Eq a => a -> a -> Bool
== SubscriptionMode
SMOnlyCreate))
      )
    UserId
connId <- Connection -> IO UserId
insertedRowId Connection
db
    let ctConn :: Connection
ctConn =
          Connection
            { UserId
connId :: UserId
connId :: UserId
connId,
              agentConnId :: AgentConnId
agentConnId = ConnId -> AgentConnId
AgentConnId ConnId
acId,
              VersionRangeChat
peerChatVRange :: VersionRangeChat
peerChatVRange :: VersionRangeChat
peerChatVRange,
              VersionChat
connChatVersion :: VersionChat
connChatVersion :: VersionChat
connChatVersion,
              connType :: ConnType
connType = ConnType
ConnContact,
              contactConnInitiated :: Bool
contactConnInitiated = Bool
True,
              entityId :: Maybe UserId
entityId = UserId -> Maybe UserId
forall a. a -> Maybe a
Just UserId
contactId,
              viaContact :: Maybe UserId
viaContact = Maybe UserId
forall a. Maybe a
Nothing,
              viaUserContactLink :: Maybe UserId
viaUserContactLink = Maybe UserId
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 UserId
customUserProfileId :: Maybe UserId
customUserProfileId :: Maybe UserId
customUserProfileId,
              Int
connLevel :: Int
connLevel :: Int
connLevel,
              connStatus :: ConnStatus
connStatus = ConnStatus
ConnNew,
              localAlias :: LocalAlias
localAlias = LocalAlias
"",
              createdAt :: UTCTime
createdAt = UTCTime
currentTs,
              connectionCode :: Maybe SecurityCode
connectionCode = Maybe SecurityCode
forall a. Maybe a
Nothing,
              pqSupport :: PQSupport
pqSupport = PQSupport
PQSupportOff,
              pqEncryption :: PQEncryption
pqEncryption = PQEncryption
PQEncOff,
              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
            }
        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
ctConn
    Contact -> IO Contact
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Contact {UserId
contactId :: UserId
contactId :: UserId
contactId, LocalAlias
localDisplayName :: LocalAlias
localDisplayName :: LocalAlias
localDisplayName, profile :: LocalProfile
profile = LocalProfile
memberProfile, activeConn :: Maybe Connection
activeConn = Connection -> Maybe Connection
forall a. a -> Maybe a
Just Connection
ctConn, contactUsed :: Bool
contactUsed = Bool
True, 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 UserId
contactRequestId = Maybe UserId
forall a. Maybe a
Nothing, contactGroupMemberId :: Maybe UserId
contactGroupMemberId = UserId -> Maybe UserId
forall a. a -> Maybe a
Just UserId
groupMemberId, contactGrpInvSent :: Bool
contactGrpInvSent = Bool
False, groupDirectInv :: Maybe GroupDirectInvitation
groupDirectInv = Maybe GroupDirectInvitation
forall a. Maybe a
Nothing, chatTags :: [UserId]
chatTags = [], chatItemTTL :: Maybe UserId
chatItemTTL = Maybe UserId
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}

getMemberContact :: DB.Connection -> VersionRangeChat -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
getMemberContact :: Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT
     StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
getMemberContact Connection
db VersionRangeChat
vr User
user UserId
contactId = do
  Contact
ct <- Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user UserId
contactId
  let Contact {Maybe UserId
contactGroupMemberId :: Contact -> Maybe UserId
contactGroupMemberId :: Maybe UserId
contactGroupMemberId, Maybe Connection
activeConn :: Contact -> Maybe Connection
activeConn :: Maybe Connection
activeConn} = Contact
ct
  case (Maybe Connection
activeConn, Maybe UserId
contactGroupMemberId) of
    (Just Connection {UserId
connId :: Connection -> UserId
connId :: UserId
connId}, Just UserId
groupMemberId) -> do
      ConnReqInvitation
cReq <- Connection -> UserId -> ExceptT StoreError IO ConnReqInvitation
getConnReqInv Connection
db UserId
connId
      m :: GroupMember
m@GroupMember {UserId
groupId :: GroupMember -> UserId
groupId :: UserId
groupId} <- Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupMember
getGroupMemberById Connection
db VersionRangeChat
vr User
user UserId
groupMemberId
      GroupInfo
g <- Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user UserId
groupId
      (GroupInfo, GroupMember, Contact, ConnReqInvitation)
-> ExceptT
     StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupInfo
g, GroupMember
m, Contact
ct, ConnReqInvitation
cReq)
    (Maybe Connection, Maybe UserId)
_ ->
      StoreError
-> ExceptT
     StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError
 -> ExceptT
      StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation))
-> StoreError
-> ExceptT
     StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
forall a b. (a -> b) -> a -> b
$ UserId -> StoreError
SEMemberContactGroupMemberNotFound UserId
contactId

setContactGrpInvSent :: DB.Connection -> Contact -> Bool -> IO ()
setContactGrpInvSent :: Connection -> Contact -> Bool -> IO ()
setContactGrpInvSent Connection
db Contact {UserId
contactId :: Contact -> UserId
contactId :: UserId
contactId} Bool
xGrpDirectInvSent = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection -> Query -> (BoolInt, UTCTime, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"UPDATE contacts SET contact_grp_inv_sent = ?, updated_at = ? WHERE contact_id = ?"
    (Bool -> BoolInt
BI Bool
xGrpDirectInvSent, UTCTime
currentTs, UserId
contactId)

createMemberContactInvited :: DB.Connection -> User -> GroupInfo -> GroupMember -> GroupDirectInvitation -> IO (ContactId, GroupMember)
createMemberContactInvited :: Connection
-> User
-> GroupInfo
-> GroupMember
-> GroupDirectInvitation
-> IO (UserId, GroupMember)
createMemberContactInvited
  Connection
db
  User {UserId
userId :: User -> UserId
userId :: UserId
userId, profile :: User -> LocalProfile
profile = LocalProfile {Maybe Preferences
preferences :: LocalProfile -> Maybe Preferences
preferences :: Maybe Preferences
preferences}}
  GroupInfo
gInfo
  m :: GroupMember
m@GroupMember {localDisplayName :: GroupMember -> LocalAlias
localDisplayName = LocalAlias
memberLDN, UserId
memberContactProfileId :: GroupMember -> UserId
memberContactProfileId :: UserId
memberContactProfileId}
  GroupDirectInvitation {ConnReqInvitation
groupDirectInvLink :: ConnReqInvitation
groupDirectInvLink :: GroupDirectInvitation -> ConnReqInvitation
groupDirectInvLink, Maybe UserId
fromGroupId_ :: Maybe UserId
fromGroupId_ :: GroupDirectInvitation -> Maybe UserId
fromGroupId_, Maybe UserId
fromGroupMemberId_ :: Maybe UserId
fromGroupMemberId_ :: GroupDirectInvitation -> Maybe UserId
fromGroupMemberId_, Maybe UserId
fromGroupMemberConnId_ :: Maybe UserId
fromGroupMemberConnId_ :: GroupDirectInvitation -> Maybe UserId
fromGroupMemberConnId_, Bool
groupDirectInvStartedConnection :: Bool
groupDirectInvStartedConnection :: GroupDirectInvitation -> Bool
groupDirectInvStartedConnection} = do
    UTCTime
currentTs <- IO UTCTime -> IO UTCTime
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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
$ GroupInfo -> Maybe LocalProfile
incognitoMembershipProfile GroupInfo
gInfo Maybe LocalProfile -> 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
    UserId
contactId <- UTCTime -> Preferences -> IO UserId
createContactUpdateMember UTCTime
currentTs Preferences
userPreferences
    (UserId, GroupMember) -> IO (UserId, GroupMember)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserId
contactId, GroupMember
m {memberContactId = Just contactId})
    where
      createContactUpdateMember :: UTCTime -> Preferences -> IO ContactId
      createContactUpdateMember :: UTCTime -> Preferences -> IO UserId
createContactUpdateMember UTCTime
currentTs Preferences
userPreferences = do
        Connection
-> Query
-> ((UserId, LocalAlias, UserId, BoolInt, Preferences, BoolInt)
    :. ((ConnReqInvitation, Maybe UserId, Maybe UserId, Maybe UserId,
         BoolInt)
        :. (UTCTime, UTCTime, UTCTime)))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
          Connection
db
          [sql|
            INSERT INTO contacts (
              user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, contact_used,
              grp_direct_inv_link, grp_direct_inv_from_group_id, grp_direct_inv_from_group_member_id, grp_direct_inv_from_member_conn_id, grp_direct_inv_started_connection,
              created_at, updated_at, chat_ts
            ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
          |]
          ( (UserId
userId, LocalAlias
memberLDN, UserId
memberContactProfileId, Bool -> BoolInt
BI Bool
True, Preferences
userPreferences, Bool -> BoolInt
BI Bool
True)
              (UserId, LocalAlias, UserId, BoolInt, Preferences, BoolInt)
-> ((ConnReqInvitation, Maybe UserId, Maybe UserId, Maybe UserId,
     BoolInt)
    :. (UTCTime, UTCTime, UTCTime))
-> (UserId, LocalAlias, UserId, BoolInt, Preferences, BoolInt)
   :. ((ConnReqInvitation, Maybe UserId, Maybe UserId, Maybe UserId,
        BoolInt)
       :. (UTCTime, UTCTime, UTCTime))
forall h t. h -> t -> h :. t
:. (ConnReqInvitation
groupDirectInvLink, Maybe UserId
fromGroupId_, Maybe UserId
fromGroupMemberId_, Maybe UserId
fromGroupMemberConnId_, Bool -> BoolInt
BI Bool
groupDirectInvStartedConnection)
              (ConnReqInvitation, Maybe UserId, Maybe UserId, Maybe UserId,
 BoolInt)
-> (UTCTime, UTCTime, UTCTime)
-> (ConnReqInvitation, Maybe UserId, Maybe UserId, Maybe UserId,
    BoolInt)
   :. (UTCTime, UTCTime, UTCTime)
forall h t. h -> t -> h :. t
:. (UTCTime
currentTs, UTCTime
currentTs, UTCTime
currentTs)
          )
        UserId
contactId <- Connection -> IO UserId
insertedRowId Connection
db
        Connection -> Query -> (UserId, UTCTime, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
          Connection
db
          Query
"UPDATE group_members SET contact_id = ?, updated_at = ? WHERE contact_profile_id = ?"
          (UserId
contactId, UTCTime
currentTs, UserId
memberContactProfileId)
        UserId -> IO UserId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UserId
contactId

updateMemberContactInvited :: DB.Connection -> User -> Contact -> GroupDirectInvitation -> ExceptT StoreError IO ()
updateMemberContactInvited :: Connection
-> User
-> Contact
-> GroupDirectInvitation
-> ExceptT StoreError IO ()
updateMemberContactInvited Connection
_ User
_ Contact {LocalAlias
localDisplayName :: Contact -> LocalAlias
localDisplayName :: LocalAlias
localDisplayName, activeConn :: Contact -> Maybe Connection
activeConn = Maybe Connection
Nothing} GroupDirectInvitation
_ = StoreError -> ExceptT StoreError IO ()
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO ())
-> StoreError -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ LocalAlias -> StoreError
SEContactNotReady LocalAlias
localDisplayName
updateMemberContactInvited Connection
db User
user Contact {UserId
contactId :: Contact -> UserId
contactId :: UserId
contactId, activeConn :: Contact -> Maybe Connection
activeConn = Just Connection
oldContactConn} GroupDirectInvitation
groupDirectInv = 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 -> User -> UserId -> IO ()
deleteConnectionRecord Connection
db User
user (Connection -> UserId
dbConnId Connection
oldContactConn)
  GroupDirectInvitation -> IO ()
updateMemberContactFields GroupDirectInvitation
groupDirectInv
  where
    -- - reset status to active (in case contact was deleted)
    -- - reset fields used for sending invitation
    -- - set fields used for accepting invitation
    updateMemberContactFields :: GroupDirectInvitation -> IO ()
updateMemberContactFields GroupDirectInvitation {ConnReqInvitation
groupDirectInvLink :: GroupDirectInvitation -> ConnReqInvitation
groupDirectInvLink :: ConnReqInvitation
groupDirectInvLink, Maybe UserId
fromGroupId_ :: GroupDirectInvitation -> Maybe UserId
fromGroupId_ :: Maybe UserId
fromGroupId_, Maybe UserId
fromGroupMemberId_ :: GroupDirectInvitation -> Maybe UserId
fromGroupMemberId_ :: Maybe UserId
fromGroupMemberId_, Maybe UserId
fromGroupMemberConnId_ :: GroupDirectInvitation -> Maybe UserId
fromGroupMemberConnId_ :: Maybe UserId
fromGroupMemberConnId_, Bool
groupDirectInvStartedConnection :: GroupDirectInvitation -> Bool
groupDirectInvStartedConnection :: Bool
groupDirectInvStartedConnection} =
      Connection
-> Query
-> (ContactStatus, ConnReqInvitation, Maybe UserId, Maybe UserId,
    Maybe UserId, BoolInt, UserId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        [sql|
          UPDATE contacts
          SET contact_status = ?,
              contact_group_member_id = NULL, contact_grp_inv_sent = 0,
              grp_direct_inv_link = ?, grp_direct_inv_from_group_id = ?, grp_direct_inv_from_group_member_id = ?, grp_direct_inv_from_member_conn_id = ?, grp_direct_inv_started_connection = ?
          WHERE contact_id = ?
        |]
        (ContactStatus
CSActive, ConnReqInvitation
groupDirectInvLink, Maybe UserId
fromGroupId_, Maybe UserId
fromGroupMemberId_, Maybe UserId
fromGroupMemberConnId_, Bool -> BoolInt
BI Bool
groupDirectInvStartedConnection, UserId
contactId)

resetMemberContactFields :: DB.Connection -> Contact -> IO Contact
resetMemberContactFields :: Connection -> Contact -> IO Contact
resetMemberContactFields Connection
db ct :: Contact
ct@Contact {UserId
contactId :: Contact -> UserId
contactId :: UserId
contactId} = do
  UTCTime
currentTs <- IO UTCTime -> IO UTCTime
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  Connection -> Query -> (UTCTime, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE contacts
      SET contact_group_member_id = NULL, contact_grp_inv_sent = 0, updated_at = ?
      WHERE contact_id = ?
    |]
    (UTCTime
currentTs, UserId
contactId)
  Contact -> IO Contact
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Contact
ct {contactGroupMemberId = Nothing, contactGrpInvSent = False, updatedAt = currentTs}

createMemberContactConn :: DB.Connection -> User -> ConnId -> Maybe CommandId -> GroupInfo -> Connection -> ConnStatus -> ContactId -> SubscriptionMode -> IO Int64
createMemberContactConn :: Connection
-> User
-> ConnId
-> Maybe UserId
-> GroupInfo
-> Connection
-> ConnStatus
-> UserId
-> SubscriptionMode
-> IO UserId
createMemberContactConn
  Connection
db
  user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId}
  ConnId
acId
  Maybe UserId
cmdId_
  GroupInfo
gInfo
  _memberConn :: Connection
_memberConn@Connection {Int
connLevel :: Connection -> Int
connLevel :: Int
connLevel, VersionChat
connChatVersion :: Connection -> VersionChat
connChatVersion :: VersionChat
connChatVersion, peerChatVRange :: Connection -> VersionRangeChat
peerChatVRange = VersionRange VersionChat
minV VersionChat
maxV}
  ConnStatus
connStatus
  UserId
contactId
  SubscriptionMode
subMode = do
    UTCTime
currentTs <- IO UTCTime -> IO UTCTime
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    let customUserProfileId :: Maybe UserId
customUserProfileId = LocalProfile -> UserId
localProfileId (LocalProfile -> UserId) -> Maybe LocalProfile -> Maybe UserId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GroupInfo -> Maybe LocalProfile
incognitoMembershipProfile GroupInfo
gInfo
    Connection
-> Query
-> ((UserId, ConnId, Int, ConnStatus, ConnType, UserId,
     Maybe UserId)
    :. (VersionChat, VersionChat, VersionChat, UTCTime, UTCTime,
        BoolInt))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      [sql|
        INSERT INTO connections (
          user_id, agent_conn_id, conn_level, conn_status, conn_type, contact_id, custom_user_profile_id,
          conn_chat_version, peer_chat_min_version, peer_chat_max_version, created_at, updated_at, to_subscribe
        ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
      |]
      ( (UserId
userId, ConnId
acId, Int
connLevel, ConnStatus
connStatus, ConnType
ConnContact, UserId
contactId, Maybe UserId
customUserProfileId)
          (UserId, ConnId, Int, ConnStatus, ConnType, UserId, Maybe UserId)
-> (VersionChat, VersionChat, VersionChat, UTCTime, UTCTime,
    BoolInt)
-> (UserId, ConnId, Int, ConnStatus, ConnType, UserId,
    Maybe UserId)
   :. (VersionChat, VersionChat, VersionChat, UTCTime, UTCTime,
       BoolInt)
forall h t. h -> t -> h :. t
:. (VersionChat
connChatVersion, VersionChat
minV, VersionChat
maxV, UTCTime
currentTs, UTCTime
currentTs, Bool -> BoolInt
BI (SubscriptionMode
subMode SubscriptionMode -> SubscriptionMode -> Bool
forall a. Eq a => a -> a -> Bool
== SubscriptionMode
SMOnlyCreate))
      )
    UserId
connId <- Connection -> IO UserId
insertedRowId Connection
db
    Maybe UserId -> (UserId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe UserId
cmdId_ ((UserId -> IO ()) -> IO ()) -> (UserId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \UserId
cmdId -> Connection -> User -> UserId -> UserId -> IO ()
setCommandConnId Connection
db User
user UserId
cmdId UserId
connId
    UserId -> IO UserId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UserId
connId

getMemberContactInvited :: DB.Connection -> VersionRangeChat -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, Connection, Contact, GroupDirectInvitation)
getMemberContactInvited :: Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT
     StoreError
     IO
     (GroupInfo, Connection, Contact, GroupDirectInvitation)
getMemberContactInvited Connection
db VersionRangeChat
vr User
user UserId
contactId = do
  ct :: Contact
ct@Contact {groupDirectInv :: Contact -> Maybe GroupDirectInvitation
groupDirectInv = Maybe GroupDirectInvitation
groupDirectInv_} <- Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user UserId
contactId
  case Maybe GroupDirectInvitation
groupDirectInv_ of
    Just groupDirectInv :: GroupDirectInvitation
groupDirectInv@GroupDirectInvitation {fromGroupId_ :: GroupDirectInvitation -> Maybe UserId
fromGroupId_ = Just UserId
groupId, fromGroupMemberId_ :: GroupDirectInvitation -> Maybe UserId
fromGroupMemberId_ = Just UserId
_gmId, fromGroupMemberConnId_ :: GroupDirectInvitation -> Maybe UserId
fromGroupMemberConnId_ = Just UserId
mConnId} -> do
      GroupInfo
g <- Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user UserId
groupId
      Connection
mConn <- Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO Connection
getConnectionById Connection
db VersionRangeChat
vr User
user UserId
mConnId
      (GroupInfo, Connection, Contact, GroupDirectInvitation)
-> ExceptT
     StoreError
     IO
     (GroupInfo, Connection, Contact, GroupDirectInvitation)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupInfo
g, Connection
mConn, Contact
ct, GroupDirectInvitation
groupDirectInv)
    Maybe GroupDirectInvitation
_ ->
      StoreError
-> ExceptT
     StoreError
     IO
     (GroupInfo, Connection, Contact, GroupDirectInvitation)
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError
 -> ExceptT
      StoreError
      IO
      (GroupInfo, Connection, Contact, GroupDirectInvitation))
-> StoreError
-> ExceptT
     StoreError
     IO
     (GroupInfo, Connection, Contact, GroupDirectInvitation)
forall a b. (a -> b) -> a -> b
$ UserId -> StoreError
SEMemberContactGroupMemberNotFound UserId
contactId

setMemberContactStartedConnection :: DB.Connection -> Contact -> IO ()
setMemberContactStartedConnection :: Connection -> Contact -> IO ()
setMemberContactStartedConnection Connection
db Contact {UserId
contactId :: Contact -> UserId
contactId :: UserId
contactId} = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection -> Query -> (BoolInt, UTCTime, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"UPDATE contacts SET grp_direct_inv_started_connection = ?, updated_at = ? WHERE contact_id = ?"
    (Bool -> BoolInt
BI Bool
True, UTCTime
currentTs, UserId
contactId)

updateMemberProfile :: DB.Connection -> User -> GroupMember -> Profile -> ExceptT StoreError IO GroupMember
updateMemberProfile :: Connection
-> User
-> GroupMember
-> Profile
-> ExceptT StoreError IO GroupMember
updateMemberProfile Connection
db user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupMember
m Profile
p'
  | LocalAlias
displayName LocalAlias -> LocalAlias -> Bool
forall a. Eq a => a -> a -> Bool
== LocalAlias
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 -> UserId -> UserId -> Profile -> IO ()
updateMemberContactProfileReset_ Connection
db UserId
userId UserId
profileId Profile
p'
      GroupMember -> ExceptT StoreError IO GroupMember
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupMember
m {memberProfile = profile}
  | Bool
otherwise =
      IO (Either StoreError GroupMember)
-> ExceptT StoreError IO GroupMember
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError GroupMember)
 -> ExceptT StoreError IO GroupMember)
-> ((LocalAlias -> IO (Either StoreError GroupMember))
    -> IO (Either StoreError GroupMember))
-> (LocalAlias -> IO (Either StoreError GroupMember))
-> ExceptT StoreError IO GroupMember
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError GroupMember))
-> IO (Either StoreError GroupMember)
forall a.
Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError a))
-> IO (Either StoreError a)
withLocalDisplayName Connection
db UserId
userId LocalAlias
newName ((LocalAlias -> IO (Either StoreError GroupMember))
 -> ExceptT StoreError IO GroupMember)
-> (LocalAlias -> IO (Either StoreError GroupMember))
-> ExceptT StoreError IO GroupMember
forall a b. (a -> b) -> a -> b
$ \LocalAlias
ldn -> do
        UTCTime
currentTs <- IO UTCTime
getCurrentTime
        Connection -> UserId -> UserId -> Profile -> UTCTime -> IO ()
updateMemberContactProfileReset_' Connection
db UserId
userId UserId
profileId Profile
p' UTCTime
currentTs
        Connection
-> Query -> (LocalAlias, UTCTime, UserId, UserId) -> 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 group_member_id = ?"
          (LocalAlias
ldn, UTCTime
currentTs, UserId
userId, UserId
groupMemberId)
        Connection -> User -> LocalAlias -> IO ()
safeDeleteLDN Connection
db User
user LocalAlias
localDisplayName
        Either StoreError GroupMember -> IO (Either StoreError GroupMember)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError GroupMember
 -> IO (Either StoreError GroupMember))
-> Either StoreError GroupMember
-> IO (Either StoreError GroupMember)
forall a b. (a -> b) -> a -> b
$ GroupMember -> Either StoreError GroupMember
forall a b. b -> Either a b
Right GroupMember
m {localDisplayName = ldn, memberProfile = profile}
  where
    GroupMember {UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId, LocalAlias
localDisplayName :: GroupMember -> LocalAlias
localDisplayName :: LocalAlias
localDisplayName, memberProfile :: GroupMember -> LocalProfile
memberProfile = LocalProfile {UserId
profileId :: LocalProfile -> UserId
profileId :: UserId
profileId, LocalAlias
displayName :: LocalProfile -> LocalAlias
displayName :: LocalAlias
displayName, LocalAlias
localAlias :: LocalAlias
localAlias :: LocalProfile -> LocalAlias
localAlias}} = GroupMember
m
    Profile {displayName :: Profile -> LocalAlias
displayName = LocalAlias
newName} = Profile
p'
    profile :: LocalProfile
profile = UserId -> Profile -> LocalAlias -> LocalProfile
toLocalProfile UserId
profileId Profile
p' LocalAlias
localAlias

updateContactMemberProfile :: DB.Connection -> User -> GroupMember -> Contact -> Profile -> ExceptT StoreError IO (GroupMember, Contact)
updateContactMemberProfile :: Connection
-> User
-> GroupMember
-> Contact
-> Profile
-> ExceptT StoreError IO (GroupMember, Contact)
updateContactMemberProfile Connection
db user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupMember
m ct :: Contact
ct@Contact {UserId
contactId :: Contact -> UserId
contactId :: UserId
contactId} Profile
p'
  | LocalAlias
displayName LocalAlias -> LocalAlias -> Bool
forall a. Eq a => a -> a -> Bool
== LocalAlias
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 -> UserId -> UserId -> Profile -> IO ()
updateMemberContactProfile_ Connection
db UserId
userId UserId
profileId Profile
p'
      (GroupMember, Contact)
-> ExceptT StoreError IO (GroupMember, Contact)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupMember
m {memberProfile = profile}, Contact
ct {profile} :: Contact)
  | Bool
otherwise =
      IO (Either StoreError (GroupMember, Contact))
-> ExceptT StoreError IO (GroupMember, Contact)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (GroupMember, Contact))
 -> ExceptT StoreError IO (GroupMember, Contact))
-> ((LocalAlias -> IO (Either StoreError (GroupMember, Contact)))
    -> IO (Either StoreError (GroupMember, Contact)))
-> (LocalAlias -> IO (Either StoreError (GroupMember, Contact)))
-> ExceptT StoreError IO (GroupMember, Contact)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError (GroupMember, Contact)))
-> IO (Either StoreError (GroupMember, Contact))
forall a.
Connection
-> UserId
-> LocalAlias
-> (LocalAlias -> IO (Either StoreError a))
-> IO (Either StoreError a)
withLocalDisplayName Connection
db UserId
userId LocalAlias
newName ((LocalAlias -> IO (Either StoreError (GroupMember, Contact)))
 -> ExceptT StoreError IO (GroupMember, Contact))
-> (LocalAlias -> IO (Either StoreError (GroupMember, Contact)))
-> ExceptT StoreError IO (GroupMember, Contact)
forall a b. (a -> b) -> a -> b
$ \LocalAlias
ldn -> do
        UTCTime
currentTs <- IO UTCTime
getCurrentTime
        Connection -> UserId -> UserId -> Profile -> UTCTime -> IO ()
updateMemberContactProfile_' Connection
db UserId
userId UserId
profileId Profile
p' UTCTime
currentTs
        Connection
-> User -> UserId -> LocalAlias -> LocalAlias -> UTCTime -> IO ()
updateContactLDN_ Connection
db User
user UserId
contactId LocalAlias
localDisplayName LocalAlias
ldn UTCTime
currentTs
        Either StoreError (GroupMember, Contact)
-> IO (Either StoreError (GroupMember, Contact))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError (GroupMember, Contact)
 -> IO (Either StoreError (GroupMember, Contact)))
-> Either StoreError (GroupMember, Contact)
-> IO (Either StoreError (GroupMember, Contact))
forall a b. (a -> b) -> a -> b
$ (GroupMember, Contact) -> Either StoreError (GroupMember, Contact)
forall a b. b -> Either a b
Right (GroupMember
m {localDisplayName = ldn, memberProfile = profile}, Contact
ct {localDisplayName = ldn, profile} :: Contact)
  where
    GroupMember {LocalAlias
localDisplayName :: GroupMember -> LocalAlias
localDisplayName :: LocalAlias
localDisplayName, memberProfile :: GroupMember -> LocalProfile
memberProfile = LocalProfile {UserId
profileId :: LocalProfile -> UserId
profileId :: UserId
profileId, LocalAlias
displayName :: LocalProfile -> LocalAlias
displayName :: LocalAlias
displayName, LocalAlias
localAlias :: LocalProfile -> LocalAlias
localAlias :: LocalAlias
localAlias}} = GroupMember
m
    Profile {displayName :: Profile -> LocalAlias
displayName = LocalAlias
newName} = Profile
p'
    profile :: LocalProfile
profile = UserId -> Profile -> LocalAlias -> LocalProfile
toLocalProfile UserId
profileId Profile
p' LocalAlias
localAlias

getXGrpLinkMemReceived :: DB.Connection -> GroupMemberId -> ExceptT StoreError IO Bool
getXGrpLinkMemReceived :: Connection -> UserId -> ExceptT StoreError IO Bool
getXGrpLinkMemReceived Connection
db UserId
mId =
  IO (Either StoreError Bool) -> ExceptT StoreError IO Bool
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError Bool) -> ExceptT StoreError IO Bool)
-> (IO [Only BoolInt] -> IO (Either StoreError Bool))
-> IO [Only BoolInt]
-> ExceptT StoreError IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only BoolInt -> Bool)
-> StoreError -> IO [Only BoolInt] -> IO (Either StoreError Bool)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only BoolInt -> Bool
fromOnlyBI (UserId -> StoreError
SEGroupMemberNotFound UserId
mId) (IO [Only BoolInt] -> ExceptT StoreError IO Bool)
-> IO [Only BoolInt] -> ExceptT StoreError IO Bool
forall a b. (a -> b) -> a -> b
$
    Connection -> Query -> Only UserId -> IO [Only BoolInt]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT xgrplinkmem_received FROM group_members WHERE group_member_id = ?" (UserId -> Only UserId
forall a. a -> Only a
Only UserId
mId)

setXGrpLinkMemReceived :: DB.Connection -> GroupMemberId -> Bool -> IO ()
setXGrpLinkMemReceived :: Connection -> UserId -> Bool -> IO ()
setXGrpLinkMemReceived Connection
db UserId
mId Bool
xGrpLinkMemReceived = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection -> Query -> (BoolInt, UTCTime, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"UPDATE group_members SET xgrplinkmem_received = ?, updated_at = ? WHERE group_member_id = ?"
    (Bool -> BoolInt
BI Bool
xGrpLinkMemReceived, UTCTime
currentTs, UserId
mId)

createNewUnknownGroupMember :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> MemberId -> Text -> ExceptT StoreError IO GroupMember
createNewUnknownGroupMember :: Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> MemberId
-> LocalAlias
-> ExceptT StoreError IO GroupMember
createNewUnknownGroupMember Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId, UserId
userContactId :: User -> UserId
userContactId :: UserId
userContactId} GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} MemberId
memberId LocalAlias
memberName = 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 memberProfile :: Profile
memberProfile = LocalAlias -> Profile
profileFromName LocalAlias
memberName
  (LocalAlias
localDisplayName, UserId
profileId) <- Connection
-> User
-> Profile
-> UTCTime
-> ExceptT StoreError IO (LocalAlias, UserId)
createNewMemberProfile_ Connection
db User
user Profile
memberProfile UTCTime
currentTs
  UserId
indexInGroup <- Connection -> UserId -> ExceptT StoreError IO UserId
getUpdateNextIndexInGroup_ Connection
db UserId
groupId
  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
-> ((UserId, UserId, MemberId, GroupMemberRole,
     GroupMemberCategory, GroupMemberStatus, Binary ConnId,
     Maybe UserId)
    :. ((UserId, LocalAlias, Maybe UserId, UserId, UTCTime, UTCTime)
        :. (VersionChat, VersionChat)))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      [sql|
        INSERT INTO group_members
          ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by,
            user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
            peer_chat_min_version, peer_chat_max_version)
        VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
      |]
      ( (UserId
groupId, UserId
indexInGroup, MemberId
memberId, GroupMemberRole
GRAuthor, GroupMemberCategory
GCPreMember, GroupMemberStatus
GSMemUnknown, ConnId -> Binary ConnId
forall a. a -> Binary a
Binary ConnId
B.empty, UserId -> InvitedBy -> Maybe UserId
fromInvitedBy UserId
userContactId InvitedBy
IBUnknown)
          (UserId, UserId, MemberId, GroupMemberRole, GroupMemberCategory,
 GroupMemberStatus, Binary ConnId, Maybe UserId)
-> ((UserId, LocalAlias, Maybe UserId, UserId, UTCTime, UTCTime)
    :. (VersionChat, VersionChat))
-> (UserId, UserId, MemberId, GroupMemberRole, GroupMemberCategory,
    GroupMemberStatus, Binary ConnId, Maybe UserId)
   :. ((UserId, LocalAlias, Maybe UserId, UserId, UTCTime, UTCTime)
       :. (VersionChat, VersionChat))
forall h t. h -> t -> h :. t
:. (UserId
userId, LocalAlias
localDisplayName, Maybe UserId
forall a. Maybe a
Nothing :: (Maybe Int64), UserId
profileId, UTCTime
currentTs, UTCTime
currentTs)
          (UserId, LocalAlias, Maybe UserId, UserId, UTCTime, UTCTime)
-> (VersionChat, VersionChat)
-> (UserId, LocalAlias, Maybe UserId, UserId, UTCTime, UTCTime)
   :. (VersionChat, VersionChat)
forall h t. h -> t -> h :. t
:. (VersionChat
minV, VersionChat
maxV)
      )
  UserId
groupMemberId <- IO UserId -> ExceptT StoreError IO UserId
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserId -> ExceptT StoreError IO UserId)
-> IO UserId -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$ Connection -> IO UserId
insertedRowId Connection
db
  Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupMember
getGroupMemberById Connection
db VersionRangeChat
vr User
user UserId
groupMemberId
  where
    VersionRange VersionChat
minV VersionChat
maxV = VersionRangeChat
vr

updateUnknownMemberAnnounced :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> GroupMember -> MemberInfo -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
updateUnknownMemberAnnounced :: Connection
-> VersionRangeChat
-> User
-> GroupMember
-> GroupMember
-> MemberInfo
-> GroupMemberStatus
-> ExceptT StoreError IO GroupMember
updateUnknownMemberAnnounced Connection
db VersionRangeChat
vr user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupMember
invitingMember unknownMember :: GroupMember
unknownMember@GroupMember {UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId, VersionRangeChat
memberChatVRange :: GroupMember -> VersionRangeChat
memberChatVRange :: VersionRangeChat
memberChatVRange} MemberInfo {GroupMemberRole
memberRole :: GroupMemberRole
memberRole :: MemberInfo -> GroupMemberRole
memberRole, Maybe ChatVersionRange
v :: Maybe ChatVersionRange
v :: MemberInfo -> Maybe ChatVersionRange
v, Profile
profile :: MemberInfo -> Profile
profile :: Profile
profile} GroupMemberStatus
status = do
  GroupMember
_ <- Connection
-> User
-> GroupMember
-> Profile
-> ExceptT StoreError IO GroupMember
updateMemberProfile Connection
db User
user GroupMember
unknownMember Profile
profile
  UTCTime
currentTs <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> ((GroupMemberRole, GroupMemberCategory, GroupMemberStatus,
     UserId)
    :. (VersionChat, VersionChat, UTCTime, UserId, UserId))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      [sql|
        UPDATE group_members
        SET member_role = ?,
            member_category = ?,
            member_status = ?,
            invited_by_group_member_id = ?,
            peer_chat_min_version = ?,
            peer_chat_max_version = ?,
            updated_at = ?
        WHERE user_id = ? AND group_member_id = ?
      |]
      ( (GroupMemberRole
memberRole, GroupMemberCategory
GCPostMember, GroupMemberStatus
status, GroupMember -> UserId
groupMemberId' GroupMember
invitingMember)
          (GroupMemberRole, GroupMemberCategory, GroupMemberStatus, UserId)
-> (VersionChat, VersionChat, UTCTime, UserId, UserId)
-> (GroupMemberRole, GroupMemberCategory, GroupMemberStatus,
    UserId)
   :. (VersionChat, VersionChat, UTCTime, UserId, UserId)
forall h t. h -> t -> h :. t
:. (VersionChat
minV, VersionChat
maxV, UTCTime
currentTs, UserId
userId, UserId
groupMemberId)
      )
  Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO GroupMember
getGroupMemberById Connection
db VersionRangeChat
vr User
user UserId
groupMemberId
  where
    VersionRange VersionChat
minV VersionChat
maxV = VersionRangeChat
-> (ChatVersionRange -> VersionRangeChat)
-> Maybe ChatVersionRange
-> VersionRangeChat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe VersionRangeChat
memberChatVRange ChatVersionRange -> VersionRangeChat
fromChatVRange Maybe ChatVersionRange
v

updateUserMemberProfileSentAt :: DB.Connection -> User -> GroupInfo -> UTCTime -> IO ()
updateUserMemberProfileSentAt :: Connection -> User -> GroupInfo -> UTCTime -> IO ()
updateUserMemberProfileSentAt Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} UTCTime
sentTs =
  Connection -> Query -> (UTCTime, UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"UPDATE groups SET user_member_profile_sent_at = ? WHERE user_id = ? AND group_id = ?"
    (UTCTime
sentTs, UserId
userId, UserId
groupId)

setGroupCustomData :: DB.Connection -> User -> GroupInfo -> Maybe CustomData -> IO ()
setGroupCustomData :: Connection -> User -> GroupInfo -> Maybe CustomData -> IO ()
setGroupCustomData Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} Maybe CustomData
customData = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection
-> Query -> (Maybe CustomData, UTCTime, UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE groups SET custom_data = ?, updated_at = ? WHERE user_id = ? AND group_id = ?" (Maybe CustomData
customData, UTCTime
updatedAt, UserId
userId, UserId
groupId)

setGroupUIThemes :: DB.Connection -> User -> GroupInfo -> Maybe UIThemeEntityOverrides -> IO ()
setGroupUIThemes :: Connection
-> User -> GroupInfo -> Maybe UIThemeEntityOverrides -> IO ()
setGroupUIThemes Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} Maybe UIThemeEntityOverrides
uiThemes = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection
-> Query
-> (Maybe UIThemeEntityOverrides, UTCTime, UserId, UserId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE groups SET ui_themes = ?, updated_at = ? WHERE user_id = ? AND group_id = ?" (Maybe UIThemeEntityOverrides
uiThemes, UTCTime
updatedAt, UserId
userId, UserId
groupId)

updateGroupChatTags :: DB.Connection -> GroupId -> [ChatTagId] -> IO ()
updateGroupChatTags :: Connection -> UserId -> [UserId] -> IO ()
updateGroupChatTags Connection
db UserId
gId [UserId]
tIds = do
  [UserId]
currentTags <- Connection -> UserId -> IO [UserId]
getGroupChatTags Connection
db UserId
gId
  let tagsToAdd :: [UserId]
tagsToAdd = (UserId -> Bool) -> [UserId] -> [UserId]
forall a. (a -> Bool) -> [a] -> [a]
filter (UserId -> [UserId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [UserId]
currentTags) [UserId]
tIds
      tagsToDelete :: [UserId]
tagsToDelete = (UserId -> Bool) -> [UserId] -> [UserId]
forall a. (a -> Bool) -> [a] -> [a]
filter (UserId -> [UserId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [UserId]
tIds) [UserId]
currentTags
  [UserId] -> (UserId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [UserId]
tagsToDelete ((UserId -> IO ()) -> IO ()) -> (UserId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> UserId -> UserId -> IO ()
untagGroupChat Connection
db UserId
gId
  [UserId] -> (UserId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [UserId]
tagsToAdd ((UserId -> IO ()) -> IO ()) -> (UserId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> UserId -> UserId -> IO ()
tagGroupChat Connection
db UserId
gId

tagGroupChat :: DB.Connection -> GroupId -> ChatTagId -> IO ()
tagGroupChat :: Connection -> UserId -> UserId -> IO ()
tagGroupChat Connection
db UserId
groupId UserId
tId =
  Connection -> Query -> (UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      INSERT INTO chat_tags_chats (group_id, chat_tag_id)
      VALUES (?,?)
    |]
    (UserId
groupId, UserId
tId)

untagGroupChat :: DB.Connection -> GroupId -> ChatTagId -> IO ()
untagGroupChat :: Connection -> UserId -> UserId -> IO ()
untagGroupChat Connection
db UserId
groupId UserId
tId =
  Connection -> Query -> (UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      DELETE FROM chat_tags_chats
      WHERE group_id = ? AND chat_tag_id = ?
    |]
    (UserId
groupId, UserId
tId)

setGroupChatTTL :: DB.Connection -> GroupId -> Maybe Int64 -> IO ()
setGroupChatTTL :: Connection -> UserId -> Maybe UserId -> IO ()
setGroupChatTTL Connection
db UserId
gId Maybe UserId
ttl = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection -> Query -> (Maybe UserId, UTCTime, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"UPDATE groups SET chat_item_ttl = ?, updated_at = ? WHERE group_id = ?"
    (Maybe UserId
ttl, UTCTime
updatedAt, UserId
gId)

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

getUserGroupsToExpire :: DB.Connection -> User -> Int64 -> IO [GroupId]
getUserGroupsToExpire :: Connection -> User -> UserId -> IO [UserId]
getUserGroupsToExpire Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} UserId
globalTTL =
  (Only UserId -> UserId) -> [Only UserId] -> [UserId]
forall a b. (a -> b) -> [a] -> [b]
map Only UserId -> UserId
forall a. Only a -> a
fromOnly ([Only UserId] -> [UserId]) -> IO [Only UserId] -> IO [UserId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 groups WHERE user_id = ? AND chat_item_ttl > 0" Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
cond) (UserId -> Only UserId
forall a. a -> Only a
Only UserId
userId)
  where
    cond :: Query
cond = if UserId
globalTTL UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
== UserId
0 then Query
"" else Query
" OR chat_item_ttl IS NULL"

updateGroupAlias :: DB.Connection -> UserId -> GroupInfo -> LocalAlias -> IO GroupInfo
updateGroupAlias :: Connection -> UserId -> GroupInfo -> LocalAlias -> IO GroupInfo
updateGroupAlias Connection
db UserId
userId g :: GroupInfo
g@GroupInfo {UserId
groupId :: GroupInfo -> UserId
groupId :: UserId
groupId} LocalAlias
localAlias = do
  UTCTime
updatedAt <- IO UTCTime
getCurrentTime
  Connection
-> Query -> (LocalAlias, UTCTime, UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE groups SET local_alias = ?, updated_at = ? WHERE user_id = ? AND group_id = ?" (LocalAlias
localAlias, UTCTime
updatedAt, UserId
userId, UserId
groupId)
  GroupInfo -> IO GroupInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupInfo
g :: GroupInfo) {localAlias = localAlias}