simplex-chat/src/Simplex/Chat/Store/Groups.hs

{-# 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,
    getGroupInfoByUserContactLinkConnReq,
    getGroupInfoViaUserTarget,
    getGroupViaShortLinkToConnect,
    getGroupInfoByGroupLinkHash,
    updateGroupProfile,
    setGroupDomainVerified,
    updateGroupPreferences,
    updateGroupProfileFromMember,
    getGroupIdByName,
    getGroupMemberIdByName,
    getActiveMembersByName,
    getGroupInfoByName,
    getGroupToConnect,
    getGroupMember,
    getHostMember,
    getMentionedGroupMember,
    getMentionedMemberByMemberId,
    getGroupMemberById,
    getNonRemovedMemberById,
    getGroupMemberByIndex,
    getGroupMemberByMemberId,
    getCreateUnknownGMByMemberId,
    getGroupMemberIdViaMemberId,
    getScopeMemberIdViaMemberId,
    getGroupMembers,
    getGroupMembersByIndexes,
    getSupportScopeMembersByIndexes,
    getGroupModerators,
    getGroupRosterMembers,
    getGroupAdminsMods,
    getGroupOnlyMembers,
    getGroupOwners,
    getGroupRelayMembers,
    getGroupMembersForExpiration,
    getRemovedMembersToCleanup,
    deleteGroupChatItems,
    deleteGroupMembers,
    cleanupHostGroupLinkConn,
    deleteGroup,
    getInProgressGroups,
    getBaseGroupDetails,
    getContactGroupPreferences,
    getGroupInvitation,
    createNewContactMember,
    createGroupRelayRecord,
    getGroupRelayById,
    getGroupRelayByGMId,
    getGroupRelays,
    getPublishableGroupRelays,
    setGroupRosterVersion,
    getGroupRosterVersion,
    getGroupRoster,
    RcvRosterTransfer (..),
    createRosterTransfer,
    getRosterTransferVersion,
    getRosterTransferId,
    getRosterTransfer,
    setGroupLiveRoster,
    deleteRosterTransfer,
    deleteGroupRosterTransfers,
    setGroupMemberKeyRole,
    createRelayForOwner,
    getCreateRelayForMember,
    createRelayConnection,
    updateRelayStatus,
    updateRelayStatusFromTo,
    setRelayLinkAccepted,
    setRelayLinkConfId,
    updateRelayCapabilities,
    getRelayConfId,
    updateRelayMemberData,
    setGroupInProgressDone,
    createRelayRequestGroup,
    updateRelayOwnStatusFromTo,
    updateRelayOwnStatus_,
    getRelaySentWebDomain,
    updateRelaySentWebDomain,
    isRelayGroupRejected,
    allowRelayGroup,
    getRelayServedGroups,
    getRelayPublishableGroups,
    getRelayInactiveGroups,
    createNewContactMemberAsync,
    createJoiningMember,
    getMemberJoinRequest,
    createJoiningMemberConnection,
    createBusinessRequestGroup,
    getContactViaMember,
    setNewContactMemberConnRequest,
    getMemberInvitation,
    createMemberConnection,
    createMemberConnectionAsync,
    updatePreparedRelayedGroup,
    updatePublicMemberCount,
    setPublicMemberCount,
    updateGroupMemberKeys,
    updateRelayGroupKeys,
    updateGroupMemberStatus,
    updateGroupMemberStatusById,
    updateGroupMemberRemovedAt,
    updateGroupMemberAccepted,
    deleteGroupMemberSupportChat,
    updateGroupMembersRequireAttention,
    decreaseGroupMembersRequireAttention,
    increaseGroupMembersRequireAttention,
    createNewGroupMember,
    checkGroupMemberHasItems,
    deleteGroupMember,
    deleteGroupMemberConnection,
    updateGroupMemberRole,
    setMemberVectorNewRelations,
    setMembersVectorsNewRelation,
    setMemberVectorRelationConnected,
    getMemberRelationsVector,
    createIntroReMember,
    createIntroReMemberConn,
    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,
    createLinkOwnerMember,
    updatePreparedChannelMember,
    updateUnknownMemberAnnounced,
    updateRosterMemberAnnounced,
    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 (first, second)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Char (toLower)
import Data.Either (rights)
import Data.Functor (($>))
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 (NominalDiffTime, UTCTime (..), addUTCTime, getCurrentTime)
import Data.Text.Encoding (encodeUtf8)
import Simplex.Chat.Badges (BadgeRow, badgeToRow, verifyBadge_)
import Simplex.Chat.Names (SimplexDomainClaim (..))
import Simplex.Chat.Messages
import Simplex.Chat.Operators
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 (ConfirmationId, ConnId, CreatedConnLink (..), InvitationId, OwnerAuth (..), SimplexNameInfo (..), UserId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, fromOnlyBI, maybeFirstRow)
import qualified Simplex.FileTransfer.Description as FD
import Simplex.Messaging.Encoding (smpDecode, smpEncode)
import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..))
import Simplex.Messaging.Agent.Store.Entity (DBEntityId)
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 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) :. BadgeRow :. ContactDomainRow) :. (Maybe UTCTime, Maybe UTCTime) :. (Maybe UTCTime, Maybe Int64, Maybe Int64, Maybe Int64, Maybe UTCTime, Maybe C.PublicKeyEd25519, Maybe ShortLinkContact)

toMaybeGroupMember :: UTCTime -> Int64 -> MaybeGroupMemberRow -> Maybe GroupMember
toMaybeGroupMember now userContactId ((Just groupMemberId, Just groupId, Just indexInGroup, Just memberId, Just minVer, Just maxVer, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages, memberBlocked') :. (invitedById, invitedByGroupMemberId, Just localDisplayName, memberContactId, Just memberContactProfileId) :. ((Just profileId, Just displayName, Just fullName, shortDescr, image, contactLink, peerType, Just localAlias, contactPreferences) :. badgeRow :. domainRow) :. (Just createdAt, Just updatedAt) :. (supportChatTs, Just supportChatUnread, Just supportChatUnanswered, Just supportChatMentions, supportChatLastMsgFromMemberTs, memberPubKey, relayLink)) =
  Just $ toGroupMember now userContactId ((groupMemberId, groupId, indexInGroup, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberBlocked') :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId) :. ((profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, contactPreferences) :. badgeRow :. domainRow) :. (createdAt, updatedAt) :. (supportChatTs, supportChatUnread, supportChatUnanswered, supportChatMentions, supportChatLastMsgFromMemberTs, memberPubKey, relayLink))
toMaybeGroupMember _ _ _ = Nothing

createGroupLink :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> ConnId -> CreatedLinkContact -> GroupLinkId -> GroupMemberRole -> SubscriptionMode -> ExceptT StoreError IO GroupLink
createGroupLink db gVar user@User {userId} groupInfo@GroupInfo {groupId, localDisplayName} agentConnId (CCLink cReq shortLink) groupLinkId memberRole subMode = do
  checkConstraint (SEDuplicateGroupLink groupInfo) . liftIO $ do
    currentTs <- getCurrentTime
    randSuffix <- liftIO $ encodedRandomBytes gVar 12
    let groupLinkLDN = "group_link_" <> localDisplayName <> "_" <> safeDecodeUtf8 randSuffix
        slDataSet = BI (isJust shortLink)
    DB.execute
      db
      "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, groupId, groupLinkId, groupLinkLDN, cReq, shortLink, slDataSet, slDataSet) :. (memberRole, BI True, currentTs, currentTs))
    userContactLinkId <- insertedRowId db
    void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId ConnNew initialChatVersion chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode PQSupportOff
  getGroupLink db user groupInfo

getGroupLinkConnection :: DB.Connection -> StoreCxt -> User -> GroupInfo -> ExceptT StoreError IO Connection
getGroupLinkConnection db cxt User {userId} groupInfo@GroupInfo {groupId} =
  ExceptT . firstRow (toConnection cxt) (SEGroupLinkNotFound groupInfo) $
    DB.query
      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, groupId)

deleteGroupLink :: DB.Connection -> User -> GroupInfo -> IO ()
deleteGroupLink db User {userId} GroupInfo {groupId} = do
  DB.execute
    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, groupId)
  DB.execute
    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, groupId, userId)
  DB.execute
    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, groupId)
  DB.execute db "DELETE FROM user_contact_links WHERE user_id = ? AND group_id = ?" (userId, groupId)

getGroupLink :: DB.Connection -> User -> GroupInfo -> ExceptT StoreError IO GroupLink
getGroupLink db User {userId} gInfo@GroupInfo {groupId} =
  ExceptT . firstRow toGroupLink (SEGroupLinkNotFound gInfo) $
    DB.query db "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, groupId)
  where
    toGroupLink (userContactLinkId, cReq, shortLink, BI shortLinkDataSet, BI slLargeDataSet, groupLinkId, mRole_) =
      GroupLink {
        userContactLinkId,
        connLinkContact = CCLink cReq shortLink,
        shortLinkDataSet,
        shortLinkLargeDataSet = BoolDef slLargeDataSet,
        groupLinkId,
        acceptMemberRole = fromMaybe GRMember mRole_
      }

getGroupLinkId :: DB.Connection -> User -> GroupInfo -> IO (Maybe GroupLinkId)
getGroupLinkId db User {userId} GroupInfo {groupId} =
  fmap join . maybeFirstRow fromOnly $
    DB.query db "SELECT group_link_id FROM user_contact_links WHERE user_id = ? AND group_id = ? LIMIT 1" (userId, groupId)

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

setGroupLinkShortLink :: DB.Connection -> GroupLink -> ShortLinkContact -> IO GroupLink
setGroupLinkShortLink db gLnk@GroupLink {userContactLinkId, connLinkContact = CCLink connFullLink _sLnk_} shortLink = do
  DB.execute
    db
    [sql|
      UPDATE user_contact_links
      SET short_link_contact = ?,
          short_link_data_set = ?,
          short_link_large_data_set = ?
      WHERE user_contact_link_id = ?
    |]
    (shortLink, BI True, BI True, userContactLinkId)
  pure 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 -> StoreCxt -> User -> GroupProfile -> Maybe Profile -> Bool -> MemberId -> Maybe GroupKeys -> Maybe Int64 -> ExceptT StoreError IO GroupInfo
createNewGroup db cxt user@User {userId} groupProfile incognitoProfile useRelays memberId groupKeys publicMemberCount_ = ExceptT $ do
  let GroupProfile {displayName, fullName, shortDescr, description, image, publicGroup, groupPreferences, memberAdmission} = groupProfile
      (groupType_, groupLink_, publicGroupId_) = case publicGroup of
        Just PublicGroupProfile {groupType, groupLink, publicGroupId} -> (Just groupType, Just groupLink, Just publicGroupId)
        Nothing -> (Nothing, Nothing, Nothing)
      fullGroupPreferences = mergeGroupPreferences groupPreferences
      rosterVersion0 = if useRelays then Just (VersionRoster 0) else Nothing
  currentTs <- getCurrentTime
  customUserProfileId <- mapM (createIncognitoProfile_ db userId currentTs) incognitoProfile
  withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do
    let (rootPrivKey_, rootPubKey_, memberPrivKey_) = case groupKeys of
          Nothing -> (Nothing, Nothing, Nothing)
          Just GroupKeys {groupRootKey, memberPrivKey} ->
            let (rpk, rpub) = case groupRootKey of
                  GRKPrivate pk -> (Just pk, Nothing)
                  GRKPublic k -> (Nothing, Just k)
             in (rpk, rpub, Just memberPrivKey)
    groupId <- liftIO $ do
      DB.execute
        db
        [sql|
          INSERT INTO group_profiles
            (display_name, full_name, short_descr, description, image,
             group_type, group_link, public_group_id,
             group_web_page, group_domain, domain_web_page, allow_embedding, group_domain_proof,
             user_id, preferences, member_admission, created_at, updated_at)
          VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
        |]
        ((displayName, fullName, shortDescr, description, image, groupType_, groupLink_, publicGroupId_) :. publicGroupAccessRow publicGroup
          :. (userId, groupPreferences, memberAdmission, currentTs, currentTs))
      profileId <- insertedRowId db
      DB.execute
        db
        [sql|
          INSERT INTO groups
            (use_relays, creating_in_progress, local_display_name, user_id, group_profile_id, enable_ntfs,
             created_at, updated_at, chat_ts, user_member_profile_sent_at,
             root_priv_key, root_pub_key, member_priv_key, public_member_count, roster_version)
          VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
        |]
        ( (BI useRelays, BI useRelays, ldn, userId, profileId, BI True, currentTs, currentTs, currentTs, currentTs)
            :. (rootPrivKey_, rootPubKey_, memberPrivKey_, publicMemberCount_, rosterVersion0)
        )
      insertedRowId db
    let memberPubKey = C.publicKey . memberPrivKey <$> groupKeys
    membership <- createContactMemberInv_ db user groupId Nothing user (MemberIdRole memberId GROwner) GCUserMember GSMemCreator IBUser customUserProfileId memberPubKey currentTs (vr cxt)
    let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False}
    pure
      GroupInfo
        { groupId,
          useRelays = BoolDef useRelays,
          relayOwnStatus = Nothing,
          localDisplayName = ldn,
          groupProfile,
          localAlias = "",
          businessChat = Nothing,
          fullGroupPreferences,
          membership,
          chatSettings,
          createdAt = currentTs,
          updatedAt = currentTs,
          chatTs = Just currentTs,
          userMemberProfileSentAt = Just currentTs,
          preparedGroup = Nothing,
          chatTags = [],
          chatItemTTL = Nothing,
          uiThemes = Nothing,
          groupSummary = GroupSummary {currentMembers = 1, publicMemberCount = publicMemberCount_},
          rosterVersion = rosterVersion0,
          customData = Nothing,
          membersRequireAttention = 0,
          viaGroupLinkUri = Nothing,
          groupKeys,
          groupDomainVerified = Nothing
        }

-- | creates a new group record for the group the current user was invited to, or returns an existing one
createGroupInvitation :: DB.Connection -> StoreCxt -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMemberId)
createGroupInvitation _ _ _ Contact {localDisplayName, activeConn = Nothing} _ _ = throwError $ SEContactNotReady localDisplayName
createGroupInvitation db cxt user@User {userId} contact@Contact {contactId, activeConn = Just Connection {peerChatVRange}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile, business} incognitoProfileId = do
  liftIO getInvitationGroupId_ >>= \case
    Nothing -> createGroupInvitation_
    Just gId -> do
      gInfo@GroupInfo {membership, groupProfile = p'} <- getGroupInfo db cxt user gId
      hostId <- getHostMemberId_ db user gId
      let GroupMember {groupMemberId, memberId, memberRole} = membership
          MemberIdRole {memberId = invMemberId, memberRole = invMemberRole} = invitedMember
      liftIO . when (memberId /= invMemberId || memberRole /= invMemberRole) $
        DB.execute db "UPDATE group_members SET member_id = ?, member_role = ? WHERE group_member_id = ?" (invMemberId, invMemberRole, groupMemberId)
      gInfo' <-
        if p' == groupProfile
          then pure gInfo
          else updateGroupProfile db user gInfo groupProfile
      pure (gInfo', hostId)
  where
    getInvitationGroupId_ :: IO (Maybe Int64)
    getInvitationGroupId_ =
      maybeFirstRow fromOnly $
        DB.query db "SELECT group_id FROM groups WHERE inv_queue_info = ? AND user_id = ? LIMIT 1" (connRequest, userId)
    createGroupInvitation_ :: ExceptT StoreError IO (GroupInfo, GroupMemberId)
    createGroupInvitation_ = do
      let GroupProfile {displayName, fullName, shortDescr, description, image, groupPreferences, memberAdmission} = groupProfile
          fullGroupPreferences = mergeGroupPreferences groupPreferences
      ExceptT $
        withLocalDisplayName db userId displayName $ \localDisplayName -> runExceptT $ do
          currentTs <- liftIO getCurrentTime
          groupId <- liftIO $ do
            DB.execute
              db
              "INSERT INTO group_profiles (display_name, full_name, short_descr, description, image, user_id, preferences, member_admission, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?)"
              (displayName, fullName, shortDescr, description, image, userId, groupPreferences, memberAdmission, currentTs, currentTs)
            profileId <- insertedRowId db
            DB.execute
              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 (?,?,?,?,?,?,?,?,?,?,?,?)
              |]
              ((profileId, localDisplayName, connRequest, userId, BI True, currentTs, currentTs, currentTs, currentTs) :. businessChatInfoRow business)
            insertedRowId db
          let hostVRange = adjustedMemberVRange (vr cxt) peerChatVRange
          GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId Nothing contact fromMember GCHostMember GSMemInvited IBUnknown Nothing Nothing currentTs hostVRange
          membership <- createContactMemberInv_ db user groupId (Just groupMemberId) user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId Nothing currentTs (vr cxt)
          let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False}
          pure
            ( GroupInfo
                { groupId,
                  useRelays = BoolDef False,
                  relayOwnStatus = Nothing,
                  localDisplayName,
                  groupProfile,
                  localAlias = "",
                  businessChat = Nothing,
                  fullGroupPreferences,
                  membership,
                  chatSettings,
                  createdAt = currentTs,
                  updatedAt = currentTs,
                  chatTs = Just currentTs,
                  userMemberProfileSentAt = Just currentTs,
                  preparedGroup = Nothing,
                  chatTags = [],
                  chatItemTTL = Nothing,
                  uiThemes = Nothing,
                  groupSummary = GroupSummary {currentMembers = 2, publicMemberCount = Nothing},
                  rosterVersion = Nothing,
                  customData = Nothing,
                  membersRequireAttention = 0,
                  viaGroupLinkUri = Nothing,
                  groupKeys = Nothing,
                  groupDomainVerified = Nothing
                },
              groupMemberId
            )

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

adjustedMemberVRange :: VersionRangeChat -> VersionRangeChat -> VersionRangeChat
adjustedMemberVRange chatVR vr@(VersionRange minV maxV) =
  let maxV' = min maxV (maxVersion chatVR)
   in fromMaybe vr $ safeVersionRange minV (max minV maxV')

getHostMemberId_ :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO GroupMemberId
getHostMemberId_ db User {userId} groupId =
  ExceptT . firstRow fromOnly (SEHostMemberIdNotFound groupId) $
    DB.query db "SELECT group_member_id FROM group_members WHERE user_id = ? AND group_id = ? AND member_category = ?" (userId, groupId, GCHostMember)

getUpdateNextIndexInGroup_ :: DB.Connection -> GroupId -> ExceptT StoreError IO Int64
getUpdateNextIndexInGroup_ db groupId =
  ExceptT . firstRow fromOnly (SEGroupNotFound groupId) $
    DB.query
      db
      [sql|
        UPDATE groups
        SET member_index = member_index + 1
        WHERE group_id = ?
        RETURNING member_index - 1
      |]
      (Only groupId)

createContactMemberInv_ :: IsContact a => DB.Connection -> User -> GroupId -> Maybe GroupMemberId -> a -> MemberIdRole -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> Maybe ProfileId -> Maybe C.PublicKeyEd25519 -> UTCTime -> VersionRangeChat -> ExceptT StoreError IO GroupMember
createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMemberId userOrContact MemberIdRole {memberId, memberRole} memberCategory memberStatus invitedBy incognitoProfileId memberPubKey createdAt vr = do
  incognitoProfile <- forM incognitoProfileId $ \profileId -> getProfileById db userId profileId
  (indexInGroup, localDisplayName, memberProfile) <- case (incognitoProfile, incognitoProfileId) of
    (Just profile@LocalProfile {displayName}, Just profileId) -> do
      (indexInGroup, localDisplayName) <- insertMemberIncognitoProfile_ displayName profileId
      pure (indexInGroup, localDisplayName, profile)
    _ -> do
      (indexInGroup, localDisplayName) <- insertMember_
      pure (indexInGroup, localDisplayName, profile' userOrContact)
  groupMemberId <- liftIO $ insertedRowId db
  pure
    GroupMember
      { groupMemberId,
        groupId,
        indexInGroup,
        memberId,
        memberRole,
        memberCategory,
        memberStatus,
        memberSettings = defaultMemberSettings,
        blockedByAdmin = False,
        invitedBy,
        invitedByGroupMemberId,
        localDisplayName,
        memberProfile,
        memberContactId = Just $ contactId' userOrContact,
        memberContactProfileId = localProfileId (profile' userOrContact),
        activeConn = Nothing,
        memberChatVRange,
        createdAt,
        updatedAt = createdAt,
        supportChat = Nothing,
        memberPubKey,
        relayLink = Nothing
      }
  where
    memberChatVRange@(VersionRange minV maxV) = vr
    insertMember_ :: ExceptT StoreError IO (Int64, ContactName)
    insertMember_ = do
      let localDisplayName = localDisplayName' userOrContact
      indexInGroup <- getUpdateNextIndexInGroup_ db groupId
      liftIO $
        DB.execute
          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_pub_key, created_at, updated_at,
                peer_chat_min_version, peer_chat_max_version)
            VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
          |]
          ( (groupId, indexInGroup, memberId, memberRole, memberCategory, memberStatus, Binary B.empty, fromInvitedBy userContactId invitedBy, invitedByGroupMemberId)
              :. (userId, localDisplayName' userOrContact, contactId' userOrContact, localProfileId $ profile' userOrContact, memberPubKey, createdAt, createdAt)
              :. (minV, maxV)
          )
      pure (indexInGroup, localDisplayName)
    insertMemberIncognitoProfile_ :: ContactName -> ProfileId -> ExceptT StoreError IO (Int64, ContactName)
    insertMemberIncognitoProfile_ incognitoDisplayName customUserProfileId =
      ExceptT . withLocalDisplayName db userId incognitoDisplayName $ \incognitoLdn -> runExceptT $ do
        indexInGroup <- getUpdateNextIndexInGroup_ db groupId
        liftIO $
          DB.execute
            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, member_pub_key, created_at, updated_at,
                  peer_chat_min_version, peer_chat_max_version)
              VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
            |]
            ( (groupId, indexInGroup, memberId, memberRole, memberCategory, memberStatus, Binary B.empty, fromInvitedBy userContactId invitedBy, invitedByGroupMemberId)
                :. (userId, incognitoLdn, contactId' userOrContact, localProfileId $ profile' userOrContact, customUserProfileId, memberPubKey, createdAt, createdAt)
                :. (minV, maxV)
            )
        pure (indexInGroup, incognitoLdn)

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

createPreparedGroup :: DB.Connection -> TVar ChaChaDRG -> StoreCxt -> User -> GroupProfile -> Bool -> CreatedLinkContact -> Maybe SharedMsgId -> Bool -> GroupMemberRole -> Maybe Int64 -> Maybe Bool -> ExceptT StoreError IO (GroupInfo, Maybe GroupMember)
createPreparedGroup db gVar cxt user@User {userId, userContactId} groupProfile business connLinkToConnect welcomeSharedMsgId useRelays userMemberRole publicMemberCount_ verified_ = do
  currentTs <- liftIO getCurrentTime
  let prepared = Just (connLinkToConnect, welcomeSharedMsgId)
  (groupId, groupLDN) <- createGroup_ db userId groupProfile prepared Nothing useRelays Nothing publicMemberCount_ currentTs
  hostMemberId_ <-
    if useRelays
      then pure Nothing
      else Just <$> insertHost_ currentTs groupId groupLDN
  userMemberId <-
    if useRelays
      then liftIO $ MemberId <$> encodedRandomBytes gVar 12
      else pure $ MemberId $ encodeUtf8 groupLDN <> "_user_unknown_id"
  let userMember = MemberIdRole userMemberId userMemberRole
  -- TODO [member keys] user key must be included here. Should key be added when group is prepared?
  membership <- createContactMemberInv_ db user groupId hostMemberId_ user userMember GCUserMember GSMemUnknown IBUnknown Nothing Nothing currentTs (vr cxt)
  hostMember_ <- forM hostMemberId_ $ getGroupMember db cxt user groupId
  forM_ hostMember_ $ \hostMember ->
    when business $ liftIO $ setGroupBusinessChatInfo groupId membership hostMember
  g <- getGroupInfo db cxt user groupId
  g' <- liftIO $ maybe (pure g) (setGroupDomainVerified db user g) verified_
  pure (g', hostMember_)
  where
    insertHost_ currentTs groupId groupLDN = do
      randHostId <- liftIO $ encodedRandomBytes gVar 12
      let memberId = MemberId $ encodeUtf8 groupLDN <> "_unknown_host_" <> randHostId
          hostProfile = profileFromName $ nameFromBS randHostId
      (localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user hostProfile currentTs
      indexInGroup <- getUpdateNextIndexInGroup_ db groupId
      liftIO $ do
        DB.execute
          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 (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
          |]
          ( (groupId, indexInGroup, memberId, GRAdmin, GCHostMember, GSMemAccepted, Binary B.empty, fromInvitedBy userContactId IBUnknown)
              :. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, currentTs, currentTs)
          )
        insertedRowId db
    setGroupBusinessChatInfo :: GroupId -> GroupMember -> GroupMember -> IO ()
    setGroupBusinessChatInfo groupId membership hostMember = do
      let businessChatInfo = Just BusinessChatInfo {chatType = BCBusiness, businessId = memberId' hostMember, customerId = memberId' membership}
      updateBusinessChatInfo db groupId businessChatInfo

updateBusinessChatInfo :: DB.Connection -> GroupId -> Maybe BusinessChatInfo -> IO ()
updateBusinessChatInfo db groupId businessChatInfo =
  DB.execute
    db
    [sql|
      UPDATE groups
      SET business_chat = ?,
          business_member_id = ?,
          customer_member_id = ?
      WHERE group_id = ?
    |]
    (businessChatInfoRow businessChatInfo :. (Only groupId))

updatePreparedGroupUser :: DB.Connection -> StoreCxt -> User -> GroupInfo -> Maybe GroupMember -> User -> ExceptT StoreError IO GroupInfo
updatePreparedGroupUser db cxt user gInfo@GroupInfo {groupId, membership} hostMember_ newUser@User {userId = newUserId} = do
  currentTs <- liftIO getCurrentTime
  updateGroup gInfo currentTs
  liftIO $ updateMembership membership currentTs
  forM_ hostMember_ $ \hostMember -> updateHostMember hostMember currentTs
  getGroupInfo db cxt newUser groupId
  where
    updateGroup GroupInfo {localDisplayName = oldGroupLDN, groupProfile = GroupProfile {displayName = groupDisplayName}} currentTs =
      ExceptT . withLocalDisplayName db newUserId groupDisplayName $ \newGroupLDN -> runExceptT $ do
        liftIO $ do
          DB.execute
            db
            [sql|
              UPDATE groups
              SET user_id = ?, local_display_name = ?, updated_at = ?
              WHERE group_id = ?
            |]
            (newUserId, newGroupLDN, currentTs, groupId)
          DB.execute
            db
            [sql|
              UPDATE group_profiles
              SET user_id = ?, updated_at = ?
              WHERE group_profile_id IN (SELECT group_profile_id FROM groups WHERE group_id = ?)
            |]
            (newUserId, currentTs, groupId)
          DB.execute
            db
            [sql|
              UPDATE chat_items
              SET user_id = ?, updated_at = ?
              WHERE group_id = ?
            |]
            (newUserId, currentTs, groupId)
          safeDeleteLDN db user oldGroupLDN
    updateMembership GroupMember {groupMemberId = membershipId} currentTs =
      DB.execute
        db
        [sql|
          UPDATE group_members
          SET user_id = ?, local_display_name = ?, contact_id = ?, contact_profile_id = ?, updated_at = ?
          WHERE group_member_id = ?
        |]
        (newUserId, localDisplayName' newUser, contactId' newUser, localProfileId $ profile' newUser, currentTs, membershipId)
    updateHostMember
      GroupMember
        { groupMemberId = hostId,
          localDisplayName = oldHostLDN,
          memberProfile = LocalProfile {profileId = hostProfileId, displayName = hostDisplayName}
        }
      currentTs =
        ExceptT . withLocalDisplayName db newUserId hostDisplayName $ \newHostLDN -> runExceptT $ do
          liftIO $ do
            DB.execute
              db
              [sql|
                UPDATE group_members
                SET user_id = ?, local_display_name = ?, updated_at = ?
                WHERE group_member_id = ?
              |]
              (newUserId, newHostLDN, currentTs, hostId)
            DB.execute
              db
              [sql|
                UPDATE contact_profiles
                SET user_id = ?, updated_at = ?
                WHERE contact_profile_id = ?
              |]
              (newUserId, currentTs, hostProfileId)
            safeDeleteLDN db user oldHostLDN

updatePreparedUserAndHostMembersInvited :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupMember -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
updatePreparedUserAndHostMembersInvited db cxt user gInfo hostMember GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile, accepted, business} = do
  let fromMemberProfile = profileFromName fromMemberName
      initialStatus = maybe GSMemAccepted (acceptanceToStatus $ memberAdmission groupProfile) accepted
  updatePreparedUserAndHostMembers' db cxt user gInfo hostMember fromMember fromMemberProfile invitedMember groupProfile business initialStatus

updatePreparedUserAndHostMembersRejected :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupMember -> GroupLinkRejection -> ExceptT StoreError IO (GroupInfo, GroupMember)
updatePreparedUserAndHostMembersRejected db cxt user gInfo hostMember GroupLinkRejection {fromMember = fromMember@MemberIdRole {memberId}, invitedMember, groupProfile} = do
  let fromMemberProfile = profileFromName $ nameFromMemberId memberId
  updatePreparedUserAndHostMembers' db cxt user gInfo hostMember fromMember fromMemberProfile invitedMember groupProfile Nothing GSMemRejected

updatePreparedUserAndHostMembers' :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupMember -> MemberIdRole -> Profile -> MemberIdRole -> GroupProfile -> Maybe BusinessChatInfo -> GroupMemberStatus -> ExceptT StoreError IO (GroupInfo, GroupMember)
updatePreparedUserAndHostMembers'
  db
  cxt
  user
  gInfo@GroupInfo {groupId, membership, groupProfile = gp, businessChat}
  hostMember
  fromMember
  fromMemberProfile
  invitedMember
  groupProfile
  business
  membershipStatus = do
    currentTs <- liftIO getCurrentTime
    -- For channels, don't regress membership status if already connected via another relay
    unless (memberStatus membership == GSMemConnected) $
      liftIO $ updateUserMember currentTs
    hostMember' <- updateHostMember currentTs
    when (gp /= groupProfile) $
      void $ updateGroupProfile db user gInfo groupProfile
    when (isJust businessChat && isJust business) $
      liftIO $ updateBusinessChatInfo db groupId business
    gInfo' <- getGroupInfo db cxt user groupId
    pure (gInfo', hostMember')
    where
      updateUserMember currentTs = do
        let MemberIdRole memberId memberRole = invitedMember
        DB.execute
          db
          [sql|
            UPDATE group_members
            SET member_id = ?,
                member_role = ?,
                member_status = ?,
                updated_at = ?
            WHERE group_member_id = ?
          |]
          (memberId, memberRole, membershipStatus, currentTs, groupMemberId' membership)
      updateHostMember currentTs = do
        _ <- updateMemberProfile db cxt user hostMember fromMemberProfile
        let MemberIdRole memberId memberRole = fromMember
            gmId = groupMemberId' hostMember
        liftIO $
          DB.execute
            db
            [sql|
              UPDATE group_members
              SET member_id = ?,
                  member_role = ?,
                  updated_at = ?
              WHERE group_member_id = ?
            |]
            (memberId, memberRole, currentTs, gmId)
        getGroupMemberById db cxt user gmId

createGroupInvitedViaLink :: DB.Connection -> StoreCxt -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
createGroupInvitedViaLink db cxt user conn GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile, accepted, business} = do
  let fromMemberProfile = profileFromName fromMemberName
      initialStatus = maybe GSMemAccepted (acceptanceToStatus $ memberAdmission groupProfile) accepted
  createGroupViaLink' db cxt user conn fromMember fromMemberProfile invitedMember groupProfile business initialStatus

createGroupRejectedViaLink :: DB.Connection -> StoreCxt -> User -> Connection -> GroupLinkRejection -> ExceptT StoreError IO (GroupInfo, GroupMember)
createGroupRejectedViaLink db cxt user conn GroupLinkRejection {fromMember = fromMember@MemberIdRole {memberId}, invitedMember, groupProfile} = do
  let fromMemberProfile = profileFromName $ nameFromMemberId memberId
  createGroupViaLink' db cxt user conn fromMember fromMemberProfile invitedMember groupProfile Nothing GSMemRejected

createGroupViaLink' :: DB.Connection -> StoreCxt -> User -> Connection -> MemberIdRole -> Profile -> MemberIdRole -> GroupProfile -> Maybe BusinessChatInfo -> GroupMemberStatus -> ExceptT StoreError IO (GroupInfo, GroupMember)
createGroupViaLink'
  db
  cxt
  user@User {userId, userContactId}
  Connection {connId, customUserProfileId}
  fromMember
  fromMemberProfile
  invitedMember
  groupProfile
  business
  membershipStatus = do
    currentTs <- liftIO getCurrentTime
    (groupId, _groupLDN) <- createGroup_ db userId groupProfile Nothing business False Nothing Nothing currentTs
    hostMemberId <- insertHost_ currentTs groupId
    liftIO $ DB.execute db "UPDATE connections SET conn_type = ?, group_member_id = ?, updated_at = ? WHERE connection_id = ?" (ConnMember, hostMemberId, currentTs, connId)
    -- using IBUnknown since host is created without contact
    -- TODO [member keys] this is currently not used with public groups. If it needs to be used, member keys need to be added
    void $ createContactMemberInv_ db user groupId (Just hostMemberId) user invitedMember GCUserMember membershipStatus IBUnknown customUserProfileId Nothing currentTs (vr cxt)
    liftIO $ setViaGroupLinkUri db groupId connId
    (,) <$> getGroupInfo db cxt user groupId <*> getGroupMemberById db cxt user hostMemberId
    where
      insertHost_ currentTs groupId = do
        (localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user fromMemberProfile currentTs
        let MemberIdRole {memberId, memberRole} = fromMember
        indexInGroup <- getUpdateNextIndexInGroup_ db groupId
        liftIO $ do
          DB.execute
            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 (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
            |]
            ( (groupId, indexInGroup, memberId, memberRole, GCHostMember, GSMemAccepted, Binary B.empty, fromInvitedBy userContactId IBUnknown)
                :. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, currentTs, currentTs)
            )
          insertedRowId db

createGroup_ :: DB.Connection -> UserId -> GroupProfile -> Maybe (CreatedLinkContact, Maybe SharedMsgId) -> Maybe BusinessChatInfo -> Bool -> Maybe RelayStatus -> Maybe Int64 -> UTCTime -> ExceptT StoreError IO (GroupId, Text)
createGroup_ db userId groupProfile prepared business useRelays relayOwnStatus publicMemberCount_ currentTs = ExceptT $ do
  let GroupProfile {displayName, fullName, shortDescr, description, image, publicGroup, groupPreferences, memberAdmission} = groupProfile
      (groupType_, groupLink_, publicGroupId_) = case publicGroup of
        Just PublicGroupProfile {groupType, groupLink, publicGroupId} -> (Just groupType, Just groupLink, Just publicGroupId)
        Nothing -> (Nothing, Nothing, Nothing)
  withLocalDisplayName db userId displayName $ \localDisplayName -> runExceptT $ do
    liftIO $ do
      DB.execute
        db
        [sql|
          INSERT INTO group_profiles
            (display_name, full_name, short_descr, description, image,
             group_type, group_link, public_group_id,
             group_web_page, group_domain, domain_web_page, allow_embedding, group_domain_proof,
             user_id, preferences, member_admission, created_at, updated_at)
          VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
        |]
        ((displayName, fullName, shortDescr, description, image, groupType_, groupLink_, publicGroupId_) :. publicGroupAccessRow publicGroup
          :. (userId, groupPreferences, memberAdmission, currentTs, currentTs))
      profileId <- insertedRowId db
      DB.execute
        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, use_relays, relay_own_status, public_member_count)
          VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
        |]
        ((profileId, localDisplayName, userId, BI True, currentTs, currentTs, currentTs, currentTs) :. toPreparedGroupRow prepared :. businessChatInfoRow business :. (BI useRelays, relayOwnStatus, publicMemberCount_))
      groupId <- insertedRowId db
      pure (groupId, localDisplayName)

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

-- TODO return the last connection that is ready, not any last connection
-- requires updating connection status
getGroup :: DB.Connection -> StoreCxt -> User -> GroupId -> ExceptT StoreError IO Group
getGroup db cxt user groupId = do
  gInfo <- getGroupInfo db cxt user groupId
  members <- liftIO $ getGroupMembers db cxt user gInfo
  pure $ Group gInfo members

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

deleteGroupMembers :: DB.Connection -> User -> GroupInfo -> IO ()
deleteGroupMembers db User {userId} GroupInfo {groupId} = do
  DB.execute_ db "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
  DB.execute_ db "CREATE TABLE temp_delete_members (contact_profile_id INTEGER, member_profile_id INTEGER, local_display_name TEXT)"
#endif
  DB.execute
    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 = ?
    |]
    (Only groupId)
  DB.execute db "DELETE FROM group_members WHERE user_id = ? AND group_id = ?" (userId, groupId)
  DB.execute
    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)
    |]
    (Only userId)
  DB.execute
    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)
    |]
    (Only userId)
  DB.execute_ db "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 db user@User {userId} GroupInfo {groupId} = do
  runExceptT (getHostMemberId_ db user groupId) >>= \case
    Left _ -> pure ()
    Right hostId ->
      DB.execute
        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, hostId)

deleteGroup :: DB.Connection -> User -> GroupInfo -> IO ()
deleteGroup db user@User {userId} g@GroupInfo {groupId, localDisplayName} = do
  deleteGroupProfile_ db userId groupId
  DB.execute db "DELETE FROM groups WHERE user_id = ? AND group_id = ?" (userId, groupId)
  safeDeleteLDN db user localDisplayName
  forM_ (incognitoMembershipProfile g) $ deleteUnusedIncognitoProfileById_ db user . localProfileId

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

getInProgressGroups :: DB.Connection -> StoreCxt -> User -> UTCTime -> IO [GroupInfo]
getInProgressGroups db cxt user@User {userId} createdAtCutoff = do
  groupIds <- map fromOnly <$>
    DB.query
      db
      "SELECT group_id FROM groups WHERE user_id = ? AND creating_in_progress = 1 AND created_at <= ?"
      (userId, createdAtCutoff)
  rights <$> mapM (runExceptT . getGroupInfo db cxt user) groupIds

getBaseGroupDetails :: DB.Connection -> StoreCxt -> User -> Maybe ContactId -> Maybe Text -> IO [GroupInfo]
getBaseGroupDetails db cxt User {userId, userContactId} _contactId_ search_ = do
  currentTs <- getCurrentTime
  map (toGroupInfo currentTs cxt userContactId [])
    <$> DB.query db (groupInfoQuery <> " " <> condition) (userId, userContactId, search, search, search, search)
  where
    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 = maybe "" (T.map toLower) search_

getContactGroupPreferences :: DB.Connection -> User -> Contact -> IO [(GroupMemberRole, FullGroupPreferences)]
getContactGroupPreferences db User {userId} Contact {contactId} = do
  map (second mergeGroupPreferences)
    <$> DB.query
      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, contactId)

getGroupInfoByName :: DB.Connection -> StoreCxt -> User -> GroupName -> ExceptT StoreError IO GroupInfo
getGroupInfoByName db cxt user gName = do
  gId <- getGroupIdByName db user gName
  getGroupInfo db cxt user gId

getGroupToConnect :: DB.Connection -> StoreCxt -> User -> ContactNameOrLink -> ExceptT StoreError IO (Maybe (CreatedLinkContact, GroupInfo))
getGroupToConnect db cxt user@User {userId} = \case
  CTLink sl -> first (`CCLink` Just sl) <$$> getGroupViaShortLinkToConnect db cxt user sl
  CTName ni ->
    liftIO (maybeFirstRow id $ DB.query db byNameQuery (userId, nameDomain ni)) >>= \case
      Just (gId :: Int64, Just cReq, Just (sLnk :: ShortLinkContact)) -> Just . (CCLink cReq (Just sLnk),) <$> getGroupInfo db cxt user gId
      _ -> pure Nothing
  where
    byNameQuery =
      [sql|
        SELECT g.group_id, g.conn_full_link_to_connect, g.conn_short_link_to_connect FROM groups g
        JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
        WHERE g.user_id = ? AND gp.group_domain = ? AND g.group_domain_verified = 1
      |]

getGroupMember :: DB.Connection -> StoreCxt -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO GroupMember
getGroupMember db cxt user@User {userId} groupId groupMemberId = do
  currentTs <- liftIO getCurrentTime
  ExceptT . firstRow (toContactMember currentTs cxt user) (SEGroupMemberNotFound groupMemberId) $
    DB.query
      db
      (groupMemberQuery <> " WHERE m.group_id = ? AND m.group_member_id = ? AND m.user_id = ?")
      (groupId, groupMemberId, userId)

getHostMember :: DB.Connection -> StoreCxt -> User -> GroupId -> ExceptT StoreError IO GroupMember
getHostMember db cxt user groupId = do
  currentTs <- liftIO getCurrentTime
  ExceptT . firstRow (toContactMember currentTs cxt user) (SEGroupHostMemberNotFound groupId) $
    DB.query
      db
      (groupMemberQuery <> " WHERE m.group_id = ? AND m.member_category = ?")
      (groupId, GCHostMember)

getMentionedGroupMember :: DB.Connection -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO CIMention
getMentionedGroupMember db User {userId} groupId gmId =
  ExceptT $
    firstRow toMentionedMember (SEGroupMemberNotFound gmId) $
      DB.query
        db
        (mentionedMemberQuery <> " WHERE m.group_id = ? AND m.group_member_id = ? AND m.user_id = ?")
        (groupId, gmId, userId)

getMentionedMemberByMemberId :: DB.Connection -> User -> GroupId -> MsgMention -> IO CIMention
getMentionedMemberByMemberId db User {userId} groupId MsgMention {memberId} =
  fmap (fromMaybe mentionedMember) $
    maybeFirstRow toMentionedMember $
      DB.query
        db
        (mentionedMemberQuery <> " WHERE m.group_id = ? AND m.member_id = ? AND m.user_id = ?")
        (groupId, memberId, userId)
  where
    mentionedMember = CIMention {memberId, memberRef = Nothing}

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 (groupMemberId, memberId, memberRole, displayName, localAlias) =
  let memberRef = Just CIMentionMember {groupMemberId, displayName, localAlias, memberRole}
   in CIMention {memberId, memberRef}

getGroupMemberById :: DB.Connection -> StoreCxt -> User -> GroupMemberId -> ExceptT StoreError IO GroupMember
getGroupMemberById db cxt user@User {userId} groupMemberId = do
  currentTs <- liftIO getCurrentTime
  ExceptT . firstRow (toContactMember currentTs cxt user) (SEGroupMemberNotFound groupMemberId) $
    DB.query
      db
      (groupMemberQuery <> " WHERE m.group_member_id = ? AND m.user_id = ?")
      (groupMemberId, userId)

getNonRemovedMemberById :: DB.Connection -> StoreCxt -> User -> GroupMemberId -> ExceptT StoreError IO GroupMember
getNonRemovedMemberById db cxt user@User {userId} groupMemberId = do
  ts <- liftIO getCurrentTime
  ExceptT . firstRow (toContactMember ts cxt user) (SEGroupMemberNotFound groupMemberId) $
    DB.query
      db
      (groupMemberQuery <> " WHERE m.group_member_id = ? AND m.user_id = ? AND m.member_status NOT IN (?,?,?,?)")
      (groupMemberId, userId, GSMemRejected, GSMemRemoved, GSMemLeft, GSMemGroupDeleted)

getGroupMemberByIndex :: DB.Connection -> StoreCxt -> User -> GroupInfo -> Int64 -> ExceptT StoreError IO GroupMember
getGroupMemberByIndex db cxt user GroupInfo {groupId} indexInGroup = do
  currentTs <- liftIO getCurrentTime
  ExceptT . firstRow (toContactMember currentTs cxt user) (SEGroupMemberNotFoundByIndex indexInGroup) $
    DB.query
      db
      (groupMemberQuery <> " WHERE m.group_id = ? AND m.index_in_group = ?")
      (groupId, indexInGroup)

getSupportScopeMemberByIndex :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupMemberId -> Int64 -> ExceptT StoreError IO GroupMember
getSupportScopeMemberByIndex db cxt user GroupInfo {groupId} scopeGMId indexInGroup = do
  currentTs <- liftIO getCurrentTime
  ExceptT . firstRow (toContactMember currentTs cxt user) (SEGroupMemberNotFoundByIndex indexInGroup) $
    DB.query
      db
      (groupMemberQuery <> " WHERE m.group_id = ? AND m.index_in_group = ? AND (m.member_role IN (?,?,?) OR m.group_member_id = ?)")
      (groupId, indexInGroup, GRModerator, GRAdmin, GROwner, scopeGMId)

getGroupMemberByMemberId :: DB.Connection -> StoreCxt -> User -> GroupInfo -> MemberId -> ExceptT StoreError IO GroupMember
getGroupMemberByMemberId db cxt user GroupInfo {groupId} memberId = do
  currentTs <- liftIO getCurrentTime
  ExceptT . firstRow (toContactMember currentTs cxt user) (SEGroupMemberNotFoundByMemberId memberId) $
    DB.query
      db
      (groupMemberQuery <> " WHERE m.group_id = ? AND m.member_id = ?")
      (groupId, memberId)

getCreateUnknownGMByMemberId :: DB.Connection -> StoreCxt -> User -> GroupInfo -> MemberId -> ContactName -> GroupMemberRole -> Bool -> ExceptT StoreError IO (Maybe (GroupMember, Bool))
getCreateUnknownGMByMemberId db cxt user gInfo memberId memberName unknownMemberRole allowCreate = do
  liftIO (runExceptT $ getGroupMemberByMemberId db cxt user gInfo memberId) >>= \case
    Right m -> pure $ Just (m, False)
    Left (SEGroupMemberNotFoundByMemberId _)
      | allowCreate -> do
          let name = if T.null memberName then nameFromMemberId memberId else memberName
          m <- createNewUnknownGroupMember db cxt user gInfo memberId name unknownMemberRole
          pure $ Just (m, True)
      | otherwise -> pure Nothing
    Left e -> throwError e

getScopeMemberIdViaMemberId :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberId -> ExceptT StoreError IO GroupMemberId
getScopeMemberIdViaMemberId db user g@GroupInfo {membership} sender scopeMemberId
  | scopeMemberId == memberId' membership = pure $ groupMemberId' membership
  | scopeMemberId == memberId' sender = pure $ groupMemberId' sender
  | otherwise = getGroupMemberIdViaMemberId db user g scopeMemberId

getGroupMemberIdViaMemberId :: DB.Connection -> User -> GroupInfo -> MemberId -> ExceptT StoreError IO GroupMemberId
getGroupMemberIdViaMemberId db User {userId} GroupInfo {groupId} memberId =
  ExceptT . firstRow fromOnly (SEGroupMemberNotFoundByMemberId memberId) $
    DB.query
      db
      "SELECT group_member_id FROM group_members WHERE user_id = ? AND group_id = ? AND member_id = ?"
      (userId, groupId, memberId)

getGroupMembers :: DB.Connection -> StoreCxt -> User -> GroupInfo -> IO [GroupMember]
getGroupMembers db cxt user@User {userId, userContactId} GroupInfo {groupId} = do
  currentTs <- getCurrentTime
  map (toContactMember currentTs cxt user)
    <$> DB.query
      db
      (groupMemberQuery <> " WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?)")
      (userId, groupId, userContactId)

getGroupMembersByIndexes :: DB.Connection -> StoreCxt -> User -> GroupInfo -> [Int64] -> IO [GroupMember]
getGroupMembersByIndexes db cxt user gInfo indexesInGroup = do
#if defined(dbPostgres)
  currentTs <- getCurrentTime
  let GroupInfo {groupId} = gInfo
  map (toContactMember currentTs cxt user) <$>
    DB.query
      db
      (groupMemberQuery <> " WHERE m.group_id = ? AND m.index_in_group IN ?")
      (groupId, In indexesInGroup)
#else
  rights <$> mapM (runExceptT . getGroupMemberByIndex db cxt user gInfo) indexesInGroup
#endif

getSupportScopeMembersByIndexes :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupMemberId -> [Int64] -> IO [GroupMember]
getSupportScopeMembersByIndexes db cxt user gInfo scopeGMId indexesInGroup = do
#if defined(dbPostgres)
  currentTs <- getCurrentTime
  let GroupInfo {groupId} = gInfo
  map (toContactMember currentTs cxt 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
  rights <$> mapM (runExceptT . getSupportScopeMemberByIndex db cxt user gInfo scopeGMId) indexesInGroup
#endif

getGroupModerators :: DB.Connection -> StoreCxt -> User -> GroupInfo -> IO [GroupMember]
getGroupModerators db cxt user@User {userId, userContactId} GroupInfo {groupId} = do
  currentTs <- getCurrentTime
  map (toContactMember currentTs cxt user)
    <$> DB.query
      db
      (groupMemberQuery <> " WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role IN (?,?,?)")
      (userId, groupId, userContactId, GRModerator, GRAdmin, GROwner)

-- The full roster set - members, moderators and admins - excluding owners (link-anchored) and
-- left/removed members. For the privileged subset only use getGroupAdminsMods; for plain members
-- only use getGroupOnlyMembers.
getGroupRosterMembers :: DB.Connection -> StoreCxt -> User -> GroupInfo -> IO [GroupMember]
getGroupRosterMembers db cxt user@User {userId, userContactId} GroupInfo {groupId} = do
  currentTs <- getCurrentTime
  filter memberCurrent . map (toContactMember currentTs cxt user)
    <$> DB.query
      db
      (groupMemberQuery <> " WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role IN (?,?,?)")
      (userId, groupId, userContactId, GRMember, GRModerator, GRAdmin)

-- Moderators and admins only (excluding owners and plain members) - the set introduced to a
-- joiner; plain members are learned from the roster blob, not via introductions.
getGroupAdminsMods :: DB.Connection -> StoreCxt -> User -> GroupInfo -> IO [GroupMember]
getGroupAdminsMods db cxt user@User {userId, userContactId} GroupInfo {groupId} = do
  currentTs <- getCurrentTime
  filter memberCurrent . map (toContactMember currentTs cxt user)
    <$> DB.query
      db
      (groupMemberQuery <> " WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role IN (?,?)")
      (userId, groupId, userContactId, GRModerator, GRAdmin)

getGroupOnlyMembers :: DB.Connection -> StoreCxt -> User -> GroupInfo -> IO [GroupMember]
getGroupOnlyMembers db cxt user@User {userId, userContactId} GroupInfo {groupId} = do
  currentTs <- getCurrentTime
  filter memberCurrent . map (toContactMember currentTs cxt user)
    <$> DB.query
      db
      (groupMemberQuery <> " WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role = ?")
      (userId, groupId, userContactId, GRMember)

getGroupOwners :: DB.Connection -> StoreCxt -> User -> GroupInfo -> IO [GroupMember]
getGroupOwners db cxt user@User {userId, userContactId} GroupInfo {groupId} = do
  currentTs <- getCurrentTime
  filter memberCurrent . map (toContactMember currentTs cxt user)
    <$> DB.query
      db
      (groupMemberQuery <> " WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role = ?")
      (userId, groupId, userContactId, GROwner)

getGroupRelayMembers :: DB.Connection -> StoreCxt -> User -> GroupInfo -> IO [GroupMember]
getGroupRelayMembers db cxt user@User {userId, userContactId} GroupInfo {groupId} = do
  currentTs <- getCurrentTime
  map (toContactMember currentTs cxt user)
    <$> DB.query
      db
      (groupMemberQuery <> " WHERE m.user_id = ? AND m.group_id = ? AND m.contact_id IS DISTINCT FROM ? AND m.member_role = ?")
      (userId, groupId, userContactId, GRRelay)

getGroupMembersForExpiration :: DB.Connection -> StoreCxt -> User -> GroupInfo -> IO [GroupMember]
getGroupMembersForExpiration db cxt user@User {userId, userContactId} GroupInfo {groupId} = do
  currentTs <- getCurrentTime
  map (toContactMember currentTs cxt user)
    <$> DB.query
      db
      ( groupMemberQuery
          <> " "
          <> [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
                  )
              |]
      )
      (groupId, userId, userContactId, GSMemRemoved, GSMemLeft, GSMemGroupDeleted, GSMemUnknown)

getRemovedMembersToCleanup :: DB.Connection -> StoreCxt -> User -> UTCTime -> IO [GroupMember]
getRemovedMembersToCleanup db cxt user@User {userId} cutoffTs = do
  ts <- getCurrentTime
  map (toContactMember ts cxt user)
    <$> DB.query
      db
      (groupMemberQuery <> " WHERE m.user_id = ? AND m.removed_at < ?")
      (userId, cutoffTs)

getGroupInvitation :: DB.Connection -> StoreCxt -> User -> GroupId -> ExceptT StoreError IO ReceivedGroupInvitation
getGroupInvitation db cxt user groupId =
  getConnRec_ user >>= \case
    Just connRequest -> do
      groupInfo@GroupInfo {membership} <- getGroupInfo db cxt user groupId
      when (memberStatus membership /= GSMemInvited) $ throwError SEGroupAlreadyJoined
      hostId <- getHostMemberId_ db user groupId
      fromMember <- getGroupMember db cxt user groupId hostId
      pure ReceivedGroupInvitation {fromMember, connRequest, groupInfo}
    _ -> throwError SEGroupInvitationNotFound
  where
    getConnRec_ :: User -> ExceptT StoreError IO (Maybe ConnReqInvitation)
    getConnRec_ User {userId} = ExceptT $ do
      firstRow fromOnly (SEGroupNotFound groupId) $
        DB.query db "SELECT g.inv_queue_info FROM groups g WHERE g.group_id = ? AND g.user_id = ?" (groupId, userId)

createNewContactMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> Contact -> GroupMemberRole -> ConnId -> ConnReqInvitation -> SubscriptionMode -> ExceptT StoreError IO GroupMember
createNewContactMember _ _ _ _ Contact {localDisplayName, activeConn = Nothing} _ _ _ _ = throwError $ SEContactNotReady localDisplayName
createNewContactMember db gVar User {userId, userContactId} GroupInfo {groupId, membership} Contact {contactId, localDisplayName, profile, activeConn = Just Connection {connChatVersion, peerChatVRange}} memberRole agentConnId connRequest subMode =
  createWithRandomId' db gVar $ \memId -> runExceptT $ do
    createdAt <- liftIO getCurrentTime
    member@GroupMember {groupMemberId} <- createMember_ (MemberId memId) createdAt
    void $ liftIO $ createMemberConnection_ db userId groupMemberId agentConnId connChatVersion peerChatVRange Nothing 0 createdAt subMode
    pure member
  where
    VersionRange minV maxV = peerChatVRange
    invitedByGroupMemberId = groupMemberId' membership
    createMember_ memberId createdAt = do
      indexInGroup <- insertMember_
      groupMemberId <- liftIO $ insertedRowId db
      pure
        GroupMember
          { groupMemberId,
            groupId,
            indexInGroup,
            memberId,
            memberRole,
            memberCategory = GCInviteeMember,
            memberStatus = GSMemInvited,
            memberSettings = defaultMemberSettings,
            blockedByAdmin = False,
            invitedBy = IBUser,
            invitedByGroupMemberId = Just invitedByGroupMemberId,
            localDisplayName,
            memberProfile = profile,
            memberContactId = Just contactId,
            memberContactProfileId = localProfileId profile,
            activeConn = Nothing,
            memberChatVRange = peerChatVRange,
            createdAt,
            updatedAt = createdAt,
            supportChat = Nothing,
            memberPubKey = Nothing,
            relayLink = Nothing
          }
      where
        insertMember_ = do
          indexInGroup <- getUpdateNextIndexInGroup_ db groupId
          liftIO $
            DB.execute
              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 (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
              |]
              ( (groupId, indexInGroup, memberId, memberRole, GCInviteeMember, GSMemInvited, Binary B.empty, fromInvitedBy userContactId IBUser, invitedByGroupMemberId)
                  :. (userId, localDisplayName, contactId, localProfileId profile, connRequest, createdAt, createdAt)
                  :. (minV, maxV)
              )
          pure indexInGroup

createGroupRelayRecord :: DB.Connection -> GroupInfo -> GroupMember -> UserChatRelay -> ExceptT StoreError IO GroupRelay
createGroupRelayRecord db GroupInfo {groupId} GroupMember {groupMemberId} UserChatRelay {chatRelayId} = do
  currentTs <- liftIO getCurrentTime
  liftIO $
    DB.execute
      db
      [sql|
        INSERT INTO group_relays
          (group_id, group_member_id, chat_relay_id, relay_status, created_at, updated_at)
        VALUES (?,?,?,?,?,?)
      |]
      (groupId, groupMemberId, chatRelayId, RSNew, currentTs, currentTs)
  relayId <- liftIO $ insertedRowId db
  getGroupRelayById db relayId

getGroupRelayById :: DB.Connection -> Int64 -> ExceptT StoreError IO GroupRelay
getGroupRelayById db relayId =
  ExceptT . firstRow toGroupRelay (SEGroupRelayNotFound relayId) $
    DB.query
      db
      (groupRelayQuery <> " WHERE gr.group_relay_id = ?")
      (Only relayId)

getGroupRelayByGMId :: DB.Connection -> GroupMemberId -> ExceptT StoreError IO GroupRelay
getGroupRelayByGMId db groupMemberId =
  ExceptT . firstRow toGroupRelay (SEGroupRelayNotFoundByMemberId groupMemberId) $
    DB.query
      db
      (groupRelayQuery <> " WHERE gr.group_member_id = ?")
      (Only groupMemberId)

getGroupRelays :: DB.Connection -> GroupInfo -> IO [GroupRelay]
getGroupRelays db GroupInfo {groupId} =
  map toGroupRelay
    <$> DB.query
      db
      (groupRelayQuery <> " WHERE gr.group_id = ?")
      (Only groupId)

-- Relays whose link is published to subscribers: acked relays (RSAcknowledgedRoster/RSActive) plus
-- pre-roster relays at RSAccepted (below groupRosterVersion, they can't ack a roster), gated by the
-- relay's negotiated version read from its member connection.
getPublishableGroupRelays :: DB.Connection -> StoreCxt -> User -> GroupInfo -> IO [GroupRelay]
getPublishableGroupRelays db cxt user gInfo@GroupInfo {groupId} = do
  relays <-
    map toGroupRelay
      <$> DB.query
        db
        ( groupRelayQuery
            <> " "
            <> [sql|
                 JOIN group_members m ON m.group_member_id = gr.group_member_id
                 WHERE gr.group_id = ?
                   AND m.member_status = ?
                   AND gr.relay_status IN (?,?,?)
               |]
        )
        (groupId, GSMemConnected, RSAccepted, RSAcknowledgedRoster, RSActive)
  members <- getGroupRelayMembers db cxt user gInfo
  pure [gr | gr@GroupRelay {groupMemberId} <- relays, m <- members, groupMemberId' m == groupMemberId, publishable gr m]
  where
    publishable GroupRelay {relayStatus} m =
      relayStatus /= RSAccepted || not (m `supportsVersion` groupRosterVersion)

groupRelayQuery :: Query
groupRelayQuery =
  [sql|
    SELECT gr.group_relay_id, gr.group_member_id,
           cr.chat_relay_id, cr.address, cr.display_name, cr.full_name, cr.short_descr, cr.image, cr.domains, cr.preset, cr.tested, cr.enabled, cr.deleted,
           gr.relay_status, gr.relay_link, gr.base_web_url
    FROM group_relays gr
    JOIN chat_relays cr ON cr.chat_relay_id = gr.chat_relay_id
  |]

toGroupRelay :: (Int64, GroupMemberId, DBEntityId, ShortLinkContact, Text, Text, Maybe Text, Maybe ImageData, Text, BoolInt) :. (Maybe BoolInt, BoolInt, BoolInt, RelayStatus, Maybe ShortLinkContact, Maybe Text) -> GroupRelay
toGroupRelay ((groupRelayId, groupMemberId, chatRelayId, address, displayName, fullName, shortDescr, image, domains, BI preset) :. (tested, BI enabled, BI deleted, relayStatus, relayLink, webDomain)) =
  let userChatRelay = UserChatRelay {chatRelayId, address, relayProfile = toRelayProfile (displayName, fullName, shortDescr, image), domains = T.splitOn "," domains, preset, tested = unBI <$> tested, enabled, deleted}
      relayCap = RelayCapabilities {webDomain}
   in GroupRelay {groupRelayId, groupMemberId, userChatRelay, relayStatus, relayLink, relayCap}

setGroupRosterVersion :: DB.Connection -> GroupInfo -> VersionRoster -> IO ()
setGroupRosterVersion db GroupInfo {groupId} v = do
  currentTs <- getCurrentTime
  DB.execute db "UPDATE groups SET roster_version = ?, updated_at = ? WHERE group_id = ?" (v, currentTs, groupId)

-- Persisted roster version (the gate baseline; the in-memory gInfo copy is batch-constant and stale on reorder).
getGroupRosterVersion :: DB.Connection -> GroupInfo -> IO (Maybe VersionRoster)
getGroupRosterVersion db GroupInfo {groupId} =
  fmap join . maybeFirstRow fromOnly $
    DB.query db "SELECT roster_version FROM groups WHERE group_id = ?" (Only groupId)

-- The live roster header a relay re-serves to joiners, with the completed blob served alongside it
-- (both are written together at completion, so the blob is present whenever the header is).
getGroupRoster :: DB.Connection -> GroupInfo -> IO (Maybe (GroupMemberId, UTCTime, SignedMsg, Maybe ByteString))
getGroupRoster db GroupInfo {groupId} =
  (>>= toRoster)
    <$> maybeFirstRow
      id
      ( DB.query
          db
          "SELECT roster_sending_owner_gm_id, roster_broker_ts, roster_msg_chat_binding, roster_msg_signatures, roster_msg_body, roster_blob FROM groups WHERE group_id = ?"
          (Only groupId)
      )
  where
    toRoster (Just ownerGMId, Just brokerTs, Just cb, Just (Binary sigsBs), Just (Binary body), blob_) =
      (\sigs -> (ownerGMId, brokerTs, SignedMsg cb sigs body, (\(Binary b) -> b) <$> blob_)) <$> eitherToMaybe (smpDecode sigsBs)
    toRoster _ = Nothing

-- A per-source in-flight roster transfer, keyed (group_id, from_member_id): replaces the single
-- roster_pending_* slot, so two relays serving one member can't share a chunk stream. The signed-header
-- columns are relay-only (NULL on members), promoted to the live roster_msg_* on groups at completion.
createRosterTransfer :: DB.Connection -> GroupInfo -> GroupMemberId -> VersionRoster -> FD.FileDigest -> GroupMemberId -> UTCTime -> Maybe SignedMsg -> IO Int64
createRosterTransfer db GroupInfo {groupId} fromMemberId v digest ownerGMId brokerTs sm_ = do
  -- one in-flight transfer per (group, source): drop any prior row from this source so the INSERT can't hit
  -- the UNIQUE constraint even if the caller's fs/handle cleanup was skipped (the scratch file would then leak
  -- until group delete, but the transfer never gets stuck). Normally cleanupRosterTransfer ran first.
  DB.execute db "DELETE FROM rcv_roster_transfers WHERE group_id = ? AND from_member_id = ?" (groupId, fromMemberId)
  DB.execute
    db
    [sql|
      INSERT INTO rcv_roster_transfers
        (group_id, from_member_id, roster_version, roster_digest, sending_owner_gm_id, broker_ts,
         roster_msg_chat_binding, roster_msg_signatures, roster_msg_body)
      VALUES (?,?,?,?,?,?,?,?,?)
    |]
    ( (groupId, fromMemberId, v, Binary (FD.unFileDigest digest), ownerGMId, brokerTs)
        :. ((\SignedMsg {chatBinding} -> chatBinding) <$> sm_, (\SignedMsg {signatures} -> Binary (smpEncode signatures)) <$> sm_, (\SignedMsg {signedBody} -> Binary signedBody) <$> sm_)
    )
  insertedRowId db

getRosterTransferVersion :: DB.Connection -> GroupInfo -> GroupMemberId -> IO (Maybe VersionRoster)
getRosterTransferVersion db GroupInfo {groupId} fromMemberId =
  maybeFirstRow fromOnly $
    DB.query db "SELECT roster_version FROM rcv_roster_transfers WHERE group_id = ? AND from_member_id = ?" (groupId, fromMemberId)

getRosterTransferId :: DB.Connection -> GroupInfo -> GroupMemberId -> IO (Maybe Int64)
getRosterTransferId db GroupInfo {groupId} fromMemberId =
  maybeFirstRow fromOnly $
    DB.query db "SELECT roster_transfer_id FROM rcv_roster_transfers WHERE group_id = ? AND from_member_id = ?" (groupId, fromMemberId)

-- An in-flight received roster transfer (a rcv_roster_transfers row joined to its scratch file), read at
-- completion. The header is the relay's re-serve SignedMsg -- present only on a serving relay (NULL on a
-- member, whose live roster_msg_* stay NULL so it never re-serves).
data RcvRosterTransfer = RcvRosterTransfer
  { rosterTransferId :: Int64,
    rosterTransferVersion :: VersionRoster,
    rosterTransferDigest :: FD.FileDigest,
    rosterTransferOwnerGMId :: GroupMemberId,
    rosterTransferBrokerTs :: UTCTime,
    rosterTransferHeader :: Maybe SignedMsg
  }
  deriving (Show)

-- The in-flight transfer for a received roster file (joined via files.roster_transfer_id), with its
-- relay-only signed header. Read at completion to apply, promote into the live roster, and ack.
getRosterTransfer :: DB.Connection -> Int64 -> IO (Maybe RcvRosterTransfer)
getRosterTransfer db fileId =
  (>>= toTransfer)
    <$> maybeFirstRow
      id
      ( DB.query
          db
          [sql|
            SELECT t.roster_transfer_id, t.roster_version, t.roster_digest, t.sending_owner_gm_id, t.broker_ts,
                   t.roster_msg_chat_binding, t.roster_msg_signatures, t.roster_msg_body
            FROM rcv_roster_transfers t
            JOIN files f ON f.roster_transfer_id = t.roster_transfer_id
            WHERE f.file_id = ?
          |]
          (Only fileId)
      )
  where
    toTransfer (tId, v, Binary d, ownerGMId, brokerTs, cb_, sigs_, body_) =
      Just
        RcvRosterTransfer
          { rosterTransferId = tId,
            rosterTransferVersion = v,
            rosterTransferDigest = FD.FileDigest d,
            rosterTransferOwnerGMId = ownerGMId,
            rosterTransferBrokerTs = brokerTs,
            rosterTransferHeader = sm_
          }
      where
        sm_ = case (cb_, sigs_, body_) of
          (Just cb, Just (Binary sigsBs), Just (Binary body)) ->
            (\sigs -> SignedMsg cb sigs body) <$> eitherToMaybe (smpDecode sigsBs)
          _ -> Nothing

-- Write the single live roster on groups from a completed transfer's values (header NULL on a member,
-- so its live roster_msg_* stay NULL and it never re-serves; only relays re-serve).
setGroupLiveRoster :: DB.Connection -> GroupInfo -> VersionRoster -> GroupMemberId -> UTCTime -> Maybe SignedMsg -> ByteString -> IO ()
setGroupLiveRoster db GroupInfo {groupId} v ownerGMId brokerTs sm_ blob = do
  currentTs <- getCurrentTime
  DB.execute
    db
    [sql|
      UPDATE groups SET
        roster_version = ?, roster_blob = ?,
        roster_sending_owner_gm_id = ?, roster_broker_ts = ?,
        roster_msg_chat_binding = ?, roster_msg_signatures = ?, roster_msg_body = ?,
        updated_at = ?
      WHERE group_id = ?
    |]
    ( (v, Binary blob, ownerGMId, brokerTs)
        :. ((\SignedMsg {chatBinding} -> chatBinding) <$> sm_, (\SignedMsg {signatures} -> Binary (smpEncode signatures)) <$> sm_, (\SignedMsg {signedBody} -> Binary signedBody) <$> sm_, currentTs, groupId)
    )

-- Delete one in-flight transfer row (its files/rcv_files/rcv_file_chunks are removed separately, with
-- the on-disk file). Caller removes the fs file + cached handle first.
deleteRosterTransfer :: DB.Connection -> Int64 -> IO ()
deleteRosterTransfer db transferId =
  DB.execute db "DELETE FROM rcv_roster_transfers WHERE roster_transfer_id = ?" (Only transferId)

-- All in-flight transfers for a group (group delete).
deleteGroupRosterTransfers :: DB.Connection -> Int64 -> IO ()
deleteGroupRosterTransfers db groupId =
  DB.execute db "DELETE FROM rcv_roster_transfers WHERE group_id = ?" (Only groupId)

setGroupMemberKeyRole :: DB.Connection -> GroupMember -> C.PublicKeyEd25519 -> GroupMemberRole -> IO ()
setGroupMemberKeyRole db GroupMember {groupMemberId} pubKey role = do
  currentTs <- getCurrentTime
  DB.execute db "UPDATE group_members SET member_pub_key = ?, member_role = ?, updated_at = ? WHERE group_member_id = ?" (pubKey, role, currentTs, groupMemberId)

createRelayForOwner :: DB.Connection -> StoreCxt -> TVar ChaChaDRG -> User -> GroupInfo -> UserChatRelay -> ExceptT StoreError IO GroupMember
createRelayForOwner db cxt gVar user@User {userId, userContactId} GroupInfo {groupId, membership} UserChatRelay {relayProfile = RelayProfile {displayName}} = do
  currentTs <- liftIO getCurrentTime
  let relayProfile = profileFromName displayName
  (localDisplayName, memProfileId, _) <- createNewMemberProfile_ db cxt user relayProfile currentTs
  groupMemberId <- createWithRandomId' db gVar $ \memId -> runExceptT $ do
    indexInGroup <- getUpdateNextIndexInGroup_ db groupId
    liftIO $
      DB.execute
        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_profile_id, created_at, updated_at)
          VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
        |]
        ( (groupId, indexInGroup, MemberId memId, GRRelay, GCInviteeMember, GSMemInvited, Binary B.empty, fromInvitedBy userContactId IBUser, groupMemberId' membership)
            :. (userId, localDisplayName, memProfileId, currentTs, currentTs)
        )
    liftIO $ insertedRowId db
  getGroupMemberById db cxt user groupMemberId

getCreateRelayForMember :: DB.Connection -> StoreCxt -> TVar ChaChaDRG -> User -> GroupInfo -> ShortLinkContact -> ExceptT StoreError IO GroupMember
getCreateRelayForMember db cxt gVar user@User {userId, userContactId} GroupInfo {groupId, localDisplayName = groupLDN} relayLink = do
  currentTs <- liftIO getCurrentTime
  liftIO (getGroupMemberByRelayLink currentTs) >>= maybe createRelayMember pure
  where
    getGroupMemberByRelayLink currentTs =
      maybeFirstRow (toContactMember currentTs cxt user) $
        DB.query
          db
#if defined(dbPostgres)
          (groupMemberQuery <> " WHERE m.group_id = ? AND m.relay_link = ? AND is_current_member(m.member_status)")
#else
          -- skips GSMemLeft historical rows so re-add allocates a fresh row instead of resurrecting
          (groupMemberQuery <> " JOIN group_member_status_predicates sp ON m.member_status = sp.member_status WHERE m.group_id = ? AND m.relay_link = ? AND sp.current_member = 1")
#endif
          (groupId, relayLink)
    createRelayMember = do
      currentTs <- liftIO getCurrentTime
      randRelayId <- liftIO $ encodedRandomBytes gVar 12
      let memberId = MemberId $ encodeUtf8 groupLDN <> "_unknown_relay_" <> randRelayId
          relayProfile = profileFromName $ nameFromBS randRelayId
      (localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user relayProfile currentTs
      indexInGroup <- getUpdateNextIndexInGroup_ db groupId
      groupMemberId <- liftIO $ do
        DB.execute
          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_profile_id, created_at, updated_at, relay_link
                )
            VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
          |]
          ( (groupId, indexInGroup, memberId, GRRelay, GCHostMember, GSMemAccepted, Binary B.empty, fromInvitedBy userContactId IBUnknown)
              :. (userId, localDisplayName, profileId, currentTs, currentTs, relayLink)
          )
        insertedRowId db
      getGroupMember db cxt user groupId groupMemberId

createRelayConnection :: DB.Connection -> StoreCxt -> User -> Int64 -> ConnId -> ConnStatus -> VersionChat -> SubscriptionMode -> ExceptT StoreError IO Connection
createRelayConnection db cxt user@User {userId} groupMemberId agentConnId connStatus chatV subMode = do
  currentTs <- liftIO getCurrentTime
  liftIO $
    DB.execute
      db
      [sql|
        INSERT INTO connections (
          user_id, agent_conn_id, conn_level, conn_status, conn_type,
          group_member_id, conn_chat_version, to_subscribe, pq_support, pq_encryption,
          created_at, updated_at
        ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
      |]
      ( (userId, agentConnId, 0 :: Int, connStatus, ConnMember)
          :. (groupMemberId, chatV, BI (subMode == SMOnlyCreate), PQSupportOff, PQSupportOff)
          :. (currentTs, currentTs)
      )
  connId <- liftIO $ insertedRowId db
  getConnectionById db cxt user connId

updateRelayStatus :: DB.Connection -> GroupRelay -> RelayStatus -> IO GroupRelay
updateRelayStatus db relay@GroupRelay {groupRelayId} relayStatus =
  updateRelayStatus_ db groupRelayId relayStatus $> relay {relayStatus}

updateRelayStatusFromTo :: DB.Connection -> GroupRelay -> RelayStatus -> RelayStatus -> IO GroupRelay
updateRelayStatusFromTo db relay@GroupRelay {groupRelayId} fromStatus toStatus = do
  maybeFirstRow fromOnly (DB.query db "SELECT relay_status FROM group_relays WHERE group_relay_id = ?" (Only groupRelayId)) >>= \case
    Just status | status == fromStatus -> updateRelayStatus_ db groupRelayId toStatus $> relay {relayStatus = toStatus}
    _ -> pure relay

updateRelayStatus_ :: DB.Connection -> Int64 -> RelayStatus -> IO ()
updateRelayStatus_ db relayId relayStatus = do
  currentTs <- getCurrentTime
  DB.execute db "UPDATE group_relays SET relay_status = ?, updated_at = ? WHERE group_relay_id = ?" (relayStatus, currentTs, relayId)

setRelayLinkAccepted :: DB.Connection -> StoreCxt -> User -> GroupMember -> MemberKey -> Profile -> ExceptT StoreError IO (GroupMember, GroupRelay)
setRelayLinkAccepted db cxt user m (MemberKey relayKey) profile = do
  let gmId = groupMemberId' m
  currentTs <- liftIO getCurrentTime
  liftIO $ DB.execute
    db
    [sql|
      UPDATE group_relays
      SET relay_status = ?, updated_at = ?
      WHERE group_member_id = ?
    |]
    (RSAccepted, currentTs, gmId)
  liftIO $ DB.execute
    db
    [sql|
      UPDATE group_members
      SET member_pub_key = ?, updated_at = ?
      WHERE group_member_id = ?
    |]
    (relayKey, currentTs, gmId)
  void $ updateMemberProfile db cxt user m profile
  (,) <$> getGroupMemberById db cxt user gmId <*> getGroupRelayByGMId db gmId

setRelayLinkConfId :: DB.Connection -> GroupMember -> ConfirmationId -> ShortLinkContact -> IO ()
setRelayLinkConfId db m confId relayLink = do
  currentTs <- getCurrentTime
  DB.execute
    db
    [sql|
      UPDATE group_relays
      SET conf_id = ?, relay_link = ?, updated_at = ?
      WHERE group_member_id = ?
    |]
    (confId, relayLink, currentTs, groupMemberId' m)
  DB.execute
    db
    [sql|
      UPDATE group_members
      SET relay_link = ?, updated_at = ?
      WHERE group_member_id = ?
    |]
    (relayLink, currentTs, groupMemberId' m)

updateRelayCapabilities :: DB.Connection -> GroupMember -> RelayCapabilities -> IO ()
updateRelayCapabilities db m RelayCapabilities {webDomain} = do
  currentTs <- getCurrentTime
  DB.execute
    db
    [sql|
      UPDATE group_relays
      SET base_web_url = ?, updated_at = ?
      WHERE group_member_id = ?
    |]
    (webDomain, currentTs, groupMemberId' m)

getRelayConfId :: DB.Connection -> GroupMember -> ExceptT StoreError IO ConfirmationId
getRelayConfId db m =
  ExceptT . firstRow fromOnly (SEGroupRelayNotFoundByMemberId $ groupMemberId' m) $
    DB.query
      db
      [sql|
        SELECT conf_id
        FROM group_relays
        WHERE group_member_id = ? AND conf_id IS NOT NULL
      |]
      (Only (groupMemberId' m))

updateRelayMemberData :: DB.Connection -> StoreCxt -> User -> GroupMember -> MemberId -> MemberKey -> Profile -> ExceptT StoreError IO ()
updateRelayMemberData db cxt user m memberId (MemberKey relayKey) profile = do
  currentTs <- liftIO getCurrentTime
  liftIO $
    DB.execute
      db
      [sql|
        UPDATE group_members
        SET member_id = ?, member_pub_key = ?, updated_at = ?
        WHERE group_member_id = ?
      |]
      (memberId, relayKey, currentTs, groupMemberId' m)
  void $ updateMemberProfile db cxt user m profile

setGroupInProgressDone :: DB.Connection -> GroupInfo -> IO ()
setGroupInProgressDone db GroupInfo {groupId} = do
  currentTs <- getCurrentTime
  DB.execute
    db
    "UPDATE groups SET creating_in_progress = 0, updated_at = ? WHERE group_id = ?"
    (currentTs, groupId)

createRelayRequestGroup :: DB.Connection -> StoreCxt -> User -> GroupRelayInvitation -> InvitationId -> VersionRangeChat -> Int64 -> GroupMemberStatus -> RelayStatus -> ExceptT StoreError IO (GroupInfo, GroupMember)
createRelayRequestGroup db cxt user@User {userId} GroupRelayInvitation {fromMember, fromMemberProfile, relayMemberId, groupLink} invId reqChatVRange initialDelay memberStatus relayStatus = do
  currentTs <- liftIO getCurrentTime
  -- Create group with placeholder profile
  let Profile {displayName = fromMemberLDN} = fromMemberProfile
      placeholderProfile = GroupProfile
        { displayName = "relay_request_" <> fromMemberLDN,
          fullName = "",
          shortDescr = Nothing,
          description = Nothing,
          image = Nothing,
          publicGroup = Nothing,
          groupPreferences = Nothing,
          memberAdmission = Nothing
        }
  (groupId, _groupLDN) <- createGroup_ db userId placeholderProfile Nothing Nothing True (Just relayStatus) Nothing currentTs
  -- Store relay request data for recovery
  liftIO $ setRelayRequestData_ groupId currentTs
  ownerMemberId <- insertOwner_ currentTs groupId
  let relayMember = MemberIdRole relayMemberId GRRelay
  -- TODO [member keys] should relays use member keys?
  _membership <- createContactMemberInv_ db user groupId (Just ownerMemberId) user relayMember GCUserMember memberStatus IBUnknown Nothing Nothing currentTs (vr cxt)
  ownerMember <- getGroupMember db cxt user groupId ownerMemberId
  g <- getGroupInfo db cxt user groupId
  pure (g, ownerMember)
  where
    setRelayRequestData_ groupId currentTs =
      DB.execute
        db
        [sql|
          UPDATE groups
          SET relay_request_inv_id = ?,
              relay_request_group_link = ?,
              relay_request_peer_chat_min_version = ?,
              relay_request_peer_chat_max_version = ?,
              relay_request_delay = ?,
              relay_request_execute_at = ?
          WHERE group_id = ?
        |]
        (Binary invId, groupLink, minVersion reqChatVRange, maxVersion reqChatVRange, initialDelay, currentTs, groupId)
    insertOwner_ currentTs groupId = do
      let MemberIdRole {memberId, memberRole} = fromMember
          VersionRange minV maxV = reqChatVRange
      (localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user fromMemberProfile currentTs
      indexInGroup <- getUpdateNextIndexInGroup_ db groupId
      liftIO $ do
        DB.execute
          db
          [sql|
            INSERT INTO group_members
              ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector,
                user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
                peer_chat_min_version, peer_chat_max_version)
            VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
          |]
          ( (groupId, indexInGroup, memberId, memberRole, GCHostMember, memberStatus, Binary B.empty)
              :. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, currentTs, currentTs)
              :. (minV, maxV)
          )
        insertedRowId db

updateRelayOwnStatusFromTo :: DB.Connection -> GroupInfo -> RelayStatus -> RelayStatus -> IO GroupInfo
updateRelayOwnStatusFromTo db gInfo@GroupInfo {groupId} fromStatus toStatus = do
  maybeFirstRow fromOnly (DB.query db "SELECT relay_own_status FROM groups WHERE group_id = ?" (Only groupId)) >>= \case
    Just status | status == fromStatus -> updateRelayOwnStatus_ db gInfo toStatus $> gInfo {relayOwnStatus = Just toStatus}
    _ -> pure gInfo

updateRelayOwnStatus_ :: DB.Connection -> GroupInfo -> RelayStatus -> IO ()
updateRelayOwnStatus_ db GroupInfo {groupId} relayStatus = do
  currentTs <- getCurrentTime
  let inactiveAt_ = if relayStatus == RSInactive then Just currentTs else Nothing
  DB.execute db "UPDATE groups SET relay_own_status = ?, relay_inactive_at = ?, updated_at = ? WHERE group_id = ?" (relayStatus, inactiveAt_, currentTs, groupId)

getRelaySentWebDomain :: DB.Connection -> GroupInfo -> IO (Maybe Text)
getRelaySentWebDomain db GroupInfo {groupId} =
  join <$> maybeFirstRow fromOnly (DB.query db "SELECT relay_sent_web_domain FROM groups WHERE group_id = ?" (Only groupId))

updateRelaySentWebDomain :: DB.Connection -> GroupInfo -> Maybe Text -> IO ()
updateRelaySentWebDomain db GroupInfo {groupId} webDomain_ =
  DB.execute db "UPDATE groups SET relay_sent_web_domain = ? WHERE group_id = ?" (webDomain_, groupId)

-- Flip every RSRejected row sharing the targeted group's relay_request_group_link
-- to RSInactive in one statement; returns the refreshed GroupInfo for the targeted groupId.
allowRelayGroup :: DB.Connection -> StoreCxt -> User -> GroupId -> ExceptT StoreError IO GroupInfo
allowRelayGroup db cxt user@User {userId} groupId = do
  currentTs <- liftIO getCurrentTime
  liftIO $
    DB.execute
      db
      [sql|
        UPDATE groups
        SET relay_own_status = ?, relay_inactive_at = ?, updated_at = ?
        WHERE user_id = ?
          AND relay_request_group_link = (SELECT relay_request_group_link FROM groups WHERE group_id = ?)
          AND relay_own_status = ?
      |]
      (RSInactive, currentTs, currentTs, userId, groupId, RSRejected)
  getGroupInfo db cxt user groupId

isRelayGroupRejected :: DB.Connection -> User -> ShortLinkContact -> IO Bool
isRelayGroupRejected db User {userId} groupLink =
  fromMaybe False <$> maybeFirstRow fromOnly (
    DB.query
      db
      [sql|
        SELECT EXISTS (
          SELECT 1 FROM groups
          WHERE user_id = ?
            AND relay_request_group_link = ?
            AND relay_own_status = ?
          LIMIT 1
        )
      |]
      (userId, groupLink, RSRejected)
  )

getRelayServedGroups :: DB.Connection -> StoreCxt -> User -> IO [GroupInfo]
getRelayServedGroups db cxt User {userId, userContactId} = do
  currentTs <- getCurrentTime
  map (toGroupInfo currentTs cxt userContactId [])
    <$> DB.query
      db
      ( groupInfoQuery
          <> " WHERE g.user_id = ? AND mu.contact_id = ? AND g.relay_own_status IN (?, ?, ?)"
      )
      (userId, userContactId, RSAccepted, RSAcknowledgedRoster, RSActive)

getRelayPublishableGroups :: DB.Connection -> User -> IO [(Int64, B64UrlByteString, Maybe PublicGroupAccess)]
getRelayPublishableGroups db User {userId, userContactId} =
  map toRow <$>
    DB.query
      db
      [sql|
        SELECT g.group_id, gp.public_group_id,
               gp.group_web_page, gp.group_domain, gp.domain_web_page, gp.allow_embedding, gp.group_domain_proof
        FROM groups g
        JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
        JOIN group_members mu ON mu.group_id = g.group_id AND mu.contact_id = ?
        WHERE g.user_id = ? AND g.relay_own_status IN (?, ?)
          AND gp.public_group_id IS NOT NULL
      |]
      (userContactId, userId, RSAccepted, RSActive)
  where
    toRow ((gId, pgId) :. accessRow) = (gId, pgId, toPublicGroupAccess accessRow)

getRelayInactiveGroups :: DB.Connection -> StoreCxt -> User -> NominalDiffTime -> IO [GroupInfo]
getRelayInactiveGroups db cxt User {userId, userContactId} ttl = do
  currentTs <- getCurrentTime
  let cutoffTs = addUTCTime (- ttl) currentTs
  map (toGroupInfo currentTs cxt userContactId [])
    <$> DB.query
      db
      ( groupInfoQuery
          <> " WHERE g.user_id = ? AND mu.contact_id = ? AND g.relay_own_status = ? AND g.relay_inactive_at IS NOT NULL AND g.relay_inactive_at <= ?"
      )
      (userId, userContactId, RSInactive, cutoffTs)

createNewContactMemberAsync :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> Contact -> GroupMemberRole -> (CommandId, ConnId) -> VersionChat -> VersionRangeChat -> SubscriptionMode -> ExceptT StoreError IO ()
createNewContactMemberAsync db gVar user@User {userId, userContactId} GroupInfo {groupId, membership} Contact {contactId, localDisplayName, profile} memberRole (cmdId, agentConnId) chatV peerChatVRange subMode =
  createWithRandomId' db gVar $ \memId -> runExceptT $ do
    createdAt <- liftIO getCurrentTime
    insertMember_ (MemberId memId) createdAt
    groupMemberId <- liftIO $ insertedRowId db
    Connection {connId} <- liftIO $ createMemberConnection_ db userId groupMemberId agentConnId chatV peerChatVRange Nothing 0 createdAt subMode
    liftIO $ setCommandConnId db user cmdId connId
  where
    VersionRange minV maxV = peerChatVRange
    insertMember_ memberId createdAt = do
      indexInGroup <- getUpdateNextIndexInGroup_ db groupId
      liftIO $
        DB.execute
          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 (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
          |]
          ( (groupId, indexInGroup, memberId, memberRole, GCInviteeMember, GSMemInvited, Binary B.empty, fromInvitedBy userContactId IBUser, groupMemberId' membership)
              :. (userId, localDisplayName, contactId, localProfileId profile, createdAt, createdAt)
              :. (minV, maxV)
          )

createJoiningMember :: DB.Connection -> StoreCxt -> TVar ChaChaDRG -> User -> GroupInfo -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupMemberRole -> GroupMemberStatus -> Maybe MemberKey -> ExceptT StoreError IO (GroupMemberId, MemberId)
createJoiningMember
  db
  cxt
  gVar
  User {userId, userContactId}
  GroupInfo {groupId, membership}
  cReqChatVRange
  Profile {displayName, fullName, shortDescr, image, contactLink, badge, preferences}
  cReqXContactId_
  cReqMemberId_
  welcomeMsgId_
  memberRole
  memberStatus
  memberKey_ = do
    currentTs <- liftIO getCurrentTime
    badgeVerified <- liftIO $ verifyBadge_ (badgeKeys cxt) badge
    ExceptT . withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do
      liftIO $
        DB.execute
          db
          "INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, user_id, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra, badge_master_key, badge_signature, badge_key_idx) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
          ((displayName, fullName, shortDescr, image, contactLink, userId, preferences, currentTs, currentTs) :. badgeToRow badge badgeVerified)
      profileId <- liftIO $ insertedRowId db
      case cReqMemberId_ of
        Just memberId -> do
          checkMemberNotExists memberId
          insertMember_ ldn profileId memberId currentTs
          groupMemberId <- liftIO $ insertedRowId db
          pure (groupMemberId, memberId)
        Nothing ->
          createWithRandomId' db gVar $ \memId -> runExceptT $ do
            insertMember_ ldn profileId (MemberId memId) currentTs
            groupMemberId <- liftIO $ insertedRowId db
            pure (groupMemberId, MemberId memId)
    where
      VersionRange minV maxV = cReqChatVRange
      -- TODO [relays] relay: TBC communicate rejection
      checkMemberNotExists :: MemberId -> ExceptT StoreError IO ()
      checkMemberNotExists memberId = do
        exists <- liftIO $ fromOnly . head <$> DB.query db "SELECT EXISTS (SELECT 1 FROM group_members WHERE group_id = ? AND member_id = ?)" (groupId, memberId)
        when exists $ throwError SEDuplicateMemberId
      memberPubKey_ = (\(MemberKey k) -> k) <$> memberKey_
      insertMember_ ldn profileId memberId currentTs = do
        indexInGroup <- getUpdateNextIndexInGroup_ db groupId
        liftIO $
          DB.execute
            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_pub_key, member_xcontact_id, member_welcome_shared_msg_id, created_at, updated_at,
                  peer_chat_min_version, peer_chat_max_version)
              VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
            |]
            ( (groupId, indexInGroup, memberId, memberRole, GCInviteeMember, memberStatus, Binary B.empty, fromInvitedBy userContactId IBUser, groupMemberId' membership)
                :. (userId, ldn, Nothing :: (Maybe Int64), profileId, memberPubKey_, cReqXContactId_, welcomeMsgId_, currentTs, currentTs)
                :. (minV, maxV)
            )

getMemberJoinRequest :: DB.Connection -> User -> GroupInfo -> GroupMember -> IO (Maybe (Maybe XContactId, Maybe SharedMsgId))
getMemberJoinRequest db User {userId} GroupInfo {groupId} GroupMember {groupMemberId = mId} =
  maybeFirstRow id $
    DB.query db "SELECT member_xcontact_id, member_welcome_shared_msg_id FROM group_members WHERE user_id = ? AND group_id = ? AND group_member_id = ?" (userId, groupId, mId)

createJoiningMemberConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> VersionChat -> VersionRangeChat -> GroupMemberId -> SubscriptionMode -> IO ()
createJoiningMemberConnection
  db
  user@User {userId}
  uclId
  (cmdId, agentConnId)
  chatV
  cReqChatVRange
  groupMemberId
  subMode = do
    createdAt <- liftIO getCurrentTime
    Connection {connId} <- createConnection_ db userId ConnMember (Just groupMemberId) agentConnId ConnNew chatV cReqChatVRange Nothing (Just uclId) Nothing 0 createdAt subMode PQSupportOff
    setCommandConnId db user cmdId connId

createBusinessRequestGroup :: DB.Connection -> StoreCxt -> TVar ChaChaDRG -> User -> VersionRangeChat -> Profile -> Int64 -> Text -> GroupPreferences -> ExceptT StoreError IO (GroupInfo, GroupMember)
createBusinessRequestGroup
  db
  cxt
  gVar
  user@User {userId, userContactId}
  cReqChatVRange
  Profile {displayName, fullName, shortDescr, image}
  profileId -- contact request profile id, to be used for member profile
  ldn -- contact request local display name, to be used for group local display name
  groupPreferences = do
    currentTs <- liftIO getCurrentTime
    (groupId, membership@GroupMember {memberId = userMemberId}) <- insertGroup_ currentTs
    (groupMemberId, memberId) <- insertClientMember_ currentTs groupId membership
    liftIO $ DB.execute db "UPDATE groups SET business_member_id = ?, customer_member_id = ? WHERE group_id = ?" (userMemberId, memberId, groupId)
    groupInfo <- getGroupInfo db cxt user groupId
    clientMember <- getGroupMemberById db cxt user groupMemberId
    pure (groupInfo, clientMember)
    where
      insertGroup_ currentTs = do
        liftIO $
          DB.execute
            db
            "INSERT INTO group_profiles (display_name, full_name, short_descr, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
            (displayName, fullName, shortDescr, image, userId, groupPreferences, currentTs, currentTs)
        groupProfileId <- liftIO $ insertedRowId db
        liftIO $
          DB.execute
            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 (?,?,?,?,?,?,?,?,?)
            |]
            (groupProfileId, ldn, userId, BI True, currentTs, currentTs, currentTs, currentTs, BCCustomer)
        groupId <- liftIO $ insertedRowId db
        memberId <- liftIO $ encodedRandomBytes gVar 12
        -- TODO [member keys] we could support member keys in business groups to allow binding agreements (though identity keys would be better for it.
        membership <- createContactMemberInv_ db user groupId Nothing user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser Nothing Nothing currentTs (vr cxt)
        pure (groupId, membership)
      VersionRange minV maxV = cReqChatVRange
      insertClientMember_ currentTs groupId membership =
        ExceptT . withLocalDisplayName db userId displayName $ \localDisplayName -> runExceptT $ do
          createWithRandomId' db gVar $ \memId -> runExceptT $ do
            indexInGroup <- getUpdateNextIndexInGroup_ db groupId
            liftIO $
              DB.execute
                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 (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
                |]
                ( (groupId, indexInGroup, MemberId memId, GRMember, GCInviteeMember, GSMemAccepted, Binary B.empty, fromInvitedBy userContactId IBUser, groupMemberId' membership)
                    :. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, currentTs, currentTs)
                    :. (minV, maxV)
                )
            groupMemberId <- liftIO $ insertedRowId db
            pure (groupMemberId, MemberId memId)

getContactViaMember :: DB.Connection -> StoreCxt -> User -> GroupMember -> ExceptT StoreError IO Contact
getContactViaMember db cxt user@User {userId} GroupMember {groupMemberId} = do
  contactId <-
    ExceptT $
      firstRow fromOnly (SEContactNotFoundByMemberId groupMemberId) $
        DB.query
          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, groupMemberId)
  getContact db cxt user contactId

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

getMemberInvitation :: DB.Connection -> User -> Int64 -> IO (Maybe ConnReqInvitation)
getMemberInvitation db User {userId} groupMemberId =
  fmap join . maybeFirstRow fromOnly $
    DB.query db "SELECT sent_inv_queue_info FROM group_members WHERE group_member_id = ? AND user_id = ?" (groupMemberId, userId)

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

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

-- Set group link info, incognito profile, membership keys before connecting to relays.
-- This is called once before connecting to relays, unlike createConnReqConnection -> setPreparedGroupLinkInfo_,
-- which is used in single-connection flows.
updatePreparedRelayedGroup ::
  DB.Connection -> StoreCxt -> User -> GroupInfo -> ConnReqContact -> ConnReqUriHash -> Maybe Profile ->
  C.PublicKeyEd25519 -> C.PrivateKeyEd25519 -> Maybe Int64 ->
  ExceptT StoreError IO GroupInfo
updatePreparedRelayedGroup db cxt user@User {userId} gInfo cReq cReqHash incognitoProfile rootPubKey memberPrivKey publicMemberCount_ = do
  currentTs <- liftIO getCurrentTime
  customUserProfileId <- liftIO $ mapM (createIncognitoProfile_ db userId currentTs) incognitoProfile
  liftIO $ setPreparedGroupLinkInfo_ db gInfo cReq cReqHash customUserProfileId publicMemberCount_ currentTs
  liftIO $ updateGroupMemberKeys db (groupId' gInfo) rootPubKey memberPrivKey (groupMemberId' $ membership gInfo)
  getGroupInfo db cxt user (groupId' gInfo)

updatePublicMemberCount :: DB.Connection -> StoreCxt -> User -> GroupInfo -> ExceptT StoreError IO GroupInfo
updatePublicMemberCount db cxt user GroupInfo {groupId} = do
  liftIO $ do
    totalCount <- fromMaybe 0 <$> maybeFirstRow fromOnly
      (DB.query db "SELECT summary_current_members_count FROM groups WHERE group_id = ?" (Only groupId))
    relayCount <- fromMaybe 0 <$> maybeFirstRow fromOnly
      (DB.query
        db
#if defined(dbPostgres)
        "SELECT COUNT(1) FROM group_members WHERE group_id = ? AND member_role = ? AND is_current_member(member_status)"
#else
        "SELECT COUNT(1) FROM group_members m JOIN group_member_status_predicates sp ON m.member_status = sp.member_status WHERE m.group_id = ? AND m.member_role = ? AND sp.current_member = 1"
#endif
        (groupId, GRRelay))
    let publicCount = max 0 (totalCount - relayCount) :: Int64
    currentTs <- getCurrentTime
    DB.execute db "UPDATE groups SET public_member_count = ?, updated_at = ? WHERE group_id = ?" (publicCount, currentTs, groupId)
  getGroupInfo db cxt user groupId

setPublicMemberCount :: DB.Connection -> StoreCxt -> User -> GroupInfo -> Int64 -> ExceptT StoreError IO GroupInfo
setPublicMemberCount db cxt user GroupInfo {groupId} publicCount = do
  currentTs <- liftIO getCurrentTime
  liftIO $ DB.execute db "UPDATE groups SET public_member_count = ?, updated_at = ? WHERE group_id = ?" (publicCount, currentTs, groupId)
  getGroupInfo db cxt user groupId

updateGroupMemberKeys :: DB.Connection -> GroupId -> C.PublicKeyEd25519 -> C.PrivateKeyEd25519 -> GroupMemberId -> IO ()
updateGroupMemberKeys db groupId rootPubKey memberPrivKey membershipGMId = do
  currentTs <- getCurrentTime
  DB.execute
    db
    "UPDATE groups SET root_pub_key = ?, member_priv_key = ?, updated_at = ? WHERE group_id = ?"
    (rootPubKey, memberPrivKey, currentTs, groupId)
  DB.execute
    db
    "UPDATE group_members SET member_pub_key = ?, updated_at = ? WHERE group_member_id = ?"
    (C.publicKey memberPrivKey, currentTs, membershipGMId)

updateRelayGroupKeys :: DB.Connection -> User -> GroupInfo -> PublicGroupProfile -> C.PublicKeyEd25519 -> C.PrivateKeyEd25519 -> [OwnerAuth] -> ExceptT StoreError IO ()
updateRelayGroupKeys db user@User {userId} gInfo PublicGroupProfile {groupType, groupLink, publicGroupId} rootPubKey memberPrivKey owners = do
  currentTs <- liftIO getCurrentTime
  let membershipGMId = groupMemberId' $ membership gInfo
      groupId = groupId' gInfo
  liftIO $ do
    DB.execute
      db
      [sql|
        UPDATE group_profiles SET group_type = ?, group_link = ?, public_group_id = ?, updated_at = ?
        WHERE group_profile_id IN (SELECT group_profile_id FROM groups WHERE user_id = ? AND group_id = ?)
      |]
      (groupType, groupLink, publicGroupId, currentTs, userId, groupId)
    DB.execute
      db
      "UPDATE groups SET root_pub_key = ?, member_priv_key = ?, updated_at = ? WHERE group_id = ?"
      (rootPubKey, memberPrivKey, currentTs, groupId)
    DB.execute
      db
      "UPDATE group_members SET member_pub_key = ?, updated_at = ? WHERE group_member_id = ?"
      (C.publicKey memberPrivKey, currentTs, membershipGMId)
  -- TODO [relays] relay: if not found, create owner record (multi-owner)
  forM_ owners $ \OwnerAuth {ownerId, ownerKey} -> do
    ownerGMId <- getGroupMemberIdViaMemberId db user gInfo (MemberId ownerId)
    liftIO $
      DB.execute
        db
        "UPDATE group_members SET member_pub_key = ?, updated_at = ? WHERE group_member_id = ?"
        (ownerKey, currentTs, ownerGMId)

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

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

updateGroupMemberRemovedAt :: DB.Connection -> User -> GroupMember -> IO ()
updateGroupMemberRemovedAt db User {userId} GroupMember {groupMemberId} = do
  currentTs <- getCurrentTime
  DB.execute
    db
    [sql|
      UPDATE group_members
      SET member_status = ?, removed_at = ?, updated_at = ?
      WHERE user_id = ? AND group_member_id = ?
    |]
    (GSMemRemoved, currentTs, currentTs, userId, groupMemberId)

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

deleteGroupMemberSupportChat :: DB.Connection -> GroupMember -> IO GroupMember
deleteGroupMemberSupportChat db m@GroupMember {groupMemberId} = do
  currentTs <- getCurrentTime
  DB.execute
    db
    [sql|
      DELETE FROM chat_items
      WHERE group_scope_group_member_id = ?
    |]
    (Only groupMemberId)
  DB.execute
    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 = ?
    |]
    (currentTs, groupMemberId)
  pure m {supportChat = Nothing, updatedAt = currentTs}

updateGroupMembersRequireAttention :: DB.Connection -> User -> GroupInfo -> GroupMember -> GroupMember -> IO GroupInfo
updateGroupMembersRequireAttention db user g member member'
  | nowRequires && not didRequire =
      increaseGroupMembersRequireAttention db user g
  | not nowRequires && didRequire =
      decreaseGroupMembersRequireAttention db user g
  | otherwise = pure g
  where
    didRequire = gmRequiresAttention member
    nowRequires = gmRequiresAttention member'

decreaseGroupMembersRequireAttention :: DB.Connection -> User -> GroupInfo -> IO GroupInfo
decreaseGroupMembersRequireAttention db User {userId} g@GroupInfo {groupId, membersRequireAttention} = do
  DB.execute
    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, groupId)
  pure g {membersRequireAttention = max 0 (membersRequireAttention - 1)}

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

-- | add new member with profile
createNewGroupMember :: DB.Connection -> StoreCxt -> User -> GroupInfo -> GroupMember -> MemberInfo -> GroupMemberCategory -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
createNewGroupMember db cxt user gInfo invitingMember memInfo@MemberInfo {profile} memCategory memStatus = do
  currentTs <- liftIO getCurrentTime
  (localDisplayName, memProfileId, badgeVerified) <- createNewMemberProfile_ db cxt user profile currentTs
  let newMember =
        NewGroupMember
          { memInfo,
            memCategory,
            memStatus,
            memRestriction = Nothing,
            memInvitedBy = IBUnknown,
            memInvitedByGroupMemberId = Just $ groupMemberId' invitingMember,
            localDisplayName,
            memContactId = Nothing,
            memProfileId
          }
  createNewMember_ db user gInfo newMember badgeVerified currentTs

createNewMemberProfile_ :: DB.Connection -> StoreCxt -> User -> Profile -> UTCTime -> ExceptT StoreError IO (Text, ProfileId, Maybe Bool)
createNewMemberProfile_ db cxt User {userId} Profile {displayName, fullName, shortDescr, image, contactLink, badge, preferences} createdAt =
  ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
    badgeVerified <- verifyBadge_ (badgeKeys cxt) badge
    DB.execute
      db
      "INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, user_id, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra, badge_master_key, badge_signature, badge_key_idx) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
      ((displayName, fullName, shortDescr, image, contactLink, userId, preferences, createdAt, createdAt) :. badgeToRow badge badgeVerified)
    profileId <- insertedRowId db
    pure $ Right (ldn, profileId, badgeVerified)

createNewMember_ :: DB.Connection -> User -> GroupInfo -> NewGroupMember -> Maybe Bool -> UTCTime -> ExceptT StoreError IO GroupMember
createNewMember_
  db
  User {userId, userContactId}
  GroupInfo {groupId}
  NewGroupMember
    { memInfo = MemberInfo memberId memberRole memChatVRange memberProfile memKey,
      memCategory = memberCategory,
      memStatus = memberStatus,
      memRestriction,
      memInvitedBy = invitedBy,
      memInvitedByGroupMemberId,
      localDisplayName,
      memContactId = memberContactId,
      memProfileId = memberContactProfileId
    }
  badgeVerified
  createdAt = do
    let invitedById = fromInvitedBy userContactId invitedBy
        activeConn = Nothing
        memberChatVRange@(VersionRange minV maxV) = maybe chatInitialVRange fromChatVRange memChatVRange
        memberPubKey = (\(MemberKey k) -> k) <$> memKey
    indexInGroup <- getUpdateNextIndexInGroup_ db groupId
    liftIO $
      DB.execute
        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, member_pub_key, created_at, updated_at,
            peer_chat_min_version, peer_chat_max_version)
            VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
        |]
        ( (groupId, indexInGroup, memberId, memberRole, memberCategory, memberStatus, Binary B.empty)
            :. (memRestriction, invitedById, memInvitedByGroupMemberId)
            :. (userId, localDisplayName, memberContactId, memberContactProfileId, memberPubKey, createdAt, createdAt)
            :. (minV, maxV)
        )
    groupMemberId <- liftIO $ insertedRowId db
    pure
      GroupMember
        { groupMemberId,
          groupId,
          indexInGroup,
          memberId,
          memberRole,
          memberCategory,
          memberStatus,
          memberSettings = defaultMemberSettings,
          blockedByAdmin = maybe False mrsBlocked memRestriction,
          invitedBy,
          invitedByGroupMemberId = memInvitedByGroupMemberId,
          localDisplayName,
          memberProfile = toLocalProfile memberContactProfileId memberProfile "" createdAt badgeVerified Nothing,
          memberContactId,
          memberContactProfileId,
          activeConn,
          memberChatVRange,
          createdAt,
          updatedAt = createdAt,
          supportChat = Nothing,
          memberPubKey,
          relayLink = Nothing
        }

checkGroupMemberHasItems :: DB.Connection -> User -> GroupMember -> IO (Maybe ChatItemId)
checkGroupMemberHasItems db User {userId} GroupMember {groupMemberId, groupId} =
  maybeFirstRow fromOnly $ DB.query db "SELECT chat_item_id FROM chat_items WHERE user_id = ? AND group_id = ? AND group_member_id = ? LIMIT 1" (userId, groupId, groupMemberId)

deleteGroupMember :: DB.Connection -> User -> GroupMember -> IO ()
deleteGroupMember db user@User {userId} m@GroupMember {groupMemberId, groupId, memberProfile} = do
  deleteGroupMemberConnection db user m
  DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND group_id = ? AND group_member_id = ?" (userId, groupId, groupMemberId)
  DB.execute db "DELETE FROM group_members WHERE user_id = ? AND group_member_id = ?" (userId, groupMemberId)
  cleanupMemberProfileAndName_ db user m
  when (memberIncognito m) $ deleteUnusedIncognitoProfileById_ db user $ localProfileId memberProfile

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

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

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

setMemberVectorNewRelations :: DB.Connection -> GroupMember -> [(Int64, (IntroductionDirection, MemberRelation))] -> IO ()
setMemberVectorNewRelations db GroupMember {groupMemberId} relations = do
  v_ <- fmap join . maybeFirstRow fromOnly $
    DB.query
      db
      ( "SELECT member_relations_vector FROM group_members WHERE group_member_id = ?"
#if defined(dbPostgres)
          <> " FOR UPDATE"
#endif
      )
      (Only groupMemberId)
  let v' = setNewRelations relations $ fromMaybe B.empty v_
  currentTs <- getCurrentTime
  DB.execute
    db
    [sql|
      UPDATE group_members
      SET member_relations_vector = ?, updated_at = ?
      WHERE group_member_id = ?
    |]
    (Binary v', currentTs, groupMemberId)

setMembersVectorsNewRelation :: DB.Connection -> [GroupMember] -> Int64 -> IntroductionDirection -> MemberRelation -> IO ()
setMembersVectorsNewRelation db members idx dir status = do
  currentTs <- 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
  forM_ members $ \GroupMember {groupMemberId} ->
    DB.execute
      db
      "UPDATE group_members SET member_relations_vector = set_member_vector_new_relation(member_relations_vector, ?, ?, ?), updated_at = ? WHERE group_member_id = ?"
      (idx, toIntroDirInt dir, toRelationInt status, currentTs, groupMemberId)
#endif

setMemberVectorRelationConnected :: DB.Connection -> GroupMember -> GroupMember -> MemberRelation -> ExceptT StoreError IO ()
setMemberVectorRelationConnected db GroupMember {groupMemberId} GroupMember {indexInGroup} newStatus = do
  when (newStatus /= MRSubjectConnected && newStatus /= MRReferencedConnected) $
    throwError SEInvalidMemberRelationUpdate
  v <- ExceptT $
    firstRow fromOnly (SEMemberRelationsVectorNotFound groupMemberId) $
      DB.query
        db
        ( "SELECT member_relations_vector FROM group_members WHERE group_member_id = ? AND member_relations_vector IS NOT NULL"
#if defined(dbPostgres)
          <> " FOR UPDATE"
#endif
        )
        (Only groupMemberId)
  let v' = setRelationConnected indexInGroup newStatus v
  currentTs <- liftIO getCurrentTime
  liftIO $ DB.execute
    db
    [sql|
      UPDATE group_members
      SET member_relations_vector = ?, updated_at = ?
      WHERE group_member_id = ?
    |]
    (Binary v', currentTs, groupMemberId)

getMemberRelationsVector :: DB.Connection -> GroupMember -> ExceptT StoreError IO ByteString
getMemberRelationsVector db GroupMember {groupMemberId} =
  ExceptT . firstRow (fromMaybe B.empty . fromOnly) (SEGroupMemberNotFound groupMemberId) $
    DB.query
      db
      "SELECT member_relations_vector FROM group_members WHERE group_member_id = ?"
      (Only groupMemberId)

createIntroReMember :: DB.Connection -> StoreCxt -> User -> GroupInfo -> MemberInfo -> Maybe MemberRestrictions -> ExceptT StoreError IO GroupMember
createIntroReMember
  db
  cxt
  user
  gInfo
  memInfo@(MemberInfo _ _ _ memberProfile _)
  memRestrictions_ = do
    currentTs <- liftIO getCurrentTime
    (localDisplayName, memProfileId, badgeVerified) <- createNewMemberProfile_ db cxt user memberProfile currentTs
    let memRestriction = restriction <$> memRestrictions_
        newMember = NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memRestriction, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Nothing, memProfileId}
    createNewMember_ db user gInfo newMember badgeVerified currentTs

createIntroReMemberConn :: DB.Connection -> User -> GroupMember -> GroupMember -> VersionChat -> MemberInfo -> (CommandId, ConnId) -> SubscriptionMode -> ExceptT StoreError IO GroupMember
createIntroReMemberConn
  db
  user@User {userId}
  _host@GroupMember {memberContactId, activeConn}
  reMember@GroupMember {groupMemberId}
  chatV
  (MemberInfo _ _ memChatVRange _ _)
  (groupCmdId, groupAgentConnId)
  subMode = do
    let mcvr = maybe chatInitialVRange fromChatVRange memChatVRange
        cLevel = 1 + maybe 0 (\Connection {connLevel} -> connLevel) activeConn
    currentTs <- liftIO getCurrentTime
    conn@Connection {connId = groupConnId} <- liftIO $ createMemberConnection_ db userId groupMemberId groupAgentConnId chatV mcvr memberContactId cLevel currentTs subMode
    liftIO $ setCommandConnId db user groupCmdId groupConnId
    pure (reMember :: GroupMember) {activeConn = Just conn}

createIntroToMemberContact :: DB.Connection -> User -> GroupMember -> GroupMember -> VersionChat -> VersionRangeChat -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> IO ()
createIntroToMemberContact db user@User {userId} GroupMember {memberContactId = viaContactId, activeConn} _to@GroupMember {groupMemberId, localDisplayName} chatV mcvr (groupCmdId, groupAgentConnId) directConnIds customUserProfileId subMode = do
  let cLevel = 1 + maybe 0 (\Connection {connLevel} -> connLevel) activeConn
  currentTs <- getCurrentTime
  Connection {connId = groupConnId} <- createMemberConnection_ db userId groupMemberId groupAgentConnId chatV mcvr viaContactId cLevel currentTs subMode
  setCommandConnId db user groupCmdId groupConnId
  forM_ directConnIds $ \(directCmdId, directAgentConnId) -> do
    Connection {connId = directConnId} <- createConnection_ db userId ConnContact Nothing directAgentConnId ConnNew chatV mcvr viaContactId Nothing customUserProfileId cLevel currentTs subMode PQSupportOff
    setCommandConnId db user directCmdId directConnId
    contactId <- createMemberContact_ directConnId currentTs
    updateMember_ contactId currentTs
  where
    createMemberContact_ :: Int64 -> UTCTime -> IO Int64
    createMemberContact_ connId ts = do
      DB.execute
        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 = ?
        |]
        (localDisplayName, userId, ts, ts, ts, groupMemberId)
      contactId <- insertedRowId db
      DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, ts, connId)
      pure contactId
    updateMember_ :: Int64 -> UTCTime -> IO ()
    updateMember_ contactId ts =
      DB.execute
        db
        [sql|
          UPDATE group_members
          SET contact_id = ?, updated_at = ?
          WHERE group_member_id = ?
        |]
        (contactId, ts, groupMemberId)

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

updateGroupProfile :: DB.Connection -> User -> GroupInfo -> GroupProfile -> ExceptT StoreError IO GroupInfo
updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName, publicGroup = oldPublicGroup}} p'@GroupProfile {displayName = newName, fullName, shortDescr, description, image, publicGroup, groupPreferences, memberAdmission}
  | displayName == newName = liftIO $ do
      currentTs <- getCurrentTime
      updateGroupProfile_ currentTs
      clearVerificationIfClaimChanged
      pure $ (g' :: GroupInfo) {groupProfile = p', fullGroupPreferences}
  | otherwise =
      ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
        currentTs <- getCurrentTime
        updateGroupProfile_ currentTs
        updateGroup_ ldn currentTs
        clearVerificationIfClaimChanged
        pure $ Right $ (g' :: GroupInfo) {localDisplayName = ldn, groupProfile = p', fullGroupPreferences}
  where
    fullGroupPreferences = mergeGroupPreferences groupPreferences
    groupClaim pg = domain <$> (pg >>= publicGroupAccess >>= groupDomainClaim)
    claimChanged = groupClaim oldPublicGroup /= groupClaim publicGroup
    g' = if claimChanged then (g :: GroupInfo) {groupDomainVerified = Nothing} else g
    clearVerificationIfClaimChanged =
      when claimChanged $
        DB.execute db "UPDATE groups SET group_domain_verified = NULL WHERE user_id = ? AND group_id = ?" (userId, groupId)
    (groupType_, groupLink_) = case publicGroup of
      Just PublicGroupProfile {groupType, groupLink} -> (Just groupType, Just groupLink)
      Nothing -> (Nothing, Nothing)
    updateGroupProfile_ currentTs =
      DB.execute
        db
        [sql|
          UPDATE group_profiles
          SET display_name = ?, full_name = ?, short_descr = ?, description = ?, image = ?,
              group_type = ?, group_link = ?,
              group_web_page = ?, group_domain = ?, domain_web_page = ?, allow_embedding = ?, group_domain_proof = ?,
              preferences = ?, member_admission = ?, updated_at = ?
          WHERE group_profile_id IN (
            SELECT group_profile_id
            FROM groups
            WHERE user_id = ? AND group_id = ?
          )
        |]
        ((newName, fullName, shortDescr, description, image, groupType_, groupLink_) :. publicGroupAccessRow publicGroup :. (groupPreferences, memberAdmission, currentTs, userId, groupId))
    updateGroup_ ldn currentTs = do
      DB.execute
        db
        "UPDATE groups SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND group_id = ?"
        (ldn, currentTs, userId, groupId)
      safeDeleteLDN db user localDisplayName

setGroupDomainVerified :: DB.Connection -> User -> GroupInfo -> Bool -> IO GroupInfo
setGroupDomainVerified db User {userId} g@GroupInfo {groupId} verified = do
  DB.execute
    db
    "UPDATE groups SET group_domain_verified = ? WHERE user_id = ? AND group_id = ?"
    (BI verified, userId, groupId)
  pure g {groupDomainVerified = Just verified}

updateGroupPreferences :: DB.Connection -> User -> GroupInfo -> GroupPreferences -> IO GroupInfo
updateGroupPreferences db User {userId} g@GroupInfo {groupId, groupProfile = p} ps = do
  currentTs <- getCurrentTime
  DB.execute
    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 = ?
      )
    |]
    (ps, currentTs, userId, groupId)
  pure (g :: GroupInfo) {groupProfile = p {groupPreferences = Just ps}, fullGroupPreferences = mergeGroupPreferences $ Just ps}

updateGroupProfileFromMember :: DB.Connection -> User -> GroupInfo -> Profile -> ExceptT StoreError IO GroupInfo
updateGroupProfileFromMember db user g@GroupInfo {groupId} Profile {displayName = n, fullName = fn, shortDescr = sd, image = img} = do
  p <- getGroupProfile -- to avoid any race conditions with UI
  let g' = g {groupProfile = p} :: GroupInfo
      p' = p {displayName = n, fullName = fn, shortDescr = sd, image = img} :: GroupProfile
  updateGroupProfile db user g' p'
  where
    getGroupProfile =
      ExceptT $
        firstRow toGroupProfile (SEGroupNotFound groupId) $
          DB.query
            db
            [sql|
            SELECT gp.display_name, gp.full_name, gp.short_descr, gp.description, gp.image,
                   gp.group_type, gp.group_link, gp.public_group_id,
                   gp.group_web_page, gp.group_domain, gp.domain_web_page, gp.allow_embedding, gp.group_domain_proof,
                   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 = ?
          |]
            (Only groupId)
    toGroupProfile ((displayName, fullName, shortDescr, description, image, groupType_, groupLink_, publicGroupId_) :. accessRow :. (groupPreferences, memberAdmission)) =
      let publicGroupAccess = toPublicGroupAccess accessRow
       in GroupProfile {displayName, fullName, shortDescr, description, image, publicGroup = toPublicGroupProfile groupType_ groupLink_ publicGroupId_ publicGroupAccess, groupPreferences, memberAdmission}

getGroupInfoByUserContactLinkConnReq :: DB.Connection -> StoreCxt -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe GroupInfo)
getGroupInfoByUserContactLinkConnReq db cxt user@User {userId} (cReqSchema1, 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).
  groupId_ <-
    fmap join . maybeFirstRow fromOnly $
      DB.query
        db
        [sql|
          SELECT group_id
          FROM user_contact_links
          WHERE user_id = ? AND conn_req_contact IN (?,?)
        |]
        (userId, cReqSchema1, cReqSchema2)
  maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupInfo db cxt user) groupId_

getGroupInfoViaUserTarget :: DB.Connection -> StoreCxt -> User -> ContactNameOrLink -> IO (Maybe (CreatedLinkContact, GroupInfo))
getGroupInfoViaUserTarget db cxt user@User {userId} target = fmap eitherToMaybe $ runExceptT $ do
  (cReq, sLnk, groupId) <- ExceptT getConnReqGroup
  (CCLink cReq (Just sLnk),) <$> getGroupInfo db cxt user groupId
  where
    getConnReqGroup =
      firstRow' toConnReqGroupId (SEInternalError "group link not found") $ case target of
        CTLink shortLink ->
          DB.query
            db
            [sql|
              SELECT conn_req_contact, short_link_contact, group_id
              FROM user_contact_links
              WHERE user_id = ? AND short_link_contact = ?
            |]
            (userId, shortLink)
        CTName ni ->
          DB.query
            db
            [sql|
              SELECT ucl.conn_req_contact, ucl.short_link_contact, ucl.group_id
              FROM user_contact_links ucl
              JOIN groups g ON g.group_id = ucl.group_id
              JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
              WHERE ucl.user_id = ? AND gp.group_domain = ?
            |]
            (userId, nameDomain ni)
    toConnReqGroupId = \case
      -- cReq is "not null", group_id is nullable
      (cReq, Just (sLnk :: ShortLinkContact), Just groupId) -> Right (cReq, sLnk, groupId)
      _ -> Left $ SEInternalError "no conn req or group ID"

getGroupViaShortLinkToConnect :: DB.Connection -> StoreCxt -> User -> ShortLinkContact -> ExceptT StoreError IO (Maybe (ConnReqContact, GroupInfo))
getGroupViaShortLinkToConnect db cxt user@User {userId} shortLink =
  liftIO (maybeFirstRow id $ DB.query db "SELECT group_id, conn_full_link_to_connect FROM groups WHERE user_id = ? AND conn_short_link_to_connect = ?" (userId, shortLink)) >>= \case
    Just (gId :: Int64, Just cReq) -> Just . (cReq,) <$> getGroupInfo db cxt user gId
    _ -> pure Nothing

getGroupInfoByGroupLinkHash :: DB.Connection -> StoreCxt -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe GroupInfo)
getGroupInfoByGroupLinkHash db cxt user@User {userId, userContactId} (groupLinkHash1, groupLinkHash2) = do
  groupId_ <-
    maybeFirstRow fromOnly $
      DB.query
        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, groupLinkHash1, groupLinkHash2, userContactId, GSMemRemoved, GSMemLeft, GSMemGroupDeleted, GSMemUnknown)
  maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupInfo db cxt user) groupId_

getGroupIdByName :: DB.Connection -> User -> GroupName -> ExceptT StoreError IO GroupId
getGroupIdByName db User {userId} gName =
  ExceptT . firstRow fromOnly (SEGroupNotFoundByName gName) $
    DB.query db "SELECT group_id FROM groups WHERE user_id = ? AND local_display_name = ?" (userId, gName)

getGroupMemberIdByName :: DB.Connection -> User -> GroupId -> ContactName -> ExceptT StoreError IO GroupMemberId
getGroupMemberIdByName db User {userId} groupId groupMemberName =
  ExceptT . firstRow fromOnly (SEGroupMemberNameNotFound groupId groupMemberName) $
    DB.query db "SELECT group_member_id FROM group_members WHERE user_id = ? AND group_id = ? AND local_display_name = ?" (userId, groupId, groupMemberName)

getActiveMembersByName :: DB.Connection -> StoreCxt -> User -> ContactName -> ExceptT StoreError IO [(GroupInfo, GroupMember)]
getActiveMembersByName db cxt user@User {userId} groupMemberName = do
  groupMemberIds :: [(GroupId, GroupMemberId)] <-
    liftIO $
      DB.query
        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, groupMemberName, GSMemConnected, GSMemComplete, GCUserMember)
  possibleMembers <- forM groupMemberIds $ \(groupId, groupMemberId) -> do
    groupInfo <- getGroupInfo db cxt user groupId
    groupMember <- getGroupMember db cxt user groupId groupMemberId
    pure (groupInfo, groupMember)
  pure $ sortOn (Down . ts . fst) possibleMembers
  where
    ts GroupInfo {chatTs, updatedAt} = fromMaybe updatedAt chatTs

getMatchingContacts :: DB.Connection -> StoreCxt -> User -> Contact -> IO [Contact]
getMatchingContacts db cxt user@User {userId} Contact {contactId, profile = LocalProfile {displayName, fullName, shortDescr, image}} = do
  contactIds <- map fromOnly <$> DB.query db q (userId, contactId, CSActive, displayName, fullName, shortDescr, image)
  rights <$> mapM (runExceptT . getContact db cxt user) contactIds
  where
    -- this query is different from one in getMatchingMemberContacts
    -- it checks that it's not the same contact
    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 -> StoreCxt -> User -> Contact -> IO [GroupMember]
getMatchingMembers db cxt user@User {userId} Contact {profile = LocalProfile {displayName, fullName, shortDescr, image}} = do
  memberIds <- map fromOnly <$> DB.query db q (userId, GCUserMember, displayName, fullName, shortDescr, image)
  filter memberCurrent . rights <$> mapM (runExceptT . getGroupMemberById db cxt user) memberIds
  where
    -- only match with members without associated contact
    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 -> StoreCxt -> User -> GroupMember -> IO [Contact]
getMatchingMemberContacts _ _ _ GroupMember {memberContactId = Just _} = pure []
getMatchingMemberContacts db cxt user@User {userId} GroupMember {memberProfile = LocalProfile {displayName, fullName, shortDescr, image}} = do
  contactIds <- map fromOnly <$> DB.query db q (userId, CSActive, displayName, fullName, shortDescr, image)
  rights <$> mapM (runExceptT . getContact db cxt user) contactIds
  where
    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 db gVar userId to =
  createWithRandomBytes db 32 gVar $ \probe -> do
    currentTs <- getCurrentTime
    let (ctId, gmId) = contactOrMemberIds to
    DB.execute
      db
      "INSERT INTO sent_probes (contact_id, group_member_id, probe, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
      (ctId, gmId, Binary probe, userId, currentTs, currentTs)
    (Probe probe,) <$> insertedRowId db

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

matchReceivedProbe :: DB.Connection -> StoreCxt -> User -> ContactOrMember -> Probe -> IO [ContactOrMember]
matchReceivedProbe db cxt user@User {userId} from (Probe probe) = do
  let probeHash = C.sha256Hash probe
  cgmIds <-
    DB.query
      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, Binary probeHash)
  currentTs <- getCurrentTime
  let (ctId, gmId) = contactOrMemberIds from
  DB.execute
    db
    "INSERT INTO received_probes (contact_id, group_member_id, probe, probe_hash, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
    (ctId, gmId, Binary probe, Binary probeHash, userId, currentTs, currentTs)
  let cgmIds' = filterFirstContactId cgmIds
  catMaybes <$> mapM (getContactOrMember_ db cxt user) cgmIds'
  where
    filterFirstContactId :: [(Maybe ContactId, Maybe GroupId, Maybe GroupMemberId)] -> [(Maybe ContactId, Maybe GroupId, Maybe GroupMemberId)]
    filterFirstContactId cgmIds = do
      let (ctIds, memIds) = partition (\(ctId, _, _) -> isJust ctId) cgmIds
          ctIds' = case ctIds of
            [] -> []
            (x : _) -> [x]
      ctIds' <> memIds

matchReceivedProbeHash :: DB.Connection -> StoreCxt -> User -> ContactOrMember -> ProbeHash -> IO (Maybe (ContactOrMember, Probe))
matchReceivedProbeHash db cxt user@User {userId} from (ProbeHash probeHash) = do
  probeIds <-
    maybeFirstRow id $
      DB.query
        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, Binary probeHash)
  currentTs <- getCurrentTime
  let (ctId, gmId) = contactOrMemberIds from
  DB.execute
    db
    "INSERT INTO received_probes (contact_id, group_member_id, probe_hash, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
    (ctId, gmId, Binary probeHash, userId, currentTs, currentTs)
  pure probeIds $>>= \(Only probe :. cgmIds) -> (,Probe probe) <$$> getContactOrMember_ db cxt user cgmIds

matchSentProbe :: DB.Connection -> StoreCxt -> User -> ContactOrMember -> Probe -> IO (Maybe ContactOrMember)
matchSentProbe db cxt user@User {userId} _from (Probe probe) = do
  cgmIds $>>= getContactOrMember_ db cxt user
  where
    (ctId, gmId) = contactOrMemberIds _from
    cgmIds =
      maybeFirstRow id $
        DB.query
          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, Binary probe, ctId, gmId)

getContactOrMember_ :: DB.Connection -> StoreCxt -> User -> (Maybe ContactId, Maybe GroupId, Maybe GroupMemberId) -> IO (Maybe ContactOrMember)
getContactOrMember_ db cxt user ids =
  fmap eitherToMaybe . runExceptT $ case ids of
    (Just ctId, _, _) -> COMContact <$> getContact db cxt user ctId
    (_, Just gId, Just gmId) -> COMGroupMember <$> getGroupMember db cxt user gId gmId
    _ -> throwError $ SEInternalError ""

associateMemberWithContactRecord :: DB.Connection -> User -> Contact -> GroupMember -> IO ()
associateMemberWithContactRecord
  db
  User {userId}
  Contact {contactId, localDisplayName, profile = LocalProfile {profileId}}
  GroupMember {groupId, groupMemberId, localDisplayName = memLDN, memberProfile = LocalProfile {profileId = memProfileId}} = do
    currentTs <- getCurrentTime
    DB.execute
      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 = ?
      |]
      (contactId, localDisplayName, profileId, currentTs, userId, groupId, groupMemberId)
    when (memProfileId /= profileId) $ deleteUnusedProfile_ db userId memProfileId
    when (memLDN /= localDisplayName) $ deleteUnusedDisplayName_ db userId memLDN

associateContactWithMemberRecord :: DB.Connection -> StoreCxt -> User -> GroupMember -> Contact -> ExceptT StoreError IO Contact
associateContactWithMemberRecord
  db
  cxt
  user@User {userId}
  GroupMember {groupId, groupMemberId, localDisplayName = memLDN, memberProfile = LocalProfile {profileId = memProfileId}}
  Contact {contactId, localDisplayName, profile = LocalProfile {profileId}} = do
    liftIO $ do
      currentTs <- getCurrentTime
      DB.execute
        db
        [sql|
          UPDATE group_members
          SET contact_id = ?, updated_at = ?
          WHERE user_id = ? AND group_id = ? AND group_member_id = ?
        |]
        (contactId, currentTs, userId, groupId, groupMemberId)
      DB.execute
        db
        [sql|
          UPDATE contacts
          SET local_display_name = ?, contact_profile_id = ?, updated_at = ?
          WHERE user_id = ? AND contact_id = ?
        |]
        (memLDN, memProfileId, currentTs, userId, contactId)
      when (profileId /= memProfileId) $ deleteUnusedProfile_ db userId profileId
      when (localDisplayName /= memLDN) $ deleteUnusedDisplayName_ db userId localDisplayName
    getContact db cxt user contactId

deleteUnusedDisplayName_ :: DB.Connection -> UserId -> ContactName -> IO ()
deleteUnusedDisplayName_ db userId localDisplayName =
  DB.execute
    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, localDisplayName, localDisplayName, userId, localDisplayName, userId, localDisplayName)
        :. (userId, localDisplayName, userId, localDisplayName, userId, localDisplayName)
        :. (userId, localDisplayName)
    )

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

updateGroupSettings :: DB.Connection -> User -> Int64 -> ChatSettings -> IO ()
updateGroupSettings db User {userId} groupId ChatSettings {enableNtfs, sendRcpts, favorite} =
  DB.execute db "UPDATE groups SET enable_ntfs = ?, send_rcpts = ?, favorite = ? WHERE user_id = ? AND group_id = ?" (enableNtfs, BI <$> sendRcpts, BI favorite, userId, groupId)

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

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

getHostConnId :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO GroupMemberId
getHostConnId db user@User {userId} groupId = do
  hostMemberId <- getHostMemberId_ db user groupId
  ExceptT . firstRow fromOnly (SEConnectionNotFoundByMemberId hostMemberId) $
    DB.query db "SELECT connection_id FROM connections WHERE user_id = ? AND group_member_id = ?" (userId, hostMemberId)

createMemberContact :: DB.Connection -> User -> ConnId -> ConnReqInvitation -> GroupInfo -> GroupMember -> Connection -> SubscriptionMode -> IO Contact
createMemberContact
  db
  user@User {userId, profile = LocalProfile {preferences}}
  acId
  cReq
  gInfo
  GroupMember {groupMemberId, localDisplayName, memberProfile, memberContactProfileId}
  Connection {connLevel, connChatVersion, peerChatVRange = peerChatVRange@(VersionRange minV maxV)}
  subMode = do
    currentTs <- getCurrentTime
    let incognitoProfile = incognitoMembershipProfile gInfo
        customUserProfileId = localProfileId <$> incognitoProfile
        userPreferences = fromMaybe emptyChatPrefs $ incognitoProfile >> preferences
    DB.execute
      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, localDisplayName, memberContactProfileId, BI True, userPreferences, BI True)
          :. (groupMemberId, BI False, currentTs, currentTs, currentTs)
      )
    contactId <- insertedRowId db
    DB.execute
      db
      "UPDATE group_members SET contact_id = ?, updated_at = ? WHERE contact_profile_id = ?"
      (contactId, currentTs, memberContactProfileId)
    DB.execute -- why do we insert conn_req_inv here? how is it used?
      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, acId, cReq, connLevel, ConnNew, ConnContact, BI True, contactId, customUserProfileId)
          :. (connChatVersion, minV, maxV, currentTs, currentTs, BI (subMode == SMOnlyCreate))
      )
    connId <- insertedRowId db
    let ctConn =
          Connection
            { connId,
              agentConnId = AgentConnId acId,
              peerChatVRange,
              connChatVersion,
              connType = ConnContact,
              contactConnInitiated = True,
              entityId = Just contactId,
              viaContact = Nothing,
              viaUserContactLink = Nothing,
              viaGroupLink = False,
              groupLinkId = Nothing,
              xContactId = Nothing,
              customUserProfileId,
              connLevel,
              connStatus = ConnNew,
              localAlias = "",
              createdAt = currentTs,
              connectionCode = Nothing,
              pqSupport = PQSupportOff,
              pqEncryption = PQEncOff,
              pqSndEnabled = Nothing,
              pqRcvEnabled = Nothing,
              authErrCounter = 0,
              quotaErrCounter = 0
            }
        mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn
    pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, preparedContact = Nothing, contactRequestId = Nothing, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False, groupDirectInv = Nothing, chatTags = [], chatItemTTL = Nothing, uiThemes = Nothing, chatDeleted = False, customData = Nothing}

getMemberContact :: DB.Connection -> StoreCxt -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
getMemberContact db cxt user contactId = do
  ct <- getContact db cxt user contactId
  let Contact {contactGroupMemberId, activeConn} = ct
  case (activeConn, contactGroupMemberId) of
    (Just Connection {connId}, Just groupMemberId) -> do
      cReq <- getConnReqInv db connId
      m@GroupMember {groupId} <- getGroupMemberById db cxt user groupMemberId
      g <- getGroupInfo db cxt user groupId
      pure (g, m, ct, cReq)
    _ ->
      throwError $ SEMemberContactGroupMemberNotFound contactId

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

createMemberContactInvited :: DB.Connection -> User -> GroupInfo -> GroupMember -> GroupDirectInvitation -> IO (ContactId, GroupMember)
createMemberContactInvited
  db
  User {userId, profile = LocalProfile {preferences}}
  gInfo
  m@GroupMember {localDisplayName = memberLDN, memberContactProfileId}
  GroupDirectInvitation {groupDirectInvLink, fromGroupId_, fromGroupMemberId_, fromGroupMemberConnId_, groupDirectInvStartedConnection} = do
    currentTs <- liftIO getCurrentTime
    let userPreferences = fromMaybe emptyChatPrefs $ incognitoMembershipProfile gInfo >> preferences
    contactId <- createContactUpdateMember currentTs userPreferences
    pure (contactId, m {memberContactId = Just contactId})
    where
      createContactUpdateMember :: UTCTime -> Preferences -> IO ContactId
      createContactUpdateMember currentTs userPreferences = do
        DB.execute
          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, memberLDN, memberContactProfileId, BI True, userPreferences, BI True)
              :. (groupDirectInvLink, fromGroupId_, fromGroupMemberId_, fromGroupMemberConnId_, BI groupDirectInvStartedConnection)
              :. (currentTs, currentTs, currentTs)
          )
        contactId <- insertedRowId db
        DB.execute
          db
          "UPDATE group_members SET contact_id = ?, updated_at = ? WHERE contact_profile_id = ?"
          (contactId, currentTs, memberContactProfileId)
        pure contactId

updateMemberContactInvited :: DB.Connection -> User -> Contact -> GroupDirectInvitation -> ExceptT StoreError IO ()
updateMemberContactInvited _ _ Contact {localDisplayName, activeConn = Nothing} _ = throwError $ SEContactNotReady localDisplayName
updateMemberContactInvited db user Contact {contactId, activeConn = Just oldContactConn} groupDirectInv = liftIO $ do
  deleteConnectionRecord db user (dbConnId oldContactConn)
  updateMemberContactFields 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 {groupDirectInvLink, fromGroupId_, fromGroupMemberId_, fromGroupMemberConnId_, groupDirectInvStartedConnection} =
      DB.execute
        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 = ?
        |]
        (CSActive, groupDirectInvLink, fromGroupId_, fromGroupMemberId_, fromGroupMemberConnId_, BI groupDirectInvStartedConnection, contactId)

resetMemberContactFields :: DB.Connection -> Contact -> IO Contact
resetMemberContactFields db ct@Contact {contactId} = do
  currentTs <- liftIO getCurrentTime
  DB.execute
    db
    [sql|
      UPDATE contacts
      SET contact_group_member_id = NULL, contact_grp_inv_sent = 0, updated_at = ?
      WHERE contact_id = ?
    |]
    (currentTs, contactId)
  pure ct {contactGroupMemberId = Nothing, contactGrpInvSent = False, updatedAt = currentTs}

createMemberContactConn :: DB.Connection -> User -> ConnId -> Maybe CommandId -> GroupInfo -> Connection -> ConnStatus -> ContactId -> SubscriptionMode -> IO Int64
createMemberContactConn
  db
  user@User {userId}
  acId
  cmdId_
  gInfo
  _memberConn@Connection {connLevel, connChatVersion, peerChatVRange = VersionRange minV maxV}
  connStatus
  contactId
  subMode = do
    currentTs <- liftIO getCurrentTime
    let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo
    DB.execute
      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, acId, connLevel, connStatus, ConnContact, contactId, customUserProfileId)
          :. (connChatVersion, minV, maxV, currentTs, currentTs, BI (subMode == SMOnlyCreate))
      )
    connId <- insertedRowId db
    forM_ cmdId_ $ \cmdId -> setCommandConnId db user cmdId connId
    pure connId

getMemberContactInvited :: DB.Connection -> StoreCxt -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, Connection, Contact, GroupDirectInvitation)
getMemberContactInvited db cxt user contactId = do
  ct@Contact {groupDirectInv = groupDirectInv_} <- getContact db cxt user contactId
  case groupDirectInv_ of
    Just groupDirectInv@GroupDirectInvitation {fromGroupId_ = Just groupId, fromGroupMemberId_ = Just _gmId, fromGroupMemberConnId_ = Just mConnId} -> do
      g <- getGroupInfo db cxt user groupId
      mConn <- getConnectionById db cxt user mConnId
      pure (g, mConn, ct, groupDirectInv)
    _ ->
      throwError $ SEMemberContactGroupMemberNotFound contactId

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

updateMemberProfile :: DB.Connection -> StoreCxt -> User -> GroupMember -> Profile -> ExceptT StoreError IO GroupMember
updateMemberProfile db cxt user@User {userId} m p' = do
  currentTs <- liftIO getCurrentTime
  badgeVerified <- liftIO $ profileBadgeVerified (badgeKeys cxt) (memberProfile m) p'
  let memberProfile = toLocalProfile profileId p' localAlias currentTs badgeVerified Nothing
  updateMemberProfile' currentTs badgeVerified memberProfile
  where
    GroupMember {groupMemberId, localDisplayName, memberProfile = LocalProfile {profileId, displayName, localAlias}} = m
    Profile {displayName = newName} = p'
    updateMemberProfile' currentTs badgeVerified memberProfile
      | displayName == newName = do
          liftIO $ updateMemberContactProfileReset_' db userId profileId p' badgeVerified currentTs
          pure m {memberProfile}
      | otherwise =
          ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
            updateMemberContactProfileReset_' db userId profileId p' badgeVerified currentTs
            DB.execute
              db
              "UPDATE group_members SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND group_member_id = ?"
              (ldn, currentTs, userId, groupMemberId)
            safeDeleteLDN db user localDisplayName
            pure $ Right m {localDisplayName = ldn, memberProfile}

updateContactMemberProfile :: DB.Connection -> StoreCxt -> User -> GroupMember -> Contact -> Profile -> ExceptT StoreError IO (GroupMember, Contact)
updateContactMemberProfile db cxt user@User {userId} m ct@Contact {contactId} p' = do
  currentTs <- liftIO getCurrentTime
  badgeVerified <- liftIO $ profileBadgeVerified (badgeKeys cxt) (memberProfile m) p'
  let profile = toLocalProfile profileId p' localAlias currentTs badgeVerified Nothing
  updateContactMemberProfile' currentTs badgeVerified profile
  where
    GroupMember {localDisplayName, memberProfile = LocalProfile {profileId, displayName, localAlias}} = m
    Profile {displayName = newName} = p'
    updateContactMemberProfile' currentTs badgeVerified profile
      | displayName == newName = do
          liftIO $ updateMemberContactProfile_' db userId profileId p' badgeVerified currentTs
          pure (m {memberProfile = profile}, ct {profile} :: Contact)
      | otherwise =
          ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
            updateMemberContactProfile_' db userId profileId p' badgeVerified currentTs
            updateContactLDN_ db user contactId localDisplayName ldn currentTs
            pure $ Right (m {localDisplayName = ldn, memberProfile = profile}, ct {localDisplayName = ldn, profile} :: Contact)

getXGrpLinkMemReceived :: DB.Connection -> GroupMemberId -> ExceptT StoreError IO Bool
getXGrpLinkMemReceived db mId =
  ExceptT . firstRow fromOnlyBI (SEGroupMemberNotFound mId) $
    DB.query db "SELECT xgrplinkmem_received FROM group_members WHERE group_member_id = ?" (Only mId)

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

createNewUnknownGroupMember :: DB.Connection -> StoreCxt -> User -> GroupInfo -> MemberId -> Text -> GroupMemberRole -> ExceptT StoreError IO GroupMember
createNewUnknownGroupMember db cxt user@User {userId, userContactId} GroupInfo {groupId} memberId memberName unknownMemberRole = do
  currentTs <- liftIO getCurrentTime
  let memberProfile = profileFromName memberName
  (localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user memberProfile currentTs
  indexInGroup <- getUpdateNextIndexInGroup_ db groupId
  liftIO $
    DB.execute
      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 (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
      |]
      ( (groupId, indexInGroup, memberId, unknownMemberRole, GCPreMember, GSMemUnknown, Binary B.empty, fromInvitedBy userContactId IBUnknown)
          :. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, currentTs, currentTs)
          :. (minV, maxV)
      )
  groupMemberId <- liftIO $ insertedRowId db
  getGroupMemberById db cxt user groupMemberId
  where
    VersionRange minV maxV = vr cxt

createLinkOwnerMember :: DB.Connection -> StoreCxt -> User -> GroupInfo -> Maybe ContactId -> MemberId -> C.PublicKeyEd25519 -> ExceptT StoreError IO GroupMember
createLinkOwnerMember db cxt user@User {userId, userContactId} GroupInfo {groupId} contactId_ memberId ownerKey = do
  currentTs <- liftIO getCurrentTime
  let memberProfile = profileFromName $ nameFromMemberId memberId
  (localDisplayName, profileId, _) <- createNewMemberProfile_ db cxt user memberProfile currentTs
  indexInGroup <- getUpdateNextIndexInGroup_ db groupId
  liftIO $
    DB.execute
      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, member_pub_key, created_at, updated_at,
            peer_chat_min_version, peer_chat_max_version)
        VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
      |]
      ( (groupId, indexInGroup, memberId, GROwner, GCPreMember, GSMemUnknown, Binary B.empty, fromInvitedBy userContactId IBUnknown)
          :. (userId, localDisplayName, contactId_, profileId, ownerKey, currentTs, currentTs)
          :. (minV, maxV)
      )
  groupMemberId <- liftIO $ insertedRowId db
  getGroupMemberById db cxt user groupMemberId
  where
    VersionRange minV maxV = vr cxt

-- Intro refreshes only profile / status / peer version. Role and key stay owner-authoritative
-- (the owner-signed roster for members/moderators/admins, link data for owners), so taking either from
-- an in-band relayed intro would let a compromised relay substitute them.
updatePreparedChannelMember :: DB.Connection -> StoreCxt -> User -> GroupMember -> MemberInfo -> ExceptT StoreError IO GroupMember
updatePreparedChannelMember db cxt user@User {userId} member@GroupMember {groupMemberId, memberChatVRange} MemberInfo {v, profile} = do
  _ <- updateMemberProfile db cxt user member profile
  currentTs <- liftIO getCurrentTime
  liftIO $
    DB.execute
      db
      [sql|
        UPDATE group_members
        SET member_status = ?,
            peer_chat_min_version = ?,
            peer_chat_max_version = ?,
            updated_at = ?
        WHERE user_id = ? AND group_member_id = ?
      |]
      (GSMemIntroduced, minV, maxV, currentTs, userId, groupMemberId)
  getGroupMemberById db cxt user groupMemberId
  where
    VersionRange minV maxV = maybe memberChatVRange fromChatVRange v

updateUnknownMemberAnnounced :: DB.Connection -> StoreCxt -> User -> GroupMember -> GroupMember -> MemberInfo -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
updateUnknownMemberAnnounced db cxt user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile, memberKey} status = do
  _ <- updateMemberProfile db cxt user unknownMember profile
  currentTs <- liftIO getCurrentTime
  liftIO $
    DB.execute
      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 = ?,
            member_pub_key = ?,
            updated_at = ?
        WHERE user_id = ? AND group_member_id = ?
      |]
      ( (memberRole, GCPostMember, status, groupMemberId' invitingMember)
          :. (minV, maxV, memberPubKey_, currentTs, userId, groupMemberId)
      )
  getGroupMemberById db cxt user groupMemberId
  where
    VersionRange minV maxV = maybe memberChatVRange fromChatVRange v
    memberPubKey_ = (\(MemberKey k) -> k) <$> memberKey

-- Like updateUnknownMemberAnnounced but preserves member_role and member_pub_key
-- (roster-established for moderators/admins; the dissemination carries only the profile).
updateRosterMemberAnnounced :: DB.Connection -> StoreCxt -> User -> GroupMember -> GroupMember -> MemberInfo -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
updateRosterMemberAnnounced db cxt user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {v, profile} status = do
  _ <- updateMemberProfile db cxt user unknownMember profile
  currentTs <- liftIO getCurrentTime
  liftIO $
    DB.execute
      db
      [sql|
        UPDATE group_members
        SET 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 = ?
      |]
      ((GCPostMember, status, groupMemberId' invitingMember) :. (minV, maxV, currentTs, userId, groupMemberId))
  getGroupMemberById db cxt user groupMemberId
  where
    VersionRange minV maxV = maybe memberChatVRange fromChatVRange v

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

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

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

updateGroupChatTags :: DB.Connection -> GroupId -> [ChatTagId] -> IO ()
updateGroupChatTags db gId tIds = do
  currentTags <- getGroupChatTags db gId
  let tagsToAdd = filter (`notElem` currentTags) tIds
      tagsToDelete = filter (`notElem` tIds) currentTags
  forM_ tagsToDelete $ untagGroupChat db gId
  forM_ tagsToAdd $ tagGroupChat db gId

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

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

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

getGroupChatTTL :: DB.Connection -> GroupId -> IO (Maybe Int64)
getGroupChatTTL db gId =
  fmap join . maybeFirstRow fromOnly $
    DB.query db "SELECT chat_item_ttl FROM groups WHERE group_id = ? LIMIT 1" (Only gId)

getUserGroupsToExpire :: DB.Connection -> User -> Int64 -> IO [GroupId]
getUserGroupsToExpire db User {userId} globalTTL =
  map fromOnly <$> DB.query db ("SELECT group_id FROM groups WHERE user_id = ? AND chat_item_ttl > 0" <> cond) (Only userId)
  where
    cond = if globalTTL == 0 then "" else " OR chat_item_ttl IS NULL"

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