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

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

module Simplex.Chat.Store.Profiles
  ( AutoAccept (..),
    AddressSettings (..),
    UserMsgReceiptSettings (..),
    UserContactLink (..),
    GroupLinkInfo (..),
    createUserRecordAt,
    getUsersInfo,
    getUsers,
    setActiveUser,
    getUser,
    getRelayUser,
    getUserIdByName,
    getUserByAConnId,
    getUserByASndFileId,
    getUserByARcvFileId,
    getUserByContactId,
    getUserByGroupId,
    getUserByNoteFolderId,
    getUserByFileId,
    getUserFileInfo,
    deleteUserRecord,
    updateUserPrivacy,
    updateClientService,
    updateAllContactReceipts,
    updateUserContactReceipts,
    updateUserGroupReceipts,
    updateUserAutoAcceptMemberContacts,
    updateUserProfile,
    setUserBadge,
    setUserProfileContactLink,
    getUserContactProfiles,
    createUserContactLink,
    getUserAddressConnection,
    deleteUserAddress,
    getUserAddress,
    setUserSimplexDomain,
    getUserContactLinkById,
    getGroupLinkInfo,
    getUserContactLinkByConnReq,
    getUserContactLinkViaTarget,
    setUserContactLinkShortLink,
    getContactWithoutConnViaAddress,
    getContactWithoutConnViaShortAddress,
    updateUserAddressSettings,
    getProtocolServers,
    getChatRelays,
    getChatRelayById,
    insertProtocolServer,
    getUpdateServerOperators,
    getServerOperators,
    getUserServers,
    setServerOperators,
    getCurrentUsageConditions,
    getLatestAcceptedConditions,
    setConditionsNotified,
    acceptConditions,
    setUserServers,
    setUserServers',
    createCall,
    deleteCalls,
    getCalls,
    createCommand,
    setCommandConnId,
    deleteCommand,
    updateCommandStatus,
    getCommandDataByCorrId,
    setUserUIThemes,
    profileContactLink,
  )
where

import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class
import qualified Data.Aeson.TH as J
import Data.Functor (($>))
import Data.Int (Int64)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as L
import Data.Maybe (catMaybes, fromMaybe, isJust)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import Data.Time.Clock (UTCTime (..), getCurrentTime)
import Simplex.Chat.Badges (LocalBadge, localBadgeToRow)
import Simplex.Chat.Call
import Simplex.Chat.Messages
import Simplex.Chat.Operators
import Simplex.Chat.Protocol
import Simplex.Chat.Store.Direct
import Simplex.Chat.Store.Shared
import Simplex.Chat.Names (claimDomain, mkDomainClaim)
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Chat.Types.UITheme
import Simplex.Messaging.Agent.Env.SQLite (ServerRoles (..))
import Simplex.Messaging.Agent.Protocol (ACorrId, ConnId, ConnectionLink (..), CreatedConnLink (..), SimplexDomain, SimplexNameInfo (..), UserId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, maybeFirstRow)
import Simplex.Messaging.Agent.Store.DB (BoolInt (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
import qualified Simplex.Messaging.Crypto as C
import qualified Simplex.Messaging.Crypto.Ratchet as CR
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON)
import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolType (..), ProtocolTypeI (..), SProtocolType (..), SubscriptionMode)
import Simplex.Messaging.Agent.Store.Entity
import Simplex.Messaging.Transport.Client (TransportHost)
import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8)
#if defined(dbPostgres)
import Database.PostgreSQL.Simple (Only (..), Query, (:.) (..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
#else
import Database.SQLite.Simple (Only (..), Query, (:.) (..))
import Database.SQLite.Simple.QQ (sql)
#endif

createUserRecordAt :: DB.Connection -> AgentUserId -> Bool -> Bool -> Profile -> Bool -> UTCTime -> ExceptT StoreError IO User
createUserRecordAt db (AgentUserId auId) userChatRelay clientService Profile {displayName, fullName, shortDescr, image, peerType, preferences = userPreferences} activeUser currentTs =
  checkConstraint SEDuplicateName . liftIO $ do
    when activeUser $ DB.execute_ db "UPDATE users SET active_user = 0"
    let showNtfs = True
        sendRcptsContacts = True
        sendRcptsSmallGroups = True
        autoAcceptMemberContacts = False
    order <- getNextActiveOrder db
    DB.execute
      db
      "INSERT INTO users (agent_user_id, local_display_name, active_user, is_user_chat_relay, active_order, contact_id, show_ntfs, send_rcpts_contacts, send_rcpts_small_groups, auto_accept_member_contacts, client_service, created_at, updated_at) VALUES (?,?,?,?,?,0,?,?,?,?,?,?,?)"
      ( (auId, displayName, BI activeUser, BI userChatRelay, order)
          :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, BI clientService, currentTs, currentTs)
      )
    userId <- insertedRowId db
    DB.execute
      db
      "INSERT INTO display_names (local_display_name, ldn_base, user_id, created_at, updated_at) VALUES (?,?,?,?,?)"
      (displayName, displayName, userId, currentTs, currentTs)
    DB.execute
      db
      "INSERT INTO contact_profiles (display_name, full_name, short_descr, image, chat_peer_type, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
      (displayName, fullName, shortDescr, image, peerType, userId, userPreferences, currentTs, currentTs)
    profileId <- insertedRowId db
    DB.execute
      db
      "INSERT INTO contacts (contact_profile_id, local_display_name, user_id, is_user, created_at, updated_at, chat_ts) VALUES (?,?,?,?,?,?,?)"
      (profileId, displayName, userId, BI True, currentTs, currentTs, currentTs)
    contactId <- insertedRowId db
    DB.execute db "UPDATE users SET contact_id = ? WHERE user_id = ?" (contactId, userId)
    pure $ toUser currentTs $ (userId, auId, contactId, profileId, BI activeUser, order) :. (displayName, fullName, shortDescr, image, Nothing, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, Nothing, Nothing, Nothing, BI userChatRelay, BI clientService, Nothing) :. localBadgeToRow Nothing :. (Nothing, Nothing, Nothing)

-- TODO [mentions]
getUsersInfo :: DB.Connection -> IO [UserInfo]
getUsersInfo db = getUsers db >>= mapM getUserInfo
  where
    getUserInfo :: User -> IO UserInfo
    getUserInfo user@User {userId} = do
      ctCount <-
        maybeFirstRow fromOnly $
          DB.query
            db
            [sql|
              SELECT COUNT(1)
              FROM chat_items i
              JOIN contacts ct USING (contact_id)
              WHERE i.user_id = ? AND i.item_status = ? AND (ct.enable_ntfs = 1 OR ct.enable_ntfs IS NULL) AND ct.deleted = 0
            |]
            (userId, CISRcvNew)
      gCount <-
        maybeFirstRow fromOnly $
          DB.query
            db
            [sql|
              SELECT COUNT(1)
              FROM chat_items i
              JOIN groups g USING (group_id)
              WHERE i.user_id = ? AND i.item_status = ?
                AND (g.enable_ntfs = 1 OR g.enable_ntfs IS NULL OR (g.enable_ntfs = 2 AND i.user_mention = 1))
            |]
            (userId, CISRcvNew)
      pure UserInfo {user, unreadCount = fromMaybe 0 ctCount + fromMaybe 0 gCount}

getUsers :: DB.Connection -> IO [User]
getUsers db = do
  now <- getCurrentTime
  map (toUser now) <$> DB.query_ db userQuery

setActiveUser :: DB.Connection -> User -> IO User
setActiveUser db user@User {userId} = do
  DB.execute_ db "UPDATE users SET active_user = 0"
  activeOrder <- getNextActiveOrder db
  DB.execute db "UPDATE users SET active_user = 1, active_order = ? WHERE user_id = ?" (activeOrder, userId)
  pure user {activeUser = True, activeOrder}

getNextActiveOrder :: DB.Connection -> IO Int64
getNextActiveOrder db = do
  order <- fromMaybe 0 . join <$> maybeFirstRow fromOnly (DB.query_ db "SELECT max(active_order) FROM users")
  if order == maxBound
    then 0 <$ DB.execute db "UPDATE users SET active_order = active_order - ?" (Only (maxBound :: Int64))
    else pure $ order + 1

getUser :: DB.Connection -> UserId -> ExceptT StoreError IO User
getUser db userId = do
  now <- liftIO getCurrentTime
  ExceptT . firstRow (toUser now) (SEUserNotFound userId) $
    DB.query db (userQuery <> " WHERE u.user_id = ?") (Only userId)

getRelayUser :: DB.Connection -> ExceptT StoreError IO User
getRelayUser db = do
  now <- liftIO getCurrentTime
  ExceptT . firstRow (toUser now) SERelayUserNotFound $
    DB.query_ db (userQuery <> " WHERE u.is_user_chat_relay = 1")

getUserIdByName :: DB.Connection -> UserName -> ExceptT StoreError IO Int64
getUserIdByName db uName =
  ExceptT . firstRow fromOnly (SEUserNotFoundByName uName) $
    DB.query db "SELECT user_id FROM users WHERE local_display_name = ?" (Only uName)

getUserByAConnId :: DB.Connection -> AgentConnId -> IO (Maybe User)
getUserByAConnId db agentConnId = do
  now <- getCurrentTime
  maybeFirstRow (toUser now) $
    DB.query db (userQuery <> " JOIN connections c ON c.user_id = u.user_id WHERE c.agent_conn_id = ?") (Only agentConnId)

getUserByASndFileId :: DB.Connection -> AgentSndFileId -> IO (Maybe User)
getUserByASndFileId db aSndFileId = do
  now <- getCurrentTime
  maybeFirstRow (toUser now) $
    DB.query db (userQuery <> " JOIN files f ON f.user_id = u.user_id WHERE f.agent_snd_file_id = ?") (Only aSndFileId)

getUserByARcvFileId :: DB.Connection -> AgentRcvFileId -> IO (Maybe User)
getUserByARcvFileId db aRcvFileId = do
  now <- getCurrentTime
  maybeFirstRow (toUser now) $
    DB.query db (userQuery <> " JOIN files f ON f.user_id = u.user_id JOIN rcv_files r ON r.file_id = f.file_id WHERE r.agent_rcv_file_id = ?") (Only aRcvFileId)

getUserByContactId :: DB.Connection -> ContactId -> ExceptT StoreError IO User
getUserByContactId db contactId = do
  now <- liftIO getCurrentTime
  ExceptT . firstRow (toUser now) (SEUserNotFoundByContactId contactId) $
    DB.query db (userQuery <> " JOIN contacts ct ON ct.user_id = u.user_id WHERE ct.contact_id = ? AND ct.deleted = 0") (Only contactId)

getUserByGroupId :: DB.Connection -> GroupId -> ExceptT StoreError IO User
getUserByGroupId db groupId = do
  now <- liftIO getCurrentTime
  ExceptT . firstRow (toUser now) (SEUserNotFoundByGroupId groupId) $
    DB.query db (userQuery <> " JOIN groups g ON g.user_id = u.user_id WHERE g.group_id = ?") (Only groupId)

getUserByNoteFolderId :: DB.Connection -> NoteFolderId -> ExceptT StoreError IO User
getUserByNoteFolderId db contactId = do
  now <- liftIO getCurrentTime
  ExceptT . firstRow (toUser now) (SEUserNotFoundByContactId contactId) $
    DB.query db (userQuery <> " JOIN note_folders nf ON nf.user_id = u.user_id WHERE nf.note_folder_id = ?") (Only contactId)

getUserByFileId :: DB.Connection -> FileTransferId -> ExceptT StoreError IO User
getUserByFileId db fileId = do
  now <- liftIO getCurrentTime
  ExceptT . firstRow (toUser now) (SEUserNotFoundByFileId fileId) $
    DB.query db (userQuery <> " JOIN files f ON f.user_id = u.user_id WHERE f.file_id = ?") (Only fileId)

getUserFileInfo :: DB.Connection -> User -> IO [CIFileInfo]
getUserFileInfo db User {userId} =
  map toFileInfo
    <$> DB.query db (fileInfoQuery <> " WHERE i.user_id = ?") (Only userId)

deleteUserRecord :: DB.Connection -> User -> IO ()
deleteUserRecord db User {userId} =
  DB.execute db "DELETE FROM users WHERE user_id = ?" (Only userId)

updateUserPrivacy :: DB.Connection -> User -> IO ()
updateUserPrivacy db User {userId, showNtfs, viewPwdHash} =
  DB.execute
    db
    [sql|
      UPDATE users
      SET view_pwd_hash = ?, view_pwd_salt = ?, show_ntfs = ?
      WHERE user_id = ?
    |]
    (hashSalt viewPwdHash :. (BI showNtfs, userId))
  where
    hashSalt = L.unzip . fmap (\UserPwdHash {hash, salt} -> (hash, salt))

updateClientService :: DB.Connection -> UserId -> Bool -> IO ()
updateClientService db userId enable =
  DB.execute
    db
    [sql|
      UPDATE users
      SET client_service = ?
      WHERE user_id = ?
    |]
    (BI enable, userId)

updateAllContactReceipts :: DB.Connection -> Bool -> IO ()
updateAllContactReceipts db onOff =
  DB.execute
    db
    "UPDATE users SET send_rcpts_contacts = ?, send_rcpts_small_groups = ? WHERE view_pwd_hash IS NULL"
    (BI onOff, BI onOff)

updateUserContactReceipts :: DB.Connection -> User -> UserMsgReceiptSettings -> IO ()
updateUserContactReceipts db User {userId} UserMsgReceiptSettings {enable, clearOverrides} = do
  DB.execute db "UPDATE users SET send_rcpts_contacts = ? WHERE user_id = ?" (BI enable, userId)
  when clearOverrides $ DB.execute_ db "UPDATE contacts SET send_rcpts = NULL"

updateUserGroupReceipts :: DB.Connection -> User -> UserMsgReceiptSettings -> IO ()
updateUserGroupReceipts db User {userId} UserMsgReceiptSettings {enable, clearOverrides} = do
  DB.execute db "UPDATE users SET send_rcpts_small_groups = ? WHERE user_id = ?" (BI enable, userId)
  when clearOverrides $ DB.execute_ db "UPDATE groups SET send_rcpts = NULL"

updateUserAutoAcceptMemberContacts :: DB.Connection -> User -> Bool -> IO ()
updateUserAutoAcceptMemberContacts db User {userId} autoAccept =
  DB.execute db "UPDATE users SET auto_accept_member_contacts = ? WHERE user_id = ?" (BI autoAccept, userId)

updateUserProfile :: DB.Connection -> User -> Profile -> ExceptT StoreError IO User
updateUserProfile db user p'
  | displayName == newName = liftIO $ do
      currentTs <- getCurrentTime
      updateUserProfileFields_' db userId profileId p' currentTs
      userMemberProfileUpdatedAt' <- updateUserMemberProfileUpdatedAt_ currentTs
      pure user {profile = (toLocalProfile profileId p' localAlias currentTs (Just False) Nothing) {localBadge}, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
  | otherwise =
      checkConstraint SEDuplicateName . liftIO $ do
        currentTs <- getCurrentTime
        DB.execute db "UPDATE users SET local_display_name = ?, updated_at = ? WHERE user_id = ?" (newName, currentTs, userId)
        userMemberProfileUpdatedAt' <- updateUserMemberProfileUpdatedAt_ currentTs
        DB.execute
          db
          "INSERT INTO display_names (local_display_name, ldn_base, user_id, created_at, updated_at) VALUES (?,?,?,?,?)"
          (newName, newName, userId, currentTs, currentTs)
        updateUserProfileFields_' db userId profileId p' currentTs
        updateContactLDN_ db user userContactId localDisplayName newName currentTs
        pure user {localDisplayName = newName, profile = (toLocalProfile profileId p' localAlias currentTs (Just False) Nothing) {localBadge}, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
  where
    updateUserMemberProfileUpdatedAt_ currentTs
      | userMemberProfileChanged = do
          DB.execute db "UPDATE users SET user_member_profile_updated_at = ? WHERE user_id = ?" (currentTs, userId)
          pure $ Just currentTs
      | otherwise = pure userMemberProfileUpdatedAt
    userMemberProfileChanged = newName /= displayName || fn' /= fullName || d' /= shortDescr || img' /= image
    User {userId, userContactId, localDisplayName, profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, localBadge, localAlias}, userMemberProfileUpdatedAt} = user
    Profile {displayName = newName, fullName = fn', shortDescr = d', image = img', preferences} = p'
    fullPreferences = fullPreferences' preferences

-- own profile field update; leaves the badge columns alone (the credential is owned by setUserBadge/addUserBadge)
updateUserProfileFields_' :: DB.Connection -> UserId -> ProfileId -> Profile -> UTCTime -> IO ()
updateUserProfileFields_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType} updatedAt =
  DB.execute
    db
    [sql|
      UPDATE contact_profiles
      SET display_name = ?, full_name = ?, short_descr = ?, image = ?, contact_link = ?, preferences = ?, chat_peer_type = ?, updated_at = ?
      WHERE user_id = ? AND contact_profile_id = ?
    |]
    ((displayName, fullName, shortDescr, image, contactLink, preferences, peerType, updatedAt) :. (userId, profileId))

-- store the user's own badge credential; touches only the badge columns.
-- bumps user_member_profile_updated_at so groups receive the updated profile (with the badge) on the next message.
setUserBadge :: DB.Connection -> User -> Maybe LocalBadge -> IO User
setUserBadge db user@User {userId, profile = p@LocalProfile {profileId}} localBadge = do
  ts <- getCurrentTime
  DB.execute
    db
    [sql|
      UPDATE contact_profiles
      SET badge_proof = ?, badge_pres_header = ?, badge_expiry = ?, badge_type = ?, badge_verified = ?, badge_extra = ?, badge_master_key = ?, badge_signature = ?, badge_key_idx = ?, updated_at = ?
      WHERE user_id = ? AND contact_profile_id = ?
    |]
    (localBadgeToRow localBadge :. (ts, userId, profileId))
  DB.execute db "UPDATE users SET user_member_profile_updated_at = ? WHERE user_id = ?" (ts, userId)
  pure (user :: User) {profile = p {localBadge}, userMemberProfileUpdatedAt = Just ts}

setUserSimplexDomain :: DB.Connection -> User -> Maybe SimplexDomain -> IO User
setUserSimplexDomain db user@User {userId, profile = p@LocalProfile {profileId}} domain_ = do
  ts <- getCurrentTime
  DB.execute
    db
    "UPDATE contact_profiles SET contact_domain = ?, updated_at = ? WHERE user_id = ? AND contact_profile_id = ?"
    (domain_, ts, userId, profileId)
  pure (user :: User) {profile = p {contactDomain = mkDomainClaim <$> domain_}}

setUserProfileContactLink :: DB.Connection -> User -> Maybe UserContactLink -> IO User
setUserProfileContactLink db user@User {userId, profile = p@LocalProfile {profileId}} ucl_ = do
  ts <- getCurrentTime
  DB.execute
    db
    [sql|
      UPDATE contact_profiles
      SET contact_link = ?, updated_at = ?
      WHERE user_id = ? AND contact_profile_id = ?
    |]
    (contactLink, ts, userId, profileId)
  pure (user :: User) {profile = p {contactLink}}
  where
    contactLink = profileContactLink <$> ucl_

-- only used in tests
getUserContactProfiles :: DB.Connection -> User -> IO [Profile]
getUserContactProfiles db User {userId} =
  map toContactProfile
    <$> DB.query
      db
      [sql|
        SELECT display_name, full_name, short_descr, image, contact_link, chat_peer_type, contact_domain, preferences
        FROM contact_profiles
        WHERE user_id = ?
      |]
      (Only userId)
  where
    toContactProfile :: (ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe SimplexDomain, Maybe Preferences) -> Profile
    toContactProfile (displayName, fullName, shortDescr, image, contactLink, peerType, domain_, preferences) = Profile {displayName, fullName, shortDescr, image, contactLink, contactDomain = mkDomainClaim <$> domain_, peerType, preferences, badge = Nothing}

createUserContactLink :: DB.Connection -> User -> ConnId -> CreatedLinkContact -> SubscriptionMode -> C.PrivateKeyEd25519 -> ExceptT StoreError IO ()
createUserContactLink db User {userId} agentConnId (CCLink cReq shortLink) subMode linkPrivSigKey =
  checkConstraint SEDuplicateContactLink . liftIO $ do
    currentTs <- getCurrentTime
    let slDataSet = BI (isJust shortLink)
    DB.execute
      db
      "INSERT INTO user_contact_links (user_id, conn_req_contact, short_link_contact, short_link_data_set, short_link_large_data_set, link_priv_sig_key, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
      (userId, cReq, shortLink, slDataSet, slDataSet, linkPrivSigKey, currentTs, currentTs)
    userContactLinkId <- insertedRowId db
    void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId ConnNew initialChatVersion chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode CR.PQSupportOff

getUserAddressConnection :: DB.Connection -> StoreCxt -> User -> ExceptT StoreError IO Connection
getUserAddressConnection db cxt User {userId} = do
  ExceptT . firstRow (toConnection cxt) SEUserContactLinkNotFound $
    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.local_display_name = '' AND uc.group_id IS NULL
      |]
      (userId, userId)

deleteUserAddress :: DB.Connection -> User -> IO ()
deleteUserAddress db user@User {userId} = 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.local_display_name = '' AND uc.group_id IS NULL
      )
    |]
    (Only userId)
  void $ setUserProfileContactLink db user Nothing
  DB.execute db "DELETE FROM user_contact_links WHERE user_id = ? AND local_display_name = '' AND group_id IS NULL" (Only userId)

data UserMsgReceiptSettings = UserMsgReceiptSettings
  { enable :: Bool,
    clearOverrides :: Bool
  }
  deriving (Show)

data UserContactLink = UserContactLink
  { userContactLinkId :: Int64,
    connLinkContact :: CreatedLinkContact,
    shortLinkDataSet :: Bool,
    shortLinkLargeDataSet :: BoolDef,
    addressSettings :: AddressSettings
  }
  deriving (Show)

profileContactLink :: UserContactLink -> ConnLinkContact
profileContactLink UserContactLink {connLinkContact = CCLink cReq sLink} = maybe (CLFull cReq) CLShort sLink

data GroupLinkInfo = GroupLinkInfo
  { groupId :: GroupId,
    memberRole :: GroupMemberRole
  }
  deriving (Show)

data AddressSettings = AddressSettings
  { businessAddress :: Bool, -- possibly, it can be wrapped together with acceptIncognito, or AutoAccept made sum type
    autoAccept :: Maybe AutoAccept, -- accept automatically
    autoReply :: Maybe MsgContent -- included in short link information, sent on acceptance in case wasn't shown during connection
  }
  deriving (Eq, Show)

data AutoAccept = AutoAccept
  { acceptIncognito :: IncognitoEnabled -- "incognito" is allowed onle for old addresses without short link data
  }
  deriving (Eq, Show)

$(J.deriveJSON defaultJSON ''AutoAccept)

$(J.deriveJSON defaultJSON ''AddressSettings)

$(J.deriveJSON defaultJSON ''UserContactLink)

toUserContactLink :: (Int64, ConnReqContact, Maybe ShortLinkContact, BoolInt, BoolInt, BoolInt, BoolInt, BoolInt, Maybe MsgContent) -> UserContactLink
toUserContactLink (userContactLinkId, connReq, shortLink, BI shortLinkDataSet, BI slLargeDataSet, BI businessAddress, BI autoAccept', BI acceptIncognito, autoReply) =
  UserContactLink userContactLinkId (CCLink connReq shortLink) shortLinkDataSet (BoolDef slLargeDataSet) $
    let autoAccept = if autoAccept' then Just AutoAccept {acceptIncognito} else Nothing
     in AddressSettings {businessAddress, autoAccept, autoReply}

getUserAddress :: DB.Connection -> User -> ExceptT StoreError IO UserContactLink
getUserAddress db User {userId} =
  ExceptT . firstRow toUserContactLink SEUserContactLinkNotFound $
    DB.query db (userContactLinkQuery <> " WHERE user_id = ? AND local_display_name = '' AND group_id IS NULL") (Only userId)

getUserContactLinkById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO (UserContactLink, Maybe GroupLinkInfo)
getUserContactLinkById db userId userContactLinkId =
  ExceptT . firstRow (\(ucl :. gli) -> (toUserContactLink ucl, toGroupLinkInfo gli)) SEUserContactLinkNotFound $
    DB.query
      db
      [sql|
        SELECT user_contact_link_id, conn_req_contact, short_link_contact, short_link_data_set, short_link_large_data_set, business_address, auto_accept, auto_accept_incognito, auto_reply_msg_content, group_id, group_link_member_role
        FROM user_contact_links
        WHERE user_id = ? AND user_contact_link_id = ?
      |]
      (userId, userContactLinkId)

toGroupLinkInfo :: (Maybe GroupId, Maybe GroupMemberRole) -> Maybe GroupLinkInfo
toGroupLinkInfo (groupId_, mRole_) =
  (\groupId -> GroupLinkInfo {groupId, memberRole = fromMaybe GRMember mRole_})
    <$> groupId_

getGroupLinkInfo :: DB.Connection -> UserId -> GroupId -> IO (Maybe GroupLinkInfo)
getGroupLinkInfo db userId groupId =
  fmap join $ maybeFirstRow toGroupLinkInfo $
    DB.query
      db
      [sql|
        SELECT group_id, group_link_member_role
        FROM user_contact_links
        WHERE user_id = ? AND group_id = ?
      |]
      (userId, groupId)

getUserContactLinkByConnReq :: DB.Connection -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe UserContactLink)
getUserContactLinkByConnReq db User {userId} (cReqSchema1, cReqSchema2) =
  maybeFirstRow toUserContactLink $
    DB.query db (userContactLinkQuery <> " WHERE user_id = ? AND conn_req_contact IN (?,?)") (userId, cReqSchema1, cReqSchema2)

getUserContactLinkViaTarget :: DB.Connection -> User -> ContactNameOrLink -> IO (Maybe UserContactLink)
getUserContactLinkViaTarget db User {userId, profile = LocalProfile {contactDomain}} = \case
  CTLink shortLink ->
    maybeFirstRow toUserContactLink $
      DB.query db (userContactLinkQuery <> " WHERE user_id = ? AND short_link_contact = ?") (userId, shortLink)
  CTName ni
    | (claimDomain <$> contactDomain) == Just (nameDomain ni) ->
        maybeFirstRow toUserContactLink $
          DB.query db (userContactLinkQuery <> " WHERE user_id = ? AND group_id IS NULL AND short_link_contact IS NOT NULL") (Only userId)
    | otherwise -> pure Nothing

userContactLinkQuery :: Query
userContactLinkQuery =
  [sql|
    SELECT user_contact_link_id, conn_req_contact, short_link_contact, short_link_data_set, short_link_large_data_set, business_address, auto_accept, auto_accept_incognito, auto_reply_msg_content
    FROM user_contact_links
  |]

setUserContactLinkShortLink :: DB.Connection -> Int64 -> ShortLinkContact -> IO ()
setUserContactLinkShortLink db userContactLinkId shortLink =
  DB.execute
    db
    [sql|
      UPDATE user_contact_links
      SET short_link_contact = ?,
          short_link_data_set = ?,
          short_link_large_data_set = ?,
          auto_accept_incognito = ?
      WHERE user_contact_link_id = ?
    |]
    (shortLink, BI True, BI True, BI False, userContactLinkId)

getContactWithoutConnViaAddress :: DB.Connection -> StoreCxt -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe Contact)
getContactWithoutConnViaAddress db cxt user@User {userId} (cReqSchema1, cReqSchema2) = do
  ctId_ <-
    maybeFirstRow fromOnly $
      DB.query
        db
        [sql|
          SELECT ct.contact_id
          FROM contacts ct
          JOIN contact_profiles cp ON cp.contact_profile_id = ct.contact_profile_id
          LEFT JOIN connections c ON c.contact_id = ct.contact_id
          WHERE cp.user_id = ? AND cp.contact_link IN (?,?) AND c.connection_id IS NULL
        |]
        (userId, cReqSchema1, cReqSchema2)
  maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db cxt user) ctId_

getContactWithoutConnViaShortAddress :: DB.Connection -> StoreCxt -> User -> ShortLinkContact -> IO (Maybe Contact)
getContactWithoutConnViaShortAddress db cxt user@User {userId} shortLink = do
  ctId_ <-
    maybeFirstRow fromOnly $
      DB.query
        db
        [sql|
          SELECT ct.contact_id
          FROM contacts ct
          JOIN contact_profiles cp ON cp.contact_profile_id = ct.contact_profile_id
          LEFT JOIN connections c ON c.contact_id = ct.contact_id
          WHERE cp.user_id = ? AND cp.contact_link = ? AND c.connection_id IS NULL
        |]
        (userId, shortLink)
  maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db cxt user) ctId_

updateUserAddressSettings :: DB.Connection -> Int64 -> AddressSettings -> IO ()
updateUserAddressSettings db userContactLinkId AddressSettings {businessAddress, autoAccept, autoReply} =
  DB.execute
    db
    [sql|
      UPDATE user_contact_links
      SET auto_accept = ?, auto_accept_incognito = ?, business_address = ?, auto_reply_msg_content = ?
      WHERE user_contact_link_id = ?
    |]
    (autoAcceptValues :. (BI businessAddress, autoReply, userContactLinkId))
  where
    autoAcceptValues = case autoAccept of
      Just AutoAccept {acceptIncognito} -> (BI True, BI acceptIncognito)
      Nothing -> (BI False, BI False)

getProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> SProtocolType p -> User -> IO [UserServer p]
getProtocolServers db p User {userId} =
  map toUserServer
    <$> DB.query
      db
      [sql|
        SELECT smp_server_id, host, port, key_hash, basic_auth, preset, tested, enabled
        FROM protocol_servers
        WHERE user_id = ? AND protocol = ?
      |]
      (userId, decodeLatin1 $ strEncode p)
  where
    toUserServer :: (DBEntityId, NonEmpty TransportHost, String, C.KeyHash, Maybe Text, BoolInt, Maybe BoolInt, BoolInt) -> UserServer p
    toUserServer (serverId, host, port, keyHash, auth_, BI preset, tested, BI enabled) =
      let server = ProtoServerWithAuth (ProtocolServer p host port keyHash) (BasicAuth . encodeUtf8 <$> auth_)
       in UserServer {serverId, server, preset, tested = unBI <$> tested, enabled, deleted = False}

insertProtocolServer :: forall p. ProtocolTypeI p => DB.Connection -> SProtocolType p -> User -> UTCTime -> NewUserServer p -> IO (UserServer p)
insertProtocolServer db p User {userId} ts srv@UserServer {server, preset, tested, enabled} = do
  DB.execute
    db
    [sql|
      INSERT INTO protocol_servers
        (protocol, host, port, key_hash, basic_auth, preset, tested, enabled, user_id, created_at, updated_at)
      VALUES (?,?,?,?,?,?,?,?,?,?,?)
    |]
    (serverColumns p server :. (BI preset, BI <$> tested, BI enabled, userId, ts, ts))
  sId <- insertedRowId db
  pure (srv :: NewUserServer p) {serverId = DBEntityId sId}

updateProtocolServer :: ProtocolTypeI p => DB.Connection -> SProtocolType p -> UTCTime -> UserServer p -> IO ()
updateProtocolServer db p ts UserServer {serverId, server, preset, tested, enabled} =
  DB.execute
    db
    [sql|
      UPDATE protocol_servers
      SET protocol = ?, host = ?, port = ?, key_hash = ?, basic_auth = ?,
          preset = ?, tested = ?, enabled = ?, updated_at = ?
      WHERE smp_server_id = ?
    |]
    (serverColumns p server :. (BI preset, BI <$> tested, BI enabled, ts, serverId))

serverColumns :: ProtocolTypeI p => SProtocolType p -> ProtoServerWithAuth p -> (Text, NonEmpty TransportHost, String, C.KeyHash, Maybe Text)
serverColumns p (ProtoServerWithAuth ProtocolServer {host, port, keyHash} auth_) =
  let protocol = decodeLatin1 $ strEncode p
      auth = safeDecodeUtf8 . unBasicAuth <$> auth_
   in (protocol, host, port, keyHash, auth)

getChatRelays :: DB.Connection -> User -> IO [UserChatRelay]
getChatRelays db User {userId} =
  map toChatRelay
    <$> DB.query
      db
      [sql|
        SELECT chat_relay_id, address, display_name, full_name, short_descr, image, domains, preset, tested, enabled
        FROM chat_relays
        WHERE user_id = ? AND deleted = 0
      |]
      (Only userId)

toChatRelay :: (DBEntityId, ShortLinkContact, Text, Text, Maybe Text, Maybe ImageData, Text, BoolInt, Maybe BoolInt, BoolInt) -> UserChatRelay
toChatRelay (chatRelayId, address, displayName, fullName, shortDescr, image, domains, BI preset, tested, BI enabled) =
  UserChatRelay {chatRelayId, address, relayProfile = toRelayProfile (displayName, fullName, shortDescr, image), domains = T.splitOn "," domains, preset, tested = unBI <$> tested, enabled, deleted = False}

getChatRelayById :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO UserChatRelay
getChatRelayById db User {userId} relayId =
  ExceptT . firstRow toChatRelay (SEUserChatRelayNotFound relayId) $
    DB.query
      db
      [sql|
        SELECT chat_relay_id, address, display_name, full_name, short_descr, image, domains, preset, tested, enabled
        FROM chat_relays
        WHERE user_id = ? AND chat_relay_id = ? AND deleted = 0
      |]
      (userId, relayId)

insertChatRelay :: DB.Connection -> User -> UTCTime -> NewUserChatRelay -> IO UserChatRelay
insertChatRelay db User {userId} ts relay@UserChatRelay {address, relayProfile = RelayProfile {displayName, fullName, shortDescr, image}, domains, preset, tested, enabled} = do
  crId <-
    fromOnly . head
      <$> DB.query
        db
        [sql|
          INSERT INTO chat_relays
            (address, display_name, full_name, short_descr, image, domains, preset, tested, enabled, user_id, created_at, updated_at)
          VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
          RETURNING chat_relay_id
        |]
        ((address, displayName, fullName, shortDescr, image, T.intercalate "," domains, BI preset, BI <$> tested, BI enabled, userId) :. (ts, ts))
  pure (relay :: NewUserChatRelay) {chatRelayId = DBEntityId crId}

updateChatRelay :: DB.Connection -> UTCTime -> UserChatRelay -> IO ()
updateChatRelay db ts UserChatRelay {chatRelayId, address, relayProfile = RelayProfile {displayName, fullName, shortDescr, image}, domains, preset, tested, enabled} =
  DB.execute
    db
    [sql|
      UPDATE chat_relays
      SET address = ?, display_name = ?, full_name = ?, short_descr = ?, image = ?, domains = ?,
          preset = ?, tested = ?, enabled = ?, updated_at = ?
      WHERE chat_relay_id = ?
    |]
    ((address, displayName, fullName, shortDescr, image, T.intercalate "," domains, BI preset, BI <$> tested, BI enabled, ts) :. Only chatRelayId)

getServerOperators :: DB.Connection -> ExceptT StoreError IO ServerOperatorConditions
getServerOperators db = do
  currentConditions <- getCurrentUsageConditions db
  liftIO $ do
    now <- getCurrentTime
    latestAcceptedConds_ <- getLatestAcceptedConditions db
    let getConds op = (\ca -> op {conditionsAcceptance = ca}) <$> getOperatorConditions_ db op currentConditions latestAcceptedConds_ now
    ops <- mapM getConds =<< getServerOperators_ db
    let conditionsAction = usageConditionsAction ops currentConditions now
    pure ServerOperatorConditions {serverOperators = ops, currentConditions, conditionsAction}

getUserServers :: DB.Connection -> User -> ExceptT StoreError IO ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP], [UserChatRelay])
getUserServers db user =
  (,,,)
    <$> (map Just . serverOperators <$> getServerOperators db)
    <*> liftIO (getProtocolServers db SPSMP user)
    <*> liftIO (getProtocolServers db SPXFTP user)
    <*> liftIO (getChatRelays db user)

setServerOperators :: DB.Connection -> NonEmpty ServerOperator -> IO ()
setServerOperators db ops = do
  currentTs <- getCurrentTime
  mapM_ (updateServerOperator db currentTs) ops

updateServerOperator :: DB.Connection -> UTCTime -> ServerOperator -> IO ()
updateServerOperator db currentTs ServerOperator {operatorId, enabled, smpRoles, xftpRoles} =
  DB.execute
    db
    [sql|
      UPDATE server_operators
      SET enabled = ?, smp_role_storage = ?, smp_role_proxy = ?, smp_role_names = ?, xftp_role_storage = ?, xftp_role_proxy = ?, updated_at = ?
      WHERE server_operator_id = ?
    |]
    (BI enabled, BI (storage smpRoles), BI (proxy smpRoles), BI (names smpRoles), BI (storage xftpRoles), BI (proxy xftpRoles), currentTs, operatorId)

getUpdateServerOperators :: DB.Connection -> NonEmpty PresetOperator -> Bool -> IO [(Maybe PresetOperator, Maybe ServerOperator)]
getUpdateServerOperators db presetOps newUser = do
  conds <- map toUsageConditions <$> DB.query_ db usageCondsQuery
  now <- getCurrentTime
  let (currentConds, condsToAdd) = usageConditionsToAdd newUser now conds
  mapM_ insertConditions condsToAdd
  latestAcceptedConds_ <- getLatestAcceptedConditions db
  ops <- updatedServerOperators presetOps <$> getServerOperators_ db
  forM ops $ traverse $ mapM $ \(ASO _ op) ->
    -- traverse for tuple, mapM for Maybe
    case operatorId op of
      DBNewEntity -> insertOperator op
      DBEntityId _ -> do
        updateOperator op
        getOperatorConditions_ db op currentConds latestAcceptedConds_ now >>= \case
          CARequired (Just ts) | ts < now -> autoAcceptConditions op currentConds now
          ca -> pure op {conditionsAcceptance = ca}
  where
    insertConditions UsageConditions {conditionsId, conditionsCommit, notifiedAt, createdAt} =
      DB.execute
        db
        [sql|
          INSERT INTO usage_conditions
            (usage_conditions_id, conditions_commit, notified_at, created_at)
          VALUES (?,?,?,?)
        |]
        (conditionsId, conditionsCommit, notifiedAt, createdAt)
    updateOperator :: ServerOperator -> IO ()
    updateOperator ServerOperator {operatorId, tradeName, legalName, serverDomains, enabled, smpRoles, xftpRoles} =
      DB.execute
        db
        [sql|
          UPDATE server_operators
          SET trade_name = ?, legal_name = ?, server_domains = ?, enabled = ?, smp_role_storage = ?, smp_role_proxy = ?, smp_role_names = ?, xftp_role_storage = ?, xftp_role_proxy = ?
          WHERE server_operator_id = ?
        |]
        (tradeName, legalName, T.intercalate "," serverDomains, BI enabled, BI (storage smpRoles), BI (proxy smpRoles), BI (names smpRoles), BI (storage xftpRoles), BI (proxy xftpRoles), operatorId)
    insertOperator :: NewServerOperator -> IO ServerOperator
    insertOperator op@ServerOperator {operatorTag, tradeName, legalName, serverDomains, enabled, smpRoles, xftpRoles} = do
      DB.execute
        db
        [sql|
          INSERT INTO server_operators
            (server_operator_tag, trade_name, legal_name, server_domains, enabled, smp_role_storage, smp_role_proxy, smp_role_names, xftp_role_storage, xftp_role_proxy)
          VALUES (?,?,?,?,?,?,?,?,?,?)
        |]
        (operatorTag, tradeName, legalName, T.intercalate "," serverDomains, BI enabled, BI (storage smpRoles), BI (proxy smpRoles), BI (names smpRoles), BI (storage xftpRoles), BI (proxy xftpRoles))
      opId <- insertedRowId db
      pure op {operatorId = DBEntityId opId}
    autoAcceptConditions op UsageConditions {conditionsCommit} now =
      acceptConditions_ db op conditionsCommit now True
        $> op {conditionsAcceptance = CAAccepted (Just now) True}

serverOperatorQuery :: Query
serverOperatorQuery =
  [sql|
    SELECT server_operator_id, server_operator_tag, trade_name, legal_name,
      server_domains, enabled, smp_role_storage, smp_role_proxy, smp_role_names, xftp_role_storage, xftp_role_proxy
    FROM server_operators
  |]

getServerOperators_ :: DB.Connection -> IO [ServerOperator]
getServerOperators_ db = map toServerOperator <$> DB.query_ db serverOperatorQuery

toServerOperator :: (DBEntityId, Maybe OperatorTag, Text, Maybe Text, Text, BoolInt) :. (BoolInt, BoolInt, BoolInt) :. (BoolInt, BoolInt) -> ServerOperator
toServerOperator ((operatorId, operatorTag, tradeName, legalName, domains, BI enabled) :. smpRoles' :. xftpRoles') =
  ServerOperator
    { operatorId,
      operatorTag,
      tradeName,
      legalName,
      serverDomains = T.splitOn "," domains,
      conditionsAcceptance = CARequired Nothing,
      enabled,
      smpRoles = serverRolesSMP smpRoles',
      xftpRoles = serverRolesXFTP xftpRoles'
    }
  where
    serverRolesSMP (BI storage, BI proxy, BI names) = ServerRoles {storage, proxy, names}
    serverRolesXFTP (BI storage, BI proxy) = ServerRoles {storage, proxy, names = False}

getOperatorConditions_ :: DB.Connection -> ServerOperator -> UsageConditions -> Maybe UsageConditions -> UTCTime -> IO ConditionsAcceptance
getOperatorConditions_ db ServerOperator {operatorId} UsageConditions {conditionsCommit = currentCommit, createdAt, notifiedAt} latestAcceptedConds_ now = do
  case latestAcceptedConds_ of
    Nothing -> pure $ CARequired Nothing -- no conditions accepted by any operator
    Just UsageConditions {conditionsCommit = latestAcceptedCommit} -> do
      operatorAcceptedConds_ <-
        maybeFirstRow id $
          DB.query
            db
            [sql|
              SELECT conditions_commit, accepted_at, auto_accepted
              FROM operator_usage_conditions
              WHERE server_operator_id = ?
              ORDER BY operator_usage_conditions_id DESC
              LIMIT 1
            |]
            (Only operatorId)
      pure $ case operatorAcceptedConds_ of
        Just (operatorCommit, acceptedAt_, BI autoAccept)
          | operatorCommit /= latestAcceptedCommit -> CARequired Nothing -- TODO should we consider this operator disabled?
          | currentCommit /= latestAcceptedCommit -> CARequired $ conditionsRequiredOrDeadline createdAt (fromMaybe now notifiedAt)
          | otherwise -> CAAccepted acceptedAt_ autoAccept
        _ -> CARequired Nothing -- no conditions were accepted for this operator

getCurrentUsageConditions :: DB.Connection -> ExceptT StoreError IO UsageConditions
getCurrentUsageConditions db =
  ExceptT . firstRow toUsageConditions SEUsageConditionsNotFound $
    DB.query_ db (usageCondsQuery <> " DESC LIMIT 1")

usageCondsQuery :: Query
usageCondsQuery =
  [sql|
    SELECT usage_conditions_id, conditions_commit, notified_at, created_at
    FROM usage_conditions
    ORDER BY usage_conditions_id
  |]

toUsageConditions :: (Int64, Text, Maybe UTCTime, UTCTime) -> UsageConditions
toUsageConditions (conditionsId, conditionsCommit, notifiedAt, createdAt) =
  UsageConditions {conditionsId, conditionsCommit, notifiedAt, createdAt}

getLatestAcceptedConditions :: DB.Connection -> IO (Maybe UsageConditions)
getLatestAcceptedConditions db =
  maybeFirstRow toUsageConditions $
    DB.query_
      db
      [sql|
        SELECT usage_conditions_id, conditions_commit, notified_at, created_at
        FROM usage_conditions
        WHERE conditions_commit = (
          SELECT conditions_commit
          FROM operator_usage_conditions
          ORDER BY accepted_at DESC
          LIMIT 1
        )
      |]

setConditionsNotified :: DB.Connection -> Int64 -> UTCTime -> IO ()
setConditionsNotified db condId notifiedAt =
  DB.execute db "UPDATE usage_conditions SET notified_at = ? WHERE usage_conditions_id = ?" (notifiedAt, condId)

acceptConditions :: DB.Connection -> Int64 -> NonEmpty Int64 -> UTCTime -> ExceptT StoreError IO ()
acceptConditions db condId opIds acceptedAt = do
  UsageConditions {conditionsCommit} <- getUsageConditionsById_ db condId
  operators <- mapM getServerOperator_ opIds
  liftIO $ forM_ operators $ \op -> acceptConditions_ db op conditionsCommit acceptedAt False
  where
    getServerOperator_ opId =
      ExceptT $
        firstRow toServerOperator (SEOperatorNotFound opId) $
          DB.query db (serverOperatorQuery <> " WHERE server_operator_id = ?") (Only opId)

acceptConditions_ :: DB.Connection -> ServerOperator -> Text -> UTCTime -> Bool -> IO ()
acceptConditions_ db ServerOperator {operatorId, operatorTag} conditionsCommit acceptedAt autoAccepted = do
  acceptedAt_ :: Maybe (Maybe UTCTime) <- maybeFirstRow fromOnly $ DB.query db "SELECT accepted_at FROM operator_usage_conditions WHERE server_operator_id = ? AND conditions_commit = ?" (operatorId, conditionsCommit)
  case acceptedAt_ of
    Just Nothing ->
      DB.execute
        db
        (q <> "ON CONFLICT (server_operator_id, conditions_commit) DO UPDATE SET accepted_at = ?, auto_accepted = ?")
        (operatorId, operatorTag, conditionsCommit, acceptedAt, BI autoAccepted, acceptedAt, BI autoAccepted)
    Just (Just _) ->
      DB.execute
        db
        (q <> "ON CONFLICT (server_operator_id, conditions_commit) DO NOTHING")
        (operatorId, operatorTag, conditionsCommit, acceptedAt, BI autoAccepted)
    Nothing ->
      DB.execute
        db
        q
        (operatorId, operatorTag, conditionsCommit, acceptedAt, BI autoAccepted)
  where
    q =
      [sql|
        INSERT INTO operator_usage_conditions
          (server_operator_id, server_operator_tag, conditions_commit, accepted_at, auto_accepted)
        VALUES (?,?,?,?,?)
      |]

getUsageConditionsById_ :: DB.Connection -> Int64 -> ExceptT StoreError IO UsageConditions
getUsageConditionsById_ db conditionsId =
  ExceptT . firstRow toUsageConditions SEUsageConditionsNotFound $
    DB.query
      db
      [sql|
        SELECT usage_conditions_id, conditions_commit, notified_at, created_at
        FROM usage_conditions
        WHERE usage_conditions_id = ?
      |]
      (Only conditionsId)

setUserServers :: DB.Connection -> User -> UTCTime -> UpdatedUserOperatorServers -> ExceptT StoreError IO UserOperatorServers
setUserServers db user ts = checkConstraint SEUniqueID . liftIO . setUserServers' db user ts

setUserServers' :: DB.Connection -> User -> UTCTime -> UpdatedUserOperatorServers -> IO UserOperatorServers
setUserServers' db user@User {userId} ts UpdatedUserOperatorServers {operator, smpServers, xftpServers, chatRelays} = do
  mapM_ (updateServerOperator db ts) operator
  smpSrvs' <- catMaybes <$> mapM (upsertOrDeleteSrv SPSMP) smpServers
  xftpSrvs' <- catMaybes <$> mapM (upsertOrDeleteSrv SPXFTP) xftpServers
  cRelays' <- catMaybes <$> mapM upsertOrDeleteCRelay chatRelays
  pure UserOperatorServers {operator, smpServers = smpSrvs', xftpServers = xftpSrvs', chatRelays = cRelays'}
  where
    upsertOrDeleteSrv :: ProtocolTypeI p => SProtocolType p -> AUserServer p -> IO (Maybe (UserServer p))
    upsertOrDeleteSrv p (AUS _ s@UserServer {serverId, deleted}) = case serverId of
      DBNewEntity
        | deleted -> pure Nothing
        | otherwise -> Just <$> insertProtocolServer db p user ts s
      DBEntityId srvId
        | deleted -> Nothing <$ DB.execute db "DELETE FROM protocol_servers WHERE user_id = ? AND smp_server_id = ? AND preset = ?" (userId, srvId, BI False)
        | otherwise -> Just s <$ updateProtocolServer db p ts s
    upsertOrDeleteCRelay :: AUserChatRelay -> IO (Maybe UserChatRelay)
    upsertOrDeleteCRelay (AUCR _ relay@UserChatRelay {chatRelayId, address, deleted}) = case chatRelayId of
      DBNewEntity
        | deleted -> pure Nothing
        | otherwise -> do
            -- When a relay referenced in group_relays is deleted, it's soft-deleted (deleted=1).
            -- On re-add with the same address, un-delete the existing row to preserve group_relays FK.
            -- Only address is matched — it's the relay's identity. Name and other settings are updated.
            -- Re-adding with same name but different address is a different relay and will fail on UNIQUE constraint.
            existing <- maybeFirstRow fromOnly $ DB.query db
              "SELECT chat_relay_id FROM chat_relays WHERE user_id = ? AND address = ? AND deleted = 1 LIMIT 1"
              (userId, address)
            case existing of
              Just existingId -> do
                undeleteRelay existingId relay
                pure $ Just (relay :: NewUserChatRelay) {chatRelayId = DBEntityId existingId}
              Nothing -> Just <$> insertChatRelay db user ts relay
      DBEntityId relayId
        | deleted -> do
            -- If relay is referenced in group_relays, mark it as deleted instead of deleting
            referenced <- fromOnly . head <$> DB.query db "SELECT EXISTS (SELECT 1 FROM group_relays WHERE chat_relay_id = ?)" (Only relayId)
            if referenced
              then DB.execute db "UPDATE chat_relays SET deleted = 1, updated_at = ? WHERE chat_relay_id = ?" (ts, relayId)
              else DB.execute db "DELETE FROM chat_relays WHERE user_id = ? AND chat_relay_id = ? AND preset = ?" (userId, relayId, BI False)
            pure Nothing
        | otherwise -> Just relay <$ updateChatRelay db ts relay
    -- Un-delete soft-deleted relay, updating name and settings but keeping the address unchanged.
    undeleteRelay :: Int64 -> NewUserChatRelay -> IO ()
    undeleteRelay existingId UserChatRelay {relayProfile = RelayProfile {displayName, fullName, shortDescr, image}, domains, preset, tested, enabled} =
      DB.execute db
        [sql|
          UPDATE chat_relays
          SET display_name = ?, full_name = ?, short_descr = ?, image = ?, domains = ?,
              preset = ?, tested = ?, enabled = ?, deleted = 0, updated_at = ?
          WHERE chat_relay_id = ?
        |]
        (displayName, fullName, shortDescr, image, T.intercalate "," domains, BI preset, BI <$> tested, BI enabled, ts, existingId)

createCall :: DB.Connection -> User -> Call -> UTCTime -> IO ()
createCall db user@User {userId} Call {contactId, callId, callUUID, chatItemId, callState} callTs = do
  currentTs <- getCurrentTime
  deleteCalls db user contactId
  DB.execute
    db
    [sql|
      INSERT INTO calls
        (contact_id, shared_call_id, call_uuid, chat_item_id, call_state, call_ts, user_id, created_at, updated_at)
      VALUES (?,?,?,?,?,?,?,?,?)
    |]
    (contactId, callId, callUUID, chatItemId, callState, callTs, userId, currentTs, currentTs)

deleteCalls :: DB.Connection -> User -> ContactId -> IO ()
deleteCalls db User {userId} contactId = do
  DB.execute db "DELETE FROM calls WHERE user_id = ? AND contact_id = ?" (userId, contactId)

getCalls :: DB.Connection -> IO [Call]
getCalls db =
  map toCall
    <$> DB.query_
      db
      [sql|
        SELECT
          contact_id, shared_call_id, call_uuid, chat_item_id, call_state, call_ts
        FROM calls
        ORDER BY call_ts ASC
      |]
  where
    toCall :: (ContactId, CallId, Text, ChatItemId, CallState, UTCTime) -> Call
    toCall (contactId, callId, callUUID, chatItemId, callState, callTs) = Call {contactId, callId, callUUID, chatItemId, callState, callTs}

createCommand :: DB.Connection -> User -> Maybe Int64 -> CommandFunction -> IO CommandId
createCommand db User {userId} connId commandFunction = do
  currentTs <- getCurrentTime
  DB.execute
    db
    [sql|
      INSERT INTO commands (connection_id, command_function, command_status, user_id, created_at, updated_at)
      VALUES (?,?,?,?,?,?)
    |]
    (connId, commandFunction, CSCreated, userId, currentTs, currentTs)
  insertedRowId db

deleteCommand :: DB.Connection -> User -> CommandId -> IO ()
deleteCommand db User {userId} cmdId =
  DB.execute db "DELETE FROM commands WHERE user_id = ? AND command_id = ?" (userId, cmdId)

updateCommandStatus :: DB.Connection -> User -> CommandId -> CommandStatus -> IO ()
updateCommandStatus db User {userId} cmdId status = do
  updatedAt <- getCurrentTime
  DB.execute
    db
    [sql|
      UPDATE commands
      SET command_status = ?, updated_at = ?
      WHERE user_id = ? AND command_id = ?
    |]
    (status, updatedAt, userId, cmdId)

getCommandDataByCorrId :: DB.Connection -> User -> ACorrId -> IO (Maybe CommandData)
getCommandDataByCorrId db User {userId} corrId =
  maybeFirstRow toCommandData $
    DB.query
      db
      [sql|
        SELECT command_id, connection_id, command_function, command_status
        FROM commands
        WHERE user_id = ? AND command_id = ?
      |]
      (userId, commandId corrId)
  where
    toCommandData :: (CommandId, Maybe Int64, CommandFunction, CommandStatus) -> CommandData
    toCommandData (cmdId, cmdConnId, cmdFunction, cmdStatus) = CommandData {cmdId, cmdConnId, cmdFunction, cmdStatus}

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