{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}

module Simplex.Chat.Store.Messages
  ( getContactConnIds_,

    -- * Message and chat item functions
    deleteContactCIs,
    getGroupFileInfo,
    getGroupMemberFileInfo,
    deleteGroupChatItemsMessages,
    createNewSndMessage,
    createSndMsgDelivery,
    createNewMessageAndRcvMsgDelivery,
    getLastRcvMsgInfo,
    createNewRcvMessage,
    updateSndMsgDeliveryStatus,
    createPendingGroupMessage,
    getPendingGroupMessages,
    deletePendingGroupMessage,
    deleteOldMessages,
    MemberAttention (..),
    updateChatTsStats,
    setSupportChatTs,
    setSupportChatMemberAttention,
    createNewSndChatItem,
    createNewRcvChatItem,
    createNewChatItemNoMsg,
    createNewChatItem_,
    getChatPreviews,
    checkContactHasItems,
    getDirectChat,
    getGroupChat,
    getGroupChatScopeInfoForItem,
    getLocalChat,
    getDirectChatItemLast,
    getAllChatItems,
    getAChatItem,
    getAChatItemBySharedMsgId,
    updateDirectChatItem,
    updateDirectChatItem',
    addInitialAndNewCIVersions,
    createChatItemVersion,
    deleteDirectChatItem,
    markDirectChatItemDeleted,
    updateGroupChatItemStatus,
    updateGroupChatItem,
    createGroupCIMentions,
    updateGroupCIMentions,
    deleteGroupChatItem,
    updateGroupChatItemModerated,
    updateMemberCIsModerated,
    updateGroupCIBlockedByAdmin,
    markGroupChatItemDeleted,
    markMemberCIsDeleted,
    markGroupChatItemBlocked,
    markGroupCIBlockedByAdmin,
    markMessageReportsDeleted,
    markReceivedGroupReportsDeleted,
    deleteLocalChatItem,
    updateDirectChatItemsRead,
    getDirectUnreadTimedItems,
    updateDirectChatItemsReadList,
    setDirectChatItemRead,
    setDirectChatItemsDeleteAt,
    updateGroupChatItemsRead,
    updateSupportChatItemsRead,
    getGroupUnreadTimedItems,
    updateGroupChatItemsReadList,
    updateGroupScopeUnreadStats,
    setGroupChatItemsDeleteAt,
    updateLocalChatItemsRead,
    getChatRefViaItemId,
    getChatItemVersions,
    getDirectCIReactions,
    getDirectReactions,
    setDirectReaction,
    getGroupCIReactions,
    getGroupReactions,
    setGroupReaction,
    getReactionMembers,
    getChatItemIdsByAgentMsgId,
    getDirectChatItem,
    getDirectCIWithReactions,
    getDirectChatItemBySharedMsgId,
    getDirectChatItemsByAgentMsgId,
    getGroupChatItem,
    getGroupCIWithReactions,
    getGroupChatItemBySharedMsgId,
    getGroupMemberCIBySharedMsgId,
    getGroupChatItemsByAgentMsgId,
    getGroupMemberChatItemLast,
    getLocalChatItem,
    updateLocalChatItem',
    getDirectChatItemIdByText,
    getDirectChatItemIdByText',
    getGroupChatItemIdByText,
    getGroupChatItemIdByText',
    getLocalChatItemIdByText,
    getLocalChatItemIdByText',
    getChatItemByFileId,
    lookupChatItemByFileId,
    getChatItemByGroupId,
    updateDirectChatItemStatus,
    setDirectSndChatItemViaProxy,
    getTimedItems,
    getChatItemTTL,
    setChatItemTTL,
    getChatTTLCount,
    getContactExpiredFileInfo,
    deleteContactExpiredCIs,
    getGroupExpiredFileInfo,
    deleteGroupExpiredCIs,
    createCIModeration,
    getCIModeration,
    deleteCIModeration,
    createGroupSndStatus,
    getGroupSndStatus,
    updateGroupSndStatus,
    setGroupSndViaProxy,
    getGroupSndStatuses,
    getGroupSndStatusCounts,
    getGroupHistoryItems,
  )
where

import qualified Control.Exception as E
import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class
import Crypto.Random (ChaChaDRG)
import Data.Bifunctor (first)
import Data.ByteString.Char8 (ByteString)
import Data.Char (toLower)
import Data.Either (fromRight, rights)
import Data.Int (Int64)
import Data.List (foldl', sortBy)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as L
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe)
import Data.Ord (Down (..), comparing)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time (addUTCTime)
import Data.Time.Clock (UTCTime (..), getCurrentTime)
import Simplex.Chat.Controller (ChatListQuery (..), ChatPagination (..), PaginationByTime (..))
import Simplex.Chat.Markdown
import Simplex.Chat.Messages
import Simplex.Chat.Messages.CIContent
import Simplex.Chat.Protocol
import Simplex.Chat.Store.Direct
import Simplex.Chat.Store.Groups
import Simplex.Chat.Store.NoteFolders
import Simplex.Chat.Store.Shared
import Simplex.Chat.Types
import Simplex.Chat.Types.Shared
import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, MsgMeta (..), UserId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, 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 Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
import Simplex.Messaging.Util (eitherToMaybe)
import UnliftIO.STM
#if defined(dbPostgres)
import Database.PostgreSQL.Simple (FromRow, In (..), Only (..), Query, ToRow, (:.) (..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
#else
import Database.SQLite.Simple (FromRow, Only (..), Query, ToRow, (:.) (..))
import Database.SQLite.Simple.QQ (sql)
#endif

deleteContactCIs :: DB.Connection -> User -> Contact -> IO ()
deleteContactCIs :: Connection -> User -> Contact -> IO ()
deleteContactCIs Connection
db user :: User
user@User {ChatItemId
userId :: ChatItemId
userId :: User -> ChatItemId
userId} ct :: Contact
ct@Contact {ChatItemId
contactId :: ChatItemId
contactId :: Contact -> ChatItemId
contactId} = do
  [ChatItemId]
connIds <- Connection -> User -> Contact -> IO [ChatItemId]
getContactConnIds_ Connection
db User
user Contact
ct
  [ChatItemId] -> (ChatItemId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ChatItemId]
connIds ((ChatItemId -> IO ()) -> IO ()) -> (ChatItemId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ChatItemId
connId ->
    Connection -> Query -> Only ChatItemId -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM messages WHERE connection_id = ?" (ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
connId)
  Connection -> Query -> Only ChatItemId -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM chat_item_reactions WHERE contact_id = ?" (ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
contactId)
  Connection -> Query -> (ChatItemId, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM chat_items WHERE user_id = ? AND contact_id = ? AND item_content_tag != 'chatBanner'" (ChatItemId
userId, ChatItemId
contactId)

getContactConnIds_ :: DB.Connection -> User -> Contact -> IO [Int64]
getContactConnIds_ :: Connection -> User -> Contact -> IO [ChatItemId]
getContactConnIds_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} =
  (Only ChatItemId -> ChatItemId)
-> [Only ChatItemId] -> [ChatItemId]
forall a b. (a -> b) -> [a] -> [b]
map Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly
    ([Only ChatItemId] -> [ChatItemId])
-> IO [Only ChatItemId] -> IO [ChatItemId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query -> (ChatItemId, ChatItemId) -> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT connection_id FROM connections WHERE user_id = ? AND contact_id = ?" (ChatItemId
userId, ChatItemId
contactId)

getGroupFileInfo :: DB.Connection -> User -> GroupInfo -> IO [CIFileInfo]
getGroupFileInfo :: Connection -> User -> GroupInfo -> IO [CIFileInfo]
getGroupFileInfo Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} GroupInfo {ChatItemId
groupId :: ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId} =
  ((ChatItemId, Maybe ACIFileStatus, Maybe FilePath) -> CIFileInfo)
-> [(ChatItemId, Maybe ACIFileStatus, Maybe FilePath)]
-> [CIFileInfo]
forall a b. (a -> b) -> [a] -> [b]
map (ChatItemId, Maybe ACIFileStatus, Maybe FilePath) -> CIFileInfo
toFileInfo
    ([(ChatItemId, Maybe ACIFileStatus, Maybe FilePath)]
 -> [CIFileInfo])
-> IO [(ChatItemId, Maybe ACIFileStatus, Maybe FilePath)]
-> IO [CIFileInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (ChatItemId, ChatItemId)
-> IO [(ChatItemId, Maybe ACIFileStatus, Maybe FilePath)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
fileInfoQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE i.user_id = ? AND i.group_id = ?") (ChatItemId
userId, ChatItemId
groupId)

getGroupMemberFileInfo :: DB.Connection -> User -> GroupInfo -> GroupMember -> IO [CIFileInfo]
getGroupMemberFileInfo :: Connection -> User -> GroupInfo -> GroupMember -> IO [CIFileInfo]
getGroupMemberFileInfo Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} GroupMember {ChatItemId
groupMemberId :: ChatItemId
groupMemberId :: GroupMember -> ChatItemId
groupMemberId} =
  ((ChatItemId, Maybe ACIFileStatus, Maybe FilePath) -> CIFileInfo)
-> [(ChatItemId, Maybe ACIFileStatus, Maybe FilePath)]
-> [CIFileInfo]
forall a b. (a -> b) -> [a] -> [b]
map (ChatItemId, Maybe ACIFileStatus, Maybe FilePath) -> CIFileInfo
toFileInfo
    ([(ChatItemId, Maybe ACIFileStatus, Maybe FilePath)]
 -> [CIFileInfo])
-> IO [(ChatItemId, Maybe ACIFileStatus, Maybe FilePath)]
-> IO [CIFileInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (ChatItemId, ChatItemId, ChatItemId)
-> IO [(ChatItemId, Maybe ACIFileStatus, Maybe FilePath)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
fileInfoQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE i.user_id = ? AND i.group_id = ? AND i.group_member_id = ?") (ChatItemId
userId, ChatItemId
groupId, ChatItemId
groupMemberId)

deleteGroupChatItemsMessages :: DB.Connection -> User -> GroupInfo -> IO ()
deleteGroupChatItemsMessages :: Connection -> User -> GroupInfo -> IO ()
deleteGroupChatItemsMessages Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} = do
  Connection -> Query -> Only ChatItemId -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM messages WHERE group_id = ?" (ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
groupId)
  Connection -> Query -> Only ChatItemId -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM chat_item_reactions WHERE group_id = ?" (ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
groupId)
  Connection -> Query -> (ChatItemId, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM chat_items WHERE user_id = ? AND group_id = ? AND item_content_tag != 'chatBanner'" (ChatItemId
userId, ChatItemId
groupId)

createNewSndMessage :: MsgEncodingI e => DB.Connection -> TVar ChaChaDRG -> ConnOrGroupId -> ChatMsgEvent e -> (SharedMsgId -> EncodedChatMessage) -> ExceptT StoreError IO SndMessage
createNewSndMessage :: forall (e :: MsgEncoding).
MsgEncodingI e =>
Connection
-> TVar ChaChaDRG
-> ConnOrGroupId
-> ChatMsgEvent e
-> (SharedMsgId -> EncodedChatMessage)
-> ExceptT StoreError IO SndMessage
createNewSndMessage Connection
db TVar ChaChaDRG
gVar ConnOrGroupId
connOrGroupId ChatMsgEvent e
chatMsgEvent SharedMsgId -> EncodedChatMessage
encodeMessage =
  TVar ChaChaDRG
-> (ConnId -> IO (Either StoreError SndMessage))
-> ExceptT StoreError IO SndMessage
forall a.
TVar ChaChaDRG
-> (ConnId -> IO (Either StoreError a)) -> ExceptT StoreError IO a
createWithRandomId' TVar ChaChaDRG
gVar ((ConnId -> IO (Either StoreError SndMessage))
 -> ExceptT StoreError IO SndMessage)
-> (ConnId -> IO (Either StoreError SndMessage))
-> ExceptT StoreError IO SndMessage
forall a b. (a -> b) -> a -> b
$ \ConnId
sharedMsgId ->
    case SharedMsgId -> EncodedChatMessage
encodeMessage (ConnId -> SharedMsgId
SharedMsgId ConnId
sharedMsgId) of
      EncodedChatMessage
ECMLarge -> Either StoreError SndMessage -> IO (Either StoreError SndMessage)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError SndMessage -> IO (Either StoreError SndMessage))
-> Either StoreError SndMessage
-> IO (Either StoreError SndMessage)
forall a b. (a -> b) -> a -> b
$ StoreError -> Either StoreError SndMessage
forall a b. a -> Either a b
Left StoreError
SELargeMsg
      ECMEncoded ConnId
msgBody -> do
        UTCTime
createdAt <- IO UTCTime
getCurrentTime
        Connection
-> Query
-> (MsgDirection, CMEventTag e, Binary ConnId, Maybe ChatItemId,
    Maybe ChatItemId, Binary ConnId, Maybe BoolInt, UTCTime, UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
          Connection
db
          [sql|
            INSERT INTO messages (
              msg_sent, chat_msg_event, msg_body, connection_id, group_id,
              shared_msg_id, shared_msg_id_user, created_at, updated_at
            ) VALUES (?,?,?,?,?,?,?,?,?)
          |]
          (MsgDirection
MDSnd, ChatMsgEvent e -> CMEventTag e
forall (e :: MsgEncoding). ChatMsgEvent e -> CMEventTag e
toCMEventTag ChatMsgEvent e
chatMsgEvent, ConnId -> Binary ConnId
forall a. a -> Binary a
DB.Binary ConnId
msgBody, Maybe ChatItemId
connId_, Maybe ChatItemId
groupId_, ConnId -> Binary ConnId
forall a. a -> Binary a
DB.Binary ConnId
sharedMsgId, BoolInt -> Maybe BoolInt
forall a. a -> Maybe a
Just (Bool -> BoolInt
BI Bool
True), UTCTime
createdAt, UTCTime
createdAt)
        ChatItemId
msgId <- Connection -> IO ChatItemId
insertedRowId Connection
db
        Either StoreError SndMessage -> IO (Either StoreError SndMessage)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreError SndMessage -> IO (Either StoreError SndMessage))
-> Either StoreError SndMessage
-> IO (Either StoreError SndMessage)
forall a b. (a -> b) -> a -> b
$ SndMessage -> Either StoreError SndMessage
forall a b. b -> Either a b
Right SndMessage {ChatItemId
msgId :: ChatItemId
msgId :: ChatItemId
msgId, sharedMsgId :: SharedMsgId
sharedMsgId = ConnId -> SharedMsgId
SharedMsgId ConnId
sharedMsgId, ConnId
msgBody :: ConnId
msgBody :: ConnId
msgBody}
  where
    (Maybe ChatItemId
connId_, Maybe ChatItemId
groupId_) = case ConnOrGroupId
connOrGroupId of
      ConnectionId ChatItemId
connId -> (ChatItemId -> Maybe ChatItemId
forall a. a -> Maybe a
Just ChatItemId
connId, Maybe ChatItemId
forall a. Maybe a
Nothing)
      GroupId ChatItemId
groupId -> (Maybe ChatItemId
forall a. Maybe a
Nothing, ChatItemId -> Maybe ChatItemId
forall a. a -> Maybe a
Just ChatItemId
groupId)

createSndMsgDelivery :: DB.Connection -> SndMsgDelivery -> MessageId -> IO Int64
createSndMsgDelivery :: Connection -> SndMsgDelivery -> ChatItemId -> IO ChatItemId
createSndMsgDelivery Connection
db SndMsgDelivery {ChatItemId
connId :: ChatItemId
connId :: SndMsgDelivery -> ChatItemId
connId, ChatItemId
agentMsgId :: ChatItemId
agentMsgId :: SndMsgDelivery -> ChatItemId
agentMsgId} ChatItemId
messageId = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection
-> Query
-> (ChatItemId, ChatItemId, ChatItemId, UTCTime, UTCTime, UTCTime,
    MsgDeliveryStatus 'MDSnd)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      INSERT INTO msg_deliveries
        (message_id, connection_id, agent_msg_id, chat_ts, created_at, updated_at, delivery_status)
      VALUES (?,?,?,?,?,?,?)
    |]
    (ChatItemId
messageId, ChatItemId
connId, ChatItemId
agentMsgId, UTCTime
currentTs, UTCTime
currentTs, UTCTime
currentTs, MsgDeliveryStatus 'MDSnd
MDSSndAgent)
  Connection -> IO ChatItemId
insertedRowId Connection
db

createNewMessageAndRcvMsgDelivery :: forall e. MsgEncodingI e => DB.Connection -> ConnOrGroupId -> NewRcvMessage e -> Maybe SharedMsgId -> RcvMsgDelivery -> Maybe GroupMemberId -> ExceptT StoreError IO RcvMessage
createNewMessageAndRcvMsgDelivery :: forall (e :: MsgEncoding).
MsgEncodingI e =>
Connection
-> ConnOrGroupId
-> NewRcvMessage e
-> Maybe SharedMsgId
-> RcvMsgDelivery
-> Maybe ChatItemId
-> ExceptT StoreError IO RcvMessage
createNewMessageAndRcvMsgDelivery Connection
db ConnOrGroupId
connOrGroupId NewRcvMessage e
newMessage Maybe SharedMsgId
sharedMsgId_ RcvMsgDelivery {ChatItemId
connId :: ChatItemId
connId :: RcvMsgDelivery -> ChatItemId
connId, ChatItemId
agentMsgId :: ChatItemId
agentMsgId :: RcvMsgDelivery -> ChatItemId
agentMsgId, MsgMeta
agentMsgMeta :: MsgMeta
agentMsgMeta :: RcvMsgDelivery -> MsgMeta
agentMsgMeta} Maybe ChatItemId
authorGroupMemberId_ = do
  msg :: RcvMessage
msg@RcvMessage {ChatItemId
msgId :: ChatItemId
msgId :: RcvMessage -> ChatItemId
msgId} <- Connection
-> ConnOrGroupId
-> NewRcvMessage e
-> Maybe SharedMsgId
-> Maybe ChatItemId
-> Maybe ChatItemId
-> ExceptT StoreError IO RcvMessage
forall (e :: MsgEncoding).
MsgEncodingI e =>
Connection
-> ConnOrGroupId
-> NewRcvMessage e
-> Maybe SharedMsgId
-> Maybe ChatItemId
-> Maybe ChatItemId
-> ExceptT StoreError IO RcvMessage
createNewRcvMessage Connection
db ConnOrGroupId
connOrGroupId NewRcvMessage e
newMessage Maybe SharedMsgId
sharedMsgId_ Maybe ChatItemId
authorGroupMemberId_ Maybe ChatItemId
forall a. Maybe a
Nothing
  IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ do
    UTCTime
currentTs <- IO UTCTime
getCurrentTime
    Connection
-> Query
-> (ChatItemId, ChatItemId, ChatItemId, MemberName, UTCTime,
    UTCTime, UTCTime, MsgDeliveryStatus 'MDRcv)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      [sql|
        INSERT INTO msg_deliveries
          (message_id, connection_id, agent_msg_id, agent_msg_meta, chat_ts, created_at, updated_at, delivery_status)
        VALUES (?,?,?,?,?,?,?,?)
      |]
      (ChatItemId
msgId, ChatItemId
connId, ChatItemId
agentMsgId, MsgMeta -> MemberName
msgMetaJson MsgMeta
agentMsgMeta, (ConnId, UTCTime) -> UTCTime
forall a b. (a, b) -> b
snd ((ConnId, UTCTime) -> UTCTime) -> (ConnId, UTCTime) -> UTCTime
forall a b. (a -> b) -> a -> b
$ MsgMeta -> (ConnId, UTCTime)
broker MsgMeta
agentMsgMeta, UTCTime
currentTs, UTCTime
currentTs, MsgDeliveryStatus 'MDRcv
MDSRcvAgent)
  RcvMessage -> ExceptT StoreError IO RcvMessage
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RcvMessage
msg

getLastRcvMsgInfo :: DB.Connection -> Int64 -> IO (Maybe RcvMsgInfo)
getLastRcvMsgInfo :: Connection -> ChatItemId -> IO (Maybe RcvMsgInfo)
getLastRcvMsgInfo Connection
db ChatItemId
connId =
  ((ChatItemId, ChatItemId, MemberName, ChatItemId, MemberName)
 -> RcvMsgInfo)
-> IO
     [(ChatItemId, ChatItemId, MemberName, ChatItemId, MemberName)]
-> IO (Maybe RcvMsgInfo)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow (ChatItemId, ChatItemId, MemberName, ChatItemId, MemberName)
-> RcvMsgInfo
rcvMsgInfo (IO [(ChatItemId, ChatItemId, MemberName, ChatItemId, MemberName)]
 -> IO (Maybe RcvMsgInfo))
-> IO
     [(ChatItemId, ChatItemId, MemberName, ChatItemId, MemberName)]
-> IO (Maybe RcvMsgInfo)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (ChatItemId, MsgDeliveryStatus 'MDRcv, MsgDeliveryStatus 'MDRcv)
-> IO
     [(ChatItemId, ChatItemId, MemberName, ChatItemId, MemberName)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT message_id, msg_delivery_id, delivery_status, agent_msg_id, agent_msg_meta
        FROM msg_deliveries
        WHERE connection_id = ? AND delivery_status IN (?, ?)
        ORDER BY created_at DESC, msg_delivery_id DESC
        LIMIT 1
      |]
      (ChatItemId
connId, MsgDeliveryStatus 'MDRcv
MDSRcvAgent, MsgDeliveryStatus 'MDRcv
MDSRcvAcknowledged)
  where
    rcvMsgInfo :: (ChatItemId, ChatItemId, MemberName, ChatItemId, MemberName)
-> RcvMsgInfo
rcvMsgInfo (ChatItemId
msgId, ChatItemId
msgDeliveryId, MemberName
msgDeliveryStatus, ChatItemId
agentMsgId, MemberName
agentMsgMeta) =
      RcvMsgInfo {ChatItemId
msgId :: ChatItemId
msgId :: ChatItemId
msgId, ChatItemId
msgDeliveryId :: ChatItemId
msgDeliveryId :: ChatItemId
msgDeliveryId, MemberName
msgDeliveryStatus :: MemberName
msgDeliveryStatus :: MemberName
msgDeliveryStatus, ChatItemId
agentMsgId :: ChatItemId
agentMsgId :: ChatItemId
agentMsgId, MemberName
agentMsgMeta :: MemberName
agentMsgMeta :: MemberName
agentMsgMeta}

createNewRcvMessage :: forall e. MsgEncodingI e => DB.Connection -> ConnOrGroupId -> NewRcvMessage e -> Maybe SharedMsgId -> Maybe GroupMemberId -> Maybe GroupMemberId -> ExceptT StoreError IO RcvMessage
createNewRcvMessage :: forall (e :: MsgEncoding).
MsgEncodingI e =>
Connection
-> ConnOrGroupId
-> NewRcvMessage e
-> Maybe SharedMsgId
-> Maybe ChatItemId
-> Maybe ChatItemId
-> ExceptT StoreError IO RcvMessage
createNewRcvMessage Connection
db ConnOrGroupId
connOrGroupId NewRcvMessage {ChatMsgEvent e
chatMsgEvent :: ChatMsgEvent e
chatMsgEvent :: forall (e :: MsgEncoding). NewRcvMessage e -> ChatMsgEvent e
chatMsgEvent, ConnId
msgBody :: ConnId
msgBody :: forall (e :: MsgEncoding). NewRcvMessage e -> ConnId
msgBody, UTCTime
brokerTs :: UTCTime
brokerTs :: forall (e :: MsgEncoding). NewRcvMessage e -> UTCTime
brokerTs} Maybe SharedMsgId
sharedMsgId_ Maybe ChatItemId
authorMember Maybe ChatItemId
forwardedByMember =
  case ConnOrGroupId
connOrGroupId of
    ConnectionId ChatItemId
connId -> IO RcvMessage -> ExceptT StoreError IO RcvMessage
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RcvMessage -> ExceptT StoreError IO RcvMessage)
-> IO RcvMessage -> ExceptT StoreError IO RcvMessage
forall a b. (a -> b) -> a -> b
$ Maybe ChatItemId -> Maybe ChatItemId -> IO RcvMessage
insertRcvMsg (ChatItemId -> Maybe ChatItemId
forall a. a -> Maybe a
Just ChatItemId
connId) Maybe ChatItemId
forall a. Maybe a
Nothing
    GroupId ChatItemId
groupId -> case Maybe SharedMsgId
sharedMsgId_ of
      Just SharedMsgId
sharedMsgId ->
        IO (Maybe (Maybe ChatItemId, Maybe ChatItemId))
-> ExceptT
     StoreError IO (Maybe (Maybe ChatItemId, Maybe ChatItemId))
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ChatItemId
-> SharedMsgId -> IO (Maybe (Maybe ChatItemId, Maybe ChatItemId))
duplicateGroupMsgMemberIds ChatItemId
groupId SharedMsgId
sharedMsgId) ExceptT StoreError IO (Maybe (Maybe ChatItemId, Maybe ChatItemId))
-> (Maybe (Maybe ChatItemId, Maybe ChatItemId)
    -> ExceptT StoreError IO RcvMessage)
-> ExceptT StoreError IO RcvMessage
forall a b.
ExceptT StoreError IO a
-> (a -> ExceptT StoreError IO b) -> ExceptT StoreError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Just (Maybe ChatItemId
duplAuthorId, Maybe ChatItemId
duplFwdMemberId) ->
            StoreError -> ExceptT StoreError IO RcvMessage
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO RcvMessage)
-> StoreError -> ExceptT StoreError IO RcvMessage
forall a b. (a -> b) -> a -> b
$ ChatItemId
-> SharedMsgId
-> Maybe ChatItemId
-> Maybe ChatItemId
-> StoreError
SEDuplicateGroupMessage ChatItemId
groupId SharedMsgId
sharedMsgId Maybe ChatItemId
duplAuthorId Maybe ChatItemId
duplFwdMemberId
          Maybe (Maybe ChatItemId, Maybe ChatItemId)
Nothing -> IO RcvMessage -> ExceptT StoreError IO RcvMessage
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RcvMessage -> ExceptT StoreError IO RcvMessage)
-> IO RcvMessage -> ExceptT StoreError IO RcvMessage
forall a b. (a -> b) -> a -> b
$ Maybe ChatItemId -> Maybe ChatItemId -> IO RcvMessage
insertRcvMsg Maybe ChatItemId
forall a. Maybe a
Nothing (Maybe ChatItemId -> IO RcvMessage)
-> Maybe ChatItemId -> IO RcvMessage
forall a b. (a -> b) -> a -> b
$ ChatItemId -> Maybe ChatItemId
forall a. a -> Maybe a
Just ChatItemId
groupId
      Maybe SharedMsgId
Nothing -> IO RcvMessage -> ExceptT StoreError IO RcvMessage
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RcvMessage -> ExceptT StoreError IO RcvMessage)
-> IO RcvMessage -> ExceptT StoreError IO RcvMessage
forall a b. (a -> b) -> a -> b
$ Maybe ChatItemId -> Maybe ChatItemId -> IO RcvMessage
insertRcvMsg Maybe ChatItemId
forall a. Maybe a
Nothing (Maybe ChatItemId -> IO RcvMessage)
-> Maybe ChatItemId -> IO RcvMessage
forall a b. (a -> b) -> a -> b
$ ChatItemId -> Maybe ChatItemId
forall a. a -> Maybe a
Just ChatItemId
groupId
  where
    duplicateGroupMsgMemberIds :: Int64 -> SharedMsgId -> IO (Maybe (Maybe GroupMemberId, Maybe GroupMemberId))
    duplicateGroupMsgMemberIds :: ChatItemId
-> SharedMsgId -> IO (Maybe (Maybe ChatItemId, Maybe ChatItemId))
duplicateGroupMsgMemberIds ChatItemId
groupId SharedMsgId
sharedMsgId =
      ((Maybe ChatItemId, Maybe ChatItemId)
 -> (Maybe ChatItemId, Maybe ChatItemId))
-> IO [(Maybe ChatItemId, Maybe ChatItemId)]
-> IO (Maybe (Maybe ChatItemId, Maybe ChatItemId))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow (Maybe ChatItemId, Maybe ChatItemId)
-> (Maybe ChatItemId, Maybe ChatItemId)
forall a. a -> a
id (IO [(Maybe ChatItemId, Maybe ChatItemId)]
 -> IO (Maybe (Maybe ChatItemId, Maybe ChatItemId)))
-> IO [(Maybe ChatItemId, Maybe ChatItemId)]
-> IO (Maybe (Maybe ChatItemId, Maybe ChatItemId))
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> (ChatItemId, SharedMsgId)
-> IO [(Maybe ChatItemId, Maybe ChatItemId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT author_group_member_id, forwarded_by_group_member_id
            FROM messages
            WHERE group_id = ? AND shared_msg_id = ? LIMIT 1
          |]
          (ChatItemId
groupId, SharedMsgId
sharedMsgId)
    insertRcvMsg :: Maybe ChatItemId -> Maybe ChatItemId -> IO RcvMessage
insertRcvMsg Maybe ChatItemId
connId_ Maybe ChatItemId
groupId_ = do
      UTCTime
currentTs <- IO UTCTime
getCurrentTime
      Connection
-> Query
-> ((MsgDirection, CMEventTag e, Binary ConnId, UTCTime, UTCTime,
     UTCTime, Maybe ChatItemId, Maybe ChatItemId)
    :. (Maybe SharedMsgId, Maybe ChatItemId, Maybe ChatItemId))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        [sql|
          INSERT INTO messages
            (msg_sent, chat_msg_event, msg_body, broker_ts, created_at, updated_at, connection_id, group_id,
             shared_msg_id, author_group_member_id, forwarded_by_group_member_id)
          VALUES (?,?,?,?,?,?,?,?,?,?,?)
        |]
        ((MsgDirection
MDRcv, ChatMsgEvent e -> CMEventTag e
forall (e :: MsgEncoding). ChatMsgEvent e -> CMEventTag e
toCMEventTag ChatMsgEvent e
chatMsgEvent, ConnId -> Binary ConnId
forall a. a -> Binary a
DB.Binary ConnId
msgBody, UTCTime
brokerTs, UTCTime
currentTs, UTCTime
currentTs, Maybe ChatItemId
connId_, Maybe ChatItemId
groupId_)
         (MsgDirection, CMEventTag e, Binary ConnId, UTCTime, UTCTime,
 UTCTime, Maybe ChatItemId, Maybe ChatItemId)
-> (Maybe SharedMsgId, Maybe ChatItemId, Maybe ChatItemId)
-> (MsgDirection, CMEventTag e, Binary ConnId, UTCTime, UTCTime,
    UTCTime, Maybe ChatItemId, Maybe ChatItemId)
   :. (Maybe SharedMsgId, Maybe ChatItemId, Maybe ChatItemId)
forall h t. h -> t -> h :. t
:. (Maybe SharedMsgId
sharedMsgId_, Maybe ChatItemId
authorMember, Maybe ChatItemId
forwardedByMember))
      ChatItemId
msgId <- Connection -> IO ChatItemId
insertedRowId Connection
db
      RcvMessage -> IO RcvMessage
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RcvMessage {ChatItemId
msgId :: ChatItemId
msgId :: ChatItemId
msgId, chatMsgEvent :: AChatMsgEvent
chatMsgEvent = SMsgEncoding e -> ChatMsgEvent e -> AChatMsgEvent
forall (e :: MsgEncoding).
MsgEncodingI e =>
SMsgEncoding e -> ChatMsgEvent e -> AChatMsgEvent
ACME (forall (e :: MsgEncoding). MsgEncodingI e => SMsgEncoding e
encoding @e) ChatMsgEvent e
chatMsgEvent, Maybe SharedMsgId
sharedMsgId_ :: Maybe SharedMsgId
sharedMsgId_ :: Maybe SharedMsgId
sharedMsgId_, ConnId
msgBody :: ConnId
msgBody :: ConnId
msgBody, Maybe ChatItemId
authorMember :: Maybe ChatItemId
authorMember :: Maybe ChatItemId
authorMember, Maybe ChatItemId
forwardedByMember :: Maybe ChatItemId
forwardedByMember :: Maybe ChatItemId
forwardedByMember}

updateSndMsgDeliveryStatus :: DB.Connection -> Int64 -> AgentMsgId -> MsgDeliveryStatus 'MDSnd -> IO ()
updateSndMsgDeliveryStatus :: Connection
-> ChatItemId -> ChatItemId -> MsgDeliveryStatus 'MDSnd -> IO ()
updateSndMsgDeliveryStatus Connection
db ChatItemId
connId ChatItemId
agentMsgId MsgDeliveryStatus 'MDSnd
sndMsgDeliveryStatus = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection
-> Query
-> (MsgDeliveryStatus 'MDSnd, UTCTime, ChatItemId, ChatItemId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE msg_deliveries
      SET delivery_status = ?, updated_at = ?
      WHERE connection_id = ? AND agent_msg_id = ?
    |]
    (MsgDeliveryStatus 'MDSnd
sndMsgDeliveryStatus, UTCTime
currentTs, ChatItemId
connId, ChatItemId
agentMsgId)

createPendingGroupMessage :: DB.Connection -> Int64 -> MessageId -> IO ()
createPendingGroupMessage :: Connection -> ChatItemId -> ChatItemId -> IO ()
createPendingGroupMessage Connection
db ChatItemId
groupMemberId ChatItemId
messageId = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection
-> Query -> (ChatItemId, ChatItemId, UTCTime, UTCTime) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      INSERT INTO pending_group_messages
        (group_member_id, message_id, created_at, updated_at) VALUES (?,?,?,?)
    |]
    (ChatItemId
groupMemberId, ChatItemId
messageId, UTCTime
currentTs, UTCTime
currentTs)

getPendingGroupMessages :: DB.Connection -> Int64 -> IO [SndMessage]
getPendingGroupMessages :: Connection -> ChatItemId -> IO [SndMessage]
getPendingGroupMessages Connection
db ChatItemId
groupMemberId =
  ((ChatItemId, SharedMsgId, ConnId) -> SndMessage)
-> [(ChatItemId, SharedMsgId, ConnId)] -> [SndMessage]
forall a b. (a -> b) -> [a] -> [b]
map (ChatItemId, SharedMsgId, ConnId) -> SndMessage
pendingGroupMessage
    ([(ChatItemId, SharedMsgId, ConnId)] -> [SndMessage])
-> IO [(ChatItemId, SharedMsgId, ConnId)] -> IO [SndMessage]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> Only ChatItemId
-> IO [(ChatItemId, SharedMsgId, ConnId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT pgm.message_id, m.shared_msg_id, m.msg_body
        FROM pending_group_messages pgm
        JOIN messages m USING (message_id)
        WHERE pgm.group_member_id = ?
        ORDER BY pgm.created_at ASC, pgm.message_id ASC
      |]
      (ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
groupMemberId)
  where
    pendingGroupMessage :: (ChatItemId, SharedMsgId, ConnId) -> SndMessage
pendingGroupMessage (ChatItemId
msgId, SharedMsgId
sharedMsgId, ConnId
msgBody) =
      SndMessage {ChatItemId
msgId :: ChatItemId
msgId :: ChatItemId
msgId, SharedMsgId
sharedMsgId :: SharedMsgId
sharedMsgId :: SharedMsgId
sharedMsgId, ConnId
msgBody :: ConnId
msgBody :: ConnId
msgBody}

deletePendingGroupMessage :: DB.Connection -> Int64 -> MessageId -> IO ()
deletePendingGroupMessage :: Connection -> ChatItemId -> ChatItemId -> IO ()
deletePendingGroupMessage Connection
db ChatItemId
groupMemberId ChatItemId
messageId =
  Connection -> Query -> (ChatItemId, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM pending_group_messages WHERE group_member_id = ? AND message_id = ?" (ChatItemId
groupMemberId, ChatItemId
messageId)

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

type NewQuoteRow = (Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool, Maybe MemberId)

-- For support chats with members we track unanswered count - number of messages from the member
-- that weren't followed up by a message from any of moderators.
data MemberAttention
  -- Message was received from member, increase unanswered counter and set support_chat_last_msg_from_member_ts.
  -- `MAInc 0 Nothing` is used in two cases:
  -- - when message from moderator is older than the last message from member (support_chat_last_msg_from_member_ts);
  -- - for user's chat with moderators, where unanswered count is not tracked.
  = MAInc Int (Maybe UTCTime)
  -- Message was received from moderator, reset unanswered counter.
  | MAReset
  deriving (Int -> MemberAttention -> ShowS
[MemberAttention] -> ShowS
MemberAttention -> FilePath
(Int -> MemberAttention -> ShowS)
-> (MemberAttention -> FilePath)
-> ([MemberAttention] -> ShowS)
-> Show MemberAttention
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MemberAttention -> ShowS
showsPrec :: Int -> MemberAttention -> ShowS
$cshow :: MemberAttention -> FilePath
show :: MemberAttention -> FilePath
$cshowList :: [MemberAttention] -> ShowS
showList :: [MemberAttention] -> ShowS
Show)

updateChatTsStats :: DB.Connection -> VersionRangeChat -> User -> ChatDirection c d -> UTCTime -> Maybe (Int, MemberAttention, Int) -> IO (ChatInfo c)
updateChatTsStats :: forall (c :: ChatType) (d :: MsgDirection).
Connection
-> VersionRangeChat
-> User
-> ChatDirection c d
-> UTCTime
-> Maybe (Int, MemberAttention, Int)
-> IO (ChatInfo c)
updateChatTsStats Connection
db VersionRangeChat
vr user :: User
user@User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatDirection c d
chatDirection UTCTime
chatTs Maybe (Int, MemberAttention, Int)
chatStats_ = case ChatDirection c d -> ChatInfo c
forall (c :: ChatType) (d :: MsgDirection).
ChatDirection c d -> ChatInfo c
toChatInfo ChatDirection c d
chatDirection of
  DirectChat ct :: Contact
ct@Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} -> do
    Connection -> Query -> (UTCTime, ChatItemId, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      Query
"UPDATE contacts SET chat_ts = ?, chat_deleted = 0 WHERE user_id = ? AND contact_id = ?"
      (UTCTime
chatTs, ChatItemId
userId, ChatItemId
contactId)
    ChatInfo 'CTDirect -> IO (ChatInfo 'CTDirect)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatInfo 'CTDirect -> IO (ChatInfo 'CTDirect))
-> ChatInfo 'CTDirect -> IO (ChatInfo 'CTDirect)
forall a b. (a -> b) -> a -> b
$ Contact -> ChatInfo 'CTDirect
DirectChat Contact
ct {chatTs = Just chatTs}
  GroupChat g :: GroupInfo
g@GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} Maybe GroupChatScopeInfo
Nothing -> do
    Connection -> Query -> (UTCTime, ChatItemId, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      Query
"UPDATE groups SET chat_ts = ? WHERE user_id = ? AND group_id = ?"
      (UTCTime
chatTs, ChatItemId
userId, ChatItemId
groupId)
    ChatInfo 'CTGroup -> IO (ChatInfo 'CTGroup)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatInfo 'CTGroup -> IO (ChatInfo 'CTGroup))
-> ChatInfo 'CTGroup -> IO (ChatInfo 'CTGroup)
forall a b. (a -> b) -> a -> b
$ GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
g {chatTs = Just chatTs} Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing
  GroupChat g :: GroupInfo
g@GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId, GroupMember
membership :: GroupMember
membership :: GroupInfo -> GroupMember
membership, Int
membersRequireAttention :: Int
membersRequireAttention :: GroupInfo -> Int
membersRequireAttention} (Just GCSIMemberSupport {Maybe GroupMember
groupMember_ :: Maybe GroupMember
groupMember_ :: GroupChatScopeInfo -> Maybe GroupMember
groupMember_}) ->
    case Maybe GroupMember
groupMember_ of
      Maybe GroupMember
Nothing -> do
        GroupMember
membership' <- GroupMember -> IO GroupMember
updateGMStats GroupMember
membership
        Connection -> Query -> (UTCTime, ChatItemId, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
          Connection
db
          Query
"UPDATE groups SET chat_ts = ? WHERE user_id = ? AND group_id = ?"
          (UTCTime
chatTs, ChatItemId
userId, ChatItemId
groupId)
        ChatInfo 'CTGroup -> IO (ChatInfo 'CTGroup)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatInfo 'CTGroup -> IO (ChatInfo 'CTGroup))
-> ChatInfo 'CTGroup -> IO (ChatInfo 'CTGroup)
forall a b. (a -> b) -> a -> b
$ GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
g {membership = membership', chatTs = Just chatTs} (GroupChatScopeInfo -> Maybe GroupChatScopeInfo
forall a. a -> Maybe a
Just (GroupChatScopeInfo -> Maybe GroupChatScopeInfo)
-> GroupChatScopeInfo -> Maybe GroupChatScopeInfo
forall a b. (a -> b) -> a -> b
$ Maybe GroupMember -> GroupChatScopeInfo
GCSIMemberSupport Maybe GroupMember
forall a. Maybe a
Nothing)
      Just GroupMember
member -> do
        GroupMember
member' <- GroupMember -> IO GroupMember
updateGMStats GroupMember
member
        let didRequire :: Bool
didRequire = GroupMember -> Bool
gmRequiresAttention GroupMember
member
            nowRequires :: Bool
nowRequires = GroupMember -> Bool
gmRequiresAttention GroupMember
member'
        if
          | Bool
nowRequires Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
didRequire -> do
              Connection -> Query -> (UTCTime, ChatItemId, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
                Connection
db
                [sql|
                  UPDATE groups
                  SET chat_ts = ?,
                      members_require_attention = members_require_attention + 1
                  WHERE user_id = ? AND group_id = ?
                |]
                (UTCTime
chatTs, ChatItemId
userId, ChatItemId
groupId)
              ChatInfo 'CTGroup -> IO (ChatInfo 'CTGroup)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatInfo 'CTGroup -> IO (ChatInfo 'CTGroup))
-> ChatInfo 'CTGroup -> IO (ChatInfo 'CTGroup)
forall a b. (a -> b) -> a -> b
$ GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
g {membersRequireAttention = membersRequireAttention + 1, chatTs = Just chatTs} (GroupChatScopeInfo -> Maybe GroupChatScopeInfo
forall a. a -> Maybe a
Just (GroupChatScopeInfo -> Maybe GroupChatScopeInfo)
-> GroupChatScopeInfo -> Maybe GroupChatScopeInfo
forall a b. (a -> b) -> a -> b
$ Maybe GroupMember -> GroupChatScopeInfo
GCSIMemberSupport (GroupMember -> Maybe GroupMember
forall a. a -> Maybe a
Just GroupMember
member'))
          | Bool -> Bool
not Bool
nowRequires Bool -> Bool -> Bool
&& Bool
didRequire -> do
              Connection -> Query -> (UTCTime, ChatItemId, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
                Connection
db
#if defined(dbPostgres)
                [sql|
                  UPDATE groups
                  SET chat_ts = ?,
                      members_require_attention = GREATEST(0, members_require_attention - 1)
                  WHERE user_id = ? AND group_id = ?
                |]
#else
                [sql|
                  UPDATE groups
                  SET chat_ts = ?,
                      members_require_attention = MAX(0, members_require_attention - 1)
                  WHERE user_id = ? AND group_id = ?
                |]
#endif
                (UTCTime
chatTs, ChatItemId
userId, ChatItemId
groupId)
              ChatInfo 'CTGroup -> IO (ChatInfo 'CTGroup)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatInfo 'CTGroup -> IO (ChatInfo 'CTGroup))
-> ChatInfo 'CTGroup -> IO (ChatInfo 'CTGroup)
forall a b. (a -> b) -> a -> b
$ GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
g {membersRequireAttention = max 0 (membersRequireAttention - 1), chatTs = Just chatTs} (GroupChatScopeInfo -> Maybe GroupChatScopeInfo
forall a. a -> Maybe a
Just (GroupChatScopeInfo -> Maybe GroupChatScopeInfo)
-> GroupChatScopeInfo -> Maybe GroupChatScopeInfo
forall a b. (a -> b) -> a -> b
$ Maybe GroupMember -> GroupChatScopeInfo
GCSIMemberSupport (GroupMember -> Maybe GroupMember
forall a. a -> Maybe a
Just GroupMember
member'))
          | Bool
otherwise -> do
              Connection -> Query -> (UTCTime, ChatItemId, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
                Connection
db
                Query
"UPDATE groups SET chat_ts = ? WHERE user_id = ? AND group_id = ?"
                (UTCTime
chatTs, ChatItemId
userId, ChatItemId
groupId)
              ChatInfo 'CTGroup -> IO (ChatInfo 'CTGroup)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatInfo 'CTGroup -> IO (ChatInfo 'CTGroup))
-> ChatInfo 'CTGroup -> IO (ChatInfo 'CTGroup)
forall a b. (a -> b) -> a -> b
$ GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
g {chatTs = Just chatTs} (GroupChatScopeInfo -> Maybe GroupChatScopeInfo
forall a. a -> Maybe a
Just (GroupChatScopeInfo -> Maybe GroupChatScopeInfo)
-> GroupChatScopeInfo -> Maybe GroupChatScopeInfo
forall a b. (a -> b) -> a -> b
$ Maybe GroupMember -> GroupChatScopeInfo
GCSIMemberSupport (GroupMember -> Maybe GroupMember
forall a. a -> Maybe a
Just GroupMember
member'))
    where
      updateGMStats :: GroupMember -> IO GroupMember
updateGMStats m :: GroupMember
m@GroupMember {ChatItemId
groupMemberId :: GroupMember -> ChatItemId
groupMemberId :: ChatItemId
groupMemberId} = do
        case Maybe (Int, MemberAttention, Int)
chatStats_ of
          Maybe (Int, MemberAttention, Int)
Nothing ->
            Connection -> Query -> (UTCTime, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
              Connection
db
              Query
"UPDATE group_members SET support_chat_ts = ? WHERE group_member_id = ?"
              (UTCTime
chatTs, ChatItemId
groupMemberId)
          Just (Int
unread, MAInc Int
unanswered Maybe UTCTime
Nothing, Int
mentions) ->
            Connection
-> Query -> (UTCTime, Int, Int, Int, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
              Connection
db
              [sql|
                UPDATE group_members
                SET support_chat_ts = ?,
                    support_chat_items_unread = support_chat_items_unread + ?,
                    support_chat_items_member_attention = support_chat_items_member_attention + ?,
                    support_chat_items_mentions = support_chat_items_mentions + ?
                WHERE group_member_id = ?
              |]
              (UTCTime
chatTs, Int
unread, Int
unanswered, Int
mentions, ChatItemId
groupMemberId)
          Just (Int
unread, MAInc Int
unanswered (Just UTCTime
lastMsgFromMemberTs), Int
mentions) ->
            Connection
-> Query -> (UTCTime, Int, Int, Int, UTCTime, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
              Connection
db
              [sql|
                UPDATE group_members
                SET support_chat_ts = ?,
                    support_chat_items_unread = support_chat_items_unread + ?,
                    support_chat_items_member_attention = support_chat_items_member_attention + ?,
                    support_chat_items_mentions = support_chat_items_mentions + ?,
                    support_chat_last_msg_from_member_ts = ?
                WHERE group_member_id = ?
              |]
              (UTCTime
chatTs, Int
unread, Int
unanswered, Int
mentions, UTCTime
lastMsgFromMemberTs, ChatItemId
groupMemberId)
          Just (Int
unread, MemberAttention
MAReset, Int
mentions) ->
            Connection -> Query -> (UTCTime, Int, Int, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
              Connection
db
              [sql|
                UPDATE group_members
                SET support_chat_ts = ?,
                    support_chat_items_unread = support_chat_items_unread + ?,
                    support_chat_items_member_attention = 0,
                    support_chat_items_mentions = support_chat_items_mentions + ?
                WHERE group_member_id = ?
              |]
              (UTCTime
chatTs, Int
unread, Int
mentions, ChatItemId
groupMemberId)
        Either StoreError GroupMember
m_ <- ExceptT StoreError IO GroupMember
-> IO (Either StoreError GroupMember)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO GroupMember
 -> IO (Either StoreError GroupMember))
-> ExceptT StoreError IO GroupMember
-> IO (Either StoreError GroupMember)
forall a b. (a -> b) -> a -> b
$ Connection
-> VersionRangeChat
-> User
-> ChatItemId
-> ExceptT StoreError IO GroupMember
getGroupMemberById Connection
db VersionRangeChat
vr User
user ChatItemId
groupMemberId
        GroupMember -> IO GroupMember
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupMember -> IO GroupMember) -> GroupMember -> IO GroupMember
forall a b. (a -> b) -> a -> b
$ (StoreError -> GroupMember)
-> (GroupMember -> GroupMember)
-> Either StoreError GroupMember
-> GroupMember
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (GroupMember -> StoreError -> GroupMember
forall a b. a -> b -> a
const GroupMember
m) GroupMember -> GroupMember
forall a. a -> a
id Either StoreError GroupMember
m_ -- Left shouldn't happen, but types require it
  LocalChat nf :: NoteFolder
nf@NoteFolder {ChatItemId
noteFolderId :: ChatItemId
noteFolderId :: NoteFolder -> ChatItemId
noteFolderId} -> do
    Connection -> Query -> (UTCTime, ChatItemId, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      Query
"UPDATE note_folders SET chat_ts = ? WHERE user_id = ? AND note_folder_id = ?"
      (UTCTime
chatTs, ChatItemId
userId, ChatItemId
noteFolderId)
    ChatInfo 'CTLocal -> IO (ChatInfo 'CTLocal)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatInfo 'CTLocal -> IO (ChatInfo 'CTLocal))
-> ChatInfo 'CTLocal -> IO (ChatInfo 'CTLocal)
forall a b. (a -> b) -> a -> b
$ NoteFolder -> ChatInfo 'CTLocal
LocalChat NoteFolder
nf {chatTs = chatTs}
  ChatInfo c
cInfo -> ChatInfo c -> IO (ChatInfo c)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatInfo c
cInfo

setSupportChatTs :: DB.Connection -> GroupMemberId -> UTCTime -> IO ()
setSupportChatTs :: Connection -> ChatItemId -> UTCTime -> IO ()
setSupportChatTs Connection
db ChatItemId
groupMemberId UTCTime
chatTs =
  Connection -> Query -> (UTCTime, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE group_members SET support_chat_ts = ? WHERE group_member_id = ?" (UTCTime
chatTs, ChatItemId
groupMemberId)

setSupportChatMemberAttention :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMember -> Int64 -> IO (GroupInfo, GroupMember)
setSupportChatMemberAttention :: Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> GroupMember
-> ChatItemId
-> IO (GroupInfo, GroupMember)
setSupportChatMemberAttention Connection
db VersionRangeChat
vr User
user GroupInfo
g GroupMember
m ChatItemId
memberAttention = do
  GroupMember
m' <- IO GroupMember
updateGMAttention
  GroupInfo
g' <- Connection
-> User -> GroupInfo -> GroupMember -> GroupMember -> IO GroupInfo
updateGroupMembersRequireAttention Connection
db User
user GroupInfo
g GroupMember
m GroupMember
m'
  (GroupInfo, GroupMember) -> IO (GroupInfo, GroupMember)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupInfo
g', GroupMember
m')
  where
    updateGMAttention :: IO GroupMember
updateGMAttention = do
      UTCTime
currentTs <- IO UTCTime
getCurrentTime
      Connection -> Query -> (ChatItemId, UTCTime, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        Query
"UPDATE group_members SET support_chat_items_member_attention = ?, updated_at = ? WHERE group_member_id = ?"
        (ChatItemId
memberAttention, UTCTime
currentTs, GroupMember -> ChatItemId
groupMemberId' GroupMember
m)
      Either StoreError GroupMember
m_ <- ExceptT StoreError IO GroupMember
-> IO (Either StoreError GroupMember)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO GroupMember
 -> IO (Either StoreError GroupMember))
-> ExceptT StoreError IO GroupMember
-> IO (Either StoreError GroupMember)
forall a b. (a -> b) -> a -> b
$ Connection
-> VersionRangeChat
-> User
-> ChatItemId
-> ExceptT StoreError IO GroupMember
getGroupMemberById Connection
db VersionRangeChat
vr User
user (GroupMember -> ChatItemId
groupMemberId' GroupMember
m)
      GroupMember -> IO GroupMember
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupMember -> IO GroupMember) -> GroupMember -> IO GroupMember
forall a b. (a -> b) -> a -> b
$ (StoreError -> GroupMember)
-> (GroupMember -> GroupMember)
-> Either StoreError GroupMember
-> GroupMember
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (GroupMember -> StoreError -> GroupMember
forall a b. a -> b -> a
const GroupMember
m) GroupMember -> GroupMember
forall a. a -> a
id Either StoreError GroupMember
m_ -- Left shouldn't happen, but types require it

createNewSndChatItem :: DB.Connection -> User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> UTCTime -> IO ChatItemId
createNewSndChatItem :: forall (c :: ChatType).
Connection
-> User
-> ChatDirection c 'MDSnd
-> SndMessage
-> CIContent 'MDSnd
-> Maybe (CIQuote c)
-> Maybe CIForwardedFrom
-> Maybe CITimed
-> Bool
-> UTCTime
-> IO ChatItemId
createNewSndChatItem Connection
db User
user ChatDirection c 'MDSnd
chatDirection SndMessage {ChatItemId
msgId :: SndMessage -> ChatItemId
msgId :: ChatItemId
msgId, SharedMsgId
sharedMsgId :: SndMessage -> SharedMsgId
sharedMsgId :: SharedMsgId
sharedMsgId} CIContent 'MDSnd
ciContent Maybe (CIQuote c)
quotedItem Maybe CIForwardedFrom
itemForwarded Maybe CITimed
timed Bool
live UTCTime
createdAt =
  Connection
-> User
-> ChatDirection c 'MDSnd
-> Bool
-> Maybe ChatItemId
-> Maybe SharedMsgId
-> CIContent 'MDSnd
-> NewQuoteRow
-> Maybe CIForwardedFrom
-> Maybe CITimed
-> Bool
-> Bool
-> UTCTime
-> Maybe ChatItemId
-> UTCTime
-> IO ChatItemId
forall (c :: ChatType) (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> User
-> ChatDirection c d
-> Bool
-> Maybe ChatItemId
-> Maybe SharedMsgId
-> CIContent d
-> NewQuoteRow
-> Maybe CIForwardedFrom
-> Maybe CITimed
-> Bool
-> Bool
-> UTCTime
-> Maybe ChatItemId
-> UTCTime
-> IO ChatItemId
createNewChatItem_ Connection
db User
user ChatDirection c 'MDSnd
chatDirection Bool
False Maybe ChatItemId
createdByMsgId (SharedMsgId -> Maybe SharedMsgId
forall a. a -> Maybe a
Just SharedMsgId
sharedMsgId) CIContent 'MDSnd
ciContent NewQuoteRow
quoteRow Maybe CIForwardedFrom
itemForwarded Maybe CITimed
timed Bool
live Bool
False UTCTime
createdAt Maybe ChatItemId
forall a. Maybe a
Nothing UTCTime
createdAt
  where
    createdByMsgId :: Maybe ChatItemId
createdByMsgId = if ChatItemId
msgId ChatItemId -> ChatItemId -> Bool
forall a. Eq a => a -> a -> Bool
== ChatItemId
0 then Maybe ChatItemId
forall a. Maybe a
Nothing else ChatItemId -> Maybe ChatItemId
forall a. a -> Maybe a
Just ChatItemId
msgId
    quoteRow :: NewQuoteRow
    quoteRow :: NewQuoteRow
quoteRow = case Maybe (CIQuote c)
quotedItem of
      Maybe (CIQuote c)
Nothing -> (Maybe SharedMsgId
forall a. Maybe a
Nothing, Maybe UTCTime
forall a. Maybe a
Nothing, Maybe MsgContent
forall a. Maybe a
Nothing, Maybe Bool
forall a. Maybe a
Nothing, Maybe MemberId
forall a. Maybe a
Nothing)
      Just CIQuote {CIQDirection c
chatDir :: CIQDirection c
chatDir :: forall (c :: ChatType). CIQuote c -> CIQDirection c
chatDir, sharedMsgId :: forall (c :: ChatType). CIQuote c -> Maybe SharedMsgId
sharedMsgId = Maybe SharedMsgId
quotedSharedMsgId, UTCTime
sentAt :: UTCTime
sentAt :: forall (c :: ChatType). CIQuote c -> UTCTime
sentAt, MsgContent
content :: MsgContent
content :: forall (c :: ChatType). CIQuote c -> MsgContent
content} ->
        (Maybe Bool -> Maybe MemberId -> NewQuoteRow)
-> (Maybe Bool, Maybe MemberId) -> NewQuoteRow
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Maybe SharedMsgId
quotedSharedMsgId,UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
sentAt,MsgContent -> Maybe MsgContent
forall a. a -> Maybe a
Just MsgContent
content,,) ((Maybe Bool, Maybe MemberId) -> NewQuoteRow)
-> (Maybe Bool, Maybe MemberId) -> NewQuoteRow
forall a b. (a -> b) -> a -> b
$ case CIQDirection c
chatDir of
          CIQDirection c
CIQDirectSnd -> (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True, Maybe MemberId
forall a. Maybe a
Nothing)
          CIQDirection c
CIQDirectRcv -> (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False, Maybe MemberId
forall a. Maybe a
Nothing)
          CIQDirection c
CIQGroupSnd -> (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True, Maybe MemberId
forall a. Maybe a
Nothing)
          CIQGroupRcv (Just GroupMember {MemberId
memberId :: MemberId
memberId :: GroupMember -> MemberId
memberId}) -> (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False, MemberId -> Maybe MemberId
forall a. a -> Maybe a
Just MemberId
memberId)
          CIQGroupRcv Maybe GroupMember
Nothing -> (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False, Maybe MemberId
forall a. Maybe a
Nothing)

createNewRcvChatItem :: ChatTypeQuotable c => DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c), Maybe CIForwardedFrom)
createNewRcvChatItem :: forall (c :: ChatType).
ChatTypeQuotable c =>
Connection
-> User
-> ChatDirection c 'MDRcv
-> RcvMessage
-> Maybe SharedMsgId
-> CIContent 'MDRcv
-> Maybe CITimed
-> Bool
-> Bool
-> UTCTime
-> UTCTime
-> IO (ChatItemId, Maybe (CIQuote c), Maybe CIForwardedFrom)
createNewRcvChatItem Connection
db User
user ChatDirection c 'MDRcv
chatDirection RcvMessage {ChatItemId
msgId :: RcvMessage -> ChatItemId
msgId :: ChatItemId
msgId, AChatMsgEvent
chatMsgEvent :: RcvMessage -> AChatMsgEvent
chatMsgEvent :: AChatMsgEvent
chatMsgEvent, Maybe ChatItemId
forwardedByMember :: RcvMessage -> Maybe ChatItemId
forwardedByMember :: Maybe ChatItemId
forwardedByMember} Maybe SharedMsgId
sharedMsgId_ CIContent 'MDRcv
ciContent Maybe CITimed
timed Bool
live Bool
userMention UTCTime
itemTs UTCTime
createdAt = do
  ChatItemId
ciId <- Connection
-> User
-> ChatDirection c 'MDRcv
-> Bool
-> Maybe ChatItemId
-> Maybe SharedMsgId
-> CIContent 'MDRcv
-> NewQuoteRow
-> Maybe CIForwardedFrom
-> Maybe CITimed
-> Bool
-> Bool
-> UTCTime
-> Maybe ChatItemId
-> UTCTime
-> IO ChatItemId
forall (c :: ChatType) (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> User
-> ChatDirection c d
-> Bool
-> Maybe ChatItemId
-> Maybe SharedMsgId
-> CIContent d
-> NewQuoteRow
-> Maybe CIForwardedFrom
-> Maybe CITimed
-> Bool
-> Bool
-> UTCTime
-> Maybe ChatItemId
-> UTCTime
-> IO ChatItemId
createNewChatItem_ Connection
db User
user ChatDirection c 'MDRcv
chatDirection Bool
False (ChatItemId -> Maybe ChatItemId
forall a. a -> Maybe a
Just ChatItemId
msgId) Maybe SharedMsgId
sharedMsgId_ CIContent 'MDRcv
ciContent NewQuoteRow
quoteRow Maybe CIForwardedFrom
itemForwarded Maybe CITimed
timed Bool
live Bool
userMention UTCTime
itemTs Maybe ChatItemId
forwardedByMember UTCTime
createdAt
  Maybe (CIQuote c)
quotedItem <- (QuotedMsg -> IO (CIQuote c))
-> Maybe QuotedMsg -> IO (Maybe (CIQuote c))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (Connection
-> User -> ChatDirection c 'MDRcv -> QuotedMsg -> IO (CIQuote c)
forall (c :: ChatType).
ChatTypeQuotable c =>
Connection
-> User -> ChatDirection c 'MDRcv -> QuotedMsg -> IO (CIQuote c)
getChatItemQuote_ Connection
db User
user ChatDirection c 'MDRcv
chatDirection) Maybe QuotedMsg
quotedMsg
  (ChatItemId, Maybe (CIQuote c), Maybe CIForwardedFrom)
-> IO (ChatItemId, Maybe (CIQuote c), Maybe CIForwardedFrom)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatItemId
ciId, Maybe (CIQuote c)
quotedItem, Maybe CIForwardedFrom
itemForwarded)
  where
    itemForwarded :: Maybe CIForwardedFrom
itemForwarded = AChatMsgEvent -> Maybe CIForwardedFrom
cmForwardedFrom AChatMsgEvent
chatMsgEvent
    quotedMsg :: Maybe QuotedMsg
quotedMsg = AChatMsgEvent -> Maybe QuotedMsg
cmToQuotedMsg AChatMsgEvent
chatMsgEvent
    quoteRow :: NewQuoteRow
    quoteRow :: NewQuoteRow
quoteRow = case Maybe QuotedMsg
quotedMsg of
      Maybe QuotedMsg
Nothing -> (Maybe SharedMsgId
forall a. Maybe a
Nothing, Maybe UTCTime
forall a. Maybe a
Nothing, Maybe MsgContent
forall a. Maybe a
Nothing, Maybe Bool
forall a. Maybe a
Nothing, Maybe MemberId
forall a. Maybe a
Nothing)
      Just QuotedMsg {msgRef :: QuotedMsg -> MsgRef
msgRef = MsgRef {msgId :: MsgRef -> Maybe SharedMsgId
msgId = Maybe SharedMsgId
sharedMsgId, UTCTime
sentAt :: UTCTime
sentAt :: MsgRef -> UTCTime
sentAt, Bool
sent :: Bool
sent :: MsgRef -> Bool
sent, Maybe MemberId
memberId :: Maybe MemberId
memberId :: MsgRef -> Maybe MemberId
memberId}, MsgContent
content :: MsgContent
content :: QuotedMsg -> MsgContent
content} ->
        (Maybe Bool -> Maybe MemberId -> NewQuoteRow)
-> (Maybe Bool, Maybe MemberId) -> NewQuoteRow
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Maybe SharedMsgId
sharedMsgId,UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
sentAt,MsgContent -> Maybe MsgContent
forall a. a -> Maybe a
Just MsgContent
content,,) ((Maybe Bool, Maybe MemberId) -> NewQuoteRow)
-> (Maybe Bool, Maybe MemberId) -> NewQuoteRow
forall a b. (a -> b) -> a -> b
$ case ChatDirection c 'MDRcv
chatDirection of
          CDDirectRcv Contact
_ -> (Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
sent, Maybe MemberId
forall a. Maybe a
Nothing)
          CDGroupRcv GroupInfo {membership :: GroupInfo -> GroupMember
membership = GroupMember {memberId :: GroupMember -> MemberId
memberId = MemberId
userMemberId}} Maybe GroupChatScopeInfo
_ GroupMember
_ ->
            (Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ MemberId -> Maybe MemberId
forall a. a -> Maybe a
Just MemberId
userMemberId Maybe MemberId -> Maybe MemberId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe MemberId
memberId, Maybe MemberId
memberId)

createNewChatItemNoMsg :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> ShowGroupAsSender -> CIContent d -> Maybe SharedMsgId -> UTCTime -> UTCTime -> IO ChatItemId
createNewChatItemNoMsg :: forall (c :: ChatType) (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> User
-> ChatDirection c d
-> Bool
-> CIContent d
-> Maybe SharedMsgId
-> UTCTime
-> UTCTime
-> IO ChatItemId
createNewChatItemNoMsg Connection
db User
user ChatDirection c d
chatDirection Bool
showGroupAsSender CIContent d
ciContent Maybe SharedMsgId
sharedMsgId_ UTCTime
itemTs =
  Connection
-> User
-> ChatDirection c d
-> Bool
-> Maybe ChatItemId
-> Maybe SharedMsgId
-> CIContent d
-> NewQuoteRow
-> Maybe CIForwardedFrom
-> Maybe CITimed
-> Bool
-> Bool
-> UTCTime
-> Maybe ChatItemId
-> UTCTime
-> IO ChatItemId
forall (c :: ChatType) (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> User
-> ChatDirection c d
-> Bool
-> Maybe ChatItemId
-> Maybe SharedMsgId
-> CIContent d
-> NewQuoteRow
-> Maybe CIForwardedFrom
-> Maybe CITimed
-> Bool
-> Bool
-> UTCTime
-> Maybe ChatItemId
-> UTCTime
-> IO ChatItemId
createNewChatItem_ Connection
db User
user ChatDirection c d
chatDirection Bool
showGroupAsSender Maybe ChatItemId
forall a. Maybe a
Nothing Maybe SharedMsgId
sharedMsgId_ CIContent d
ciContent NewQuoteRow
quoteRow Maybe CIForwardedFrom
forall a. Maybe a
Nothing Maybe CITimed
forall a. Maybe a
Nothing Bool
False Bool
False UTCTime
itemTs Maybe ChatItemId
forall a. Maybe a
Nothing
  where
    quoteRow :: NewQuoteRow
    quoteRow :: NewQuoteRow
quoteRow = (Maybe SharedMsgId
forall a. Maybe a
Nothing, Maybe UTCTime
forall a. Maybe a
Nothing, Maybe MsgContent
forall a. Maybe a
Nothing, Maybe Bool
forall a. Maybe a
Nothing, Maybe MemberId
forall a. Maybe a
Nothing)

createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> ShowGroupAsSender -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> Bool -> UTCTime -> Maybe GroupMemberId -> UTCTime -> IO ChatItemId
createNewChatItem_ :: forall (c :: ChatType) (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> User
-> ChatDirection c d
-> Bool
-> Maybe ChatItemId
-> Maybe SharedMsgId
-> CIContent d
-> NewQuoteRow
-> Maybe CIForwardedFrom
-> Maybe CITimed
-> Bool
-> Bool
-> UTCTime
-> Maybe ChatItemId
-> UTCTime
-> IO ChatItemId
createNewChatItem_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatDirection c d
chatDirection Bool
showGroupAsSender Maybe ChatItemId
msgId_ Maybe SharedMsgId
sharedMsgId CIContent d
ciContent NewQuoteRow
quoteRow Maybe CIForwardedFrom
itemForwarded Maybe CITimed
timed Bool
live Bool
userMention UTCTime
itemTs Maybe ChatItemId
forwardedByMember UTCTime
createdAt = do
  Connection
-> Query
-> ((ChatItemId, Maybe ChatItemId)
    :. ((Maybe ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
         Maybe ChatItemId)
        :. ((Maybe GroupChatScopeTag, Maybe ChatItemId)
            :. (((SMsgDirection d, UTCTime, CIContent d, MemberName,
                  MemberName, CIStatus d, Maybe MsgContentTag, Maybe SharedMsgId,
                  Maybe ChatItemId, BoolInt)
                 :. ((UTCTime, UTCTime, Maybe BoolInt, BoolInt, BoolInt)
                     :. (Maybe Int, Maybe UTCTime)))
                :. ((Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent,
                     Maybe BoolInt, Maybe MemberId)
                    :. ChatItemForwardedFromRow)))))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      INSERT INTO chat_items (
        -- user and IDs
        user_id, created_by_msg_id, contact_id, group_id, group_member_id, note_folder_id, group_scope_tag, group_scope_group_member_id,
        -- meta
        item_sent, item_ts, item_content, item_content_tag, item_text, item_status, msg_content_tag, shared_msg_id,
        forwarded_by_group_member_id, include_in_history, created_at, updated_at, item_live, user_mention, show_group_as_sender, timed_ttl, timed_delete_at,
        -- quote
        quoted_shared_msg_id, quoted_sent_at, quoted_content, quoted_sent, quoted_member_id,
        -- forwarded from
        fwd_from_tag, fwd_from_chat_name, fwd_from_msg_dir, fwd_from_contact_id, fwd_from_group_id, fwd_from_chat_item_id
      ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
    |]
    ((ChatItemId
userId, Maybe ChatItemId
msgId_) (ChatItemId, Maybe ChatItemId)
-> ((Maybe ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
     Maybe ChatItemId)
    :. ((Maybe GroupChatScopeTag, Maybe ChatItemId)
        :. (((SMsgDirection d, UTCTime, CIContent d, MemberName,
              MemberName, CIStatus d, Maybe MsgContentTag, Maybe SharedMsgId,
              Maybe ChatItemId, BoolInt)
             :. ((UTCTime, UTCTime, Maybe BoolInt, BoolInt, BoolInt)
                 :. (Maybe Int, Maybe UTCTime)))
            :. ((Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent,
                 Maybe BoolInt, Maybe MemberId)
                :. ChatItemForwardedFromRow))))
-> (ChatItemId, Maybe ChatItemId)
   :. ((Maybe ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
        Maybe ChatItemId)
       :. ((Maybe GroupChatScopeTag, Maybe ChatItemId)
           :. (((SMsgDirection d, UTCTime, CIContent d, MemberName,
                 MemberName, CIStatus d, Maybe MsgContentTag, Maybe SharedMsgId,
                 Maybe ChatItemId, BoolInt)
                :. ((UTCTime, UTCTime, Maybe BoolInt, BoolInt, BoolInt)
                    :. (Maybe Int, Maybe UTCTime)))
               :. ((Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent,
                    Maybe BoolInt, Maybe MemberId)
                   :. ChatItemForwardedFromRow))))
forall h t. h -> t -> h :. t
:. (Maybe ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
 Maybe ChatItemId)
idsRow (Maybe ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
 Maybe ChatItemId)
-> ((Maybe GroupChatScopeTag, Maybe ChatItemId)
    :. (((SMsgDirection d, UTCTime, CIContent d, MemberName,
          MemberName, CIStatus d, Maybe MsgContentTag, Maybe SharedMsgId,
          Maybe ChatItemId, BoolInt)
         :. ((UTCTime, UTCTime, Maybe BoolInt, BoolInt, BoolInt)
             :. (Maybe Int, Maybe UTCTime)))
        :. ((Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent,
             Maybe BoolInt, Maybe MemberId)
            :. ChatItemForwardedFromRow)))
-> (Maybe ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
    Maybe ChatItemId)
   :. ((Maybe GroupChatScopeTag, Maybe ChatItemId)
       :. (((SMsgDirection d, UTCTime, CIContent d, MemberName,
             MemberName, CIStatus d, Maybe MsgContentTag, Maybe SharedMsgId,
             Maybe ChatItemId, BoolInt)
            :. ((UTCTime, UTCTime, Maybe BoolInt, BoolInt, BoolInt)
                :. (Maybe Int, Maybe UTCTime)))
           :. ((Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent,
                Maybe BoolInt, Maybe MemberId)
               :. ChatItemForwardedFromRow)))
forall h t. h -> t -> h :. t
:. (Maybe GroupChatScopeTag, Maybe ChatItemId)
groupScopeRow (Maybe GroupChatScopeTag, Maybe ChatItemId)
-> (((SMsgDirection d, UTCTime, CIContent d, MemberName,
      MemberName, CIStatus d, Maybe MsgContentTag, Maybe SharedMsgId,
      Maybe ChatItemId, BoolInt)
     :. ((UTCTime, UTCTime, Maybe BoolInt, BoolInt, BoolInt)
         :. (Maybe Int, Maybe UTCTime)))
    :. ((Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent,
         Maybe BoolInt, Maybe MemberId)
        :. ChatItemForwardedFromRow))
-> (Maybe GroupChatScopeTag, Maybe ChatItemId)
   :. (((SMsgDirection d, UTCTime, CIContent d, MemberName,
         MemberName, CIStatus d, Maybe MsgContentTag, Maybe SharedMsgId,
         Maybe ChatItemId, BoolInt)
        :. ((UTCTime, UTCTime, Maybe BoolInt, BoolInt, BoolInt)
            :. (Maybe Int, Maybe UTCTime)))
       :. ((Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent,
            Maybe BoolInt, Maybe MemberId)
           :. ChatItemForwardedFromRow))
forall h t. h -> t -> h :. t
:. (SMsgDirection d, UTCTime, CIContent d, MemberName, MemberName,
 CIStatus d, Maybe MsgContentTag, Maybe SharedMsgId,
 Maybe ChatItemId, BoolInt)
:. ((UTCTime, UTCTime, Maybe BoolInt, BoolInt, BoolInt)
    :. (Maybe Int, Maybe UTCTime))
itemRow ((SMsgDirection d, UTCTime, CIContent d, MemberName, MemberName,
  CIStatus d, Maybe MsgContentTag, Maybe SharedMsgId,
  Maybe ChatItemId, BoolInt)
 :. ((UTCTime, UTCTime, Maybe BoolInt, BoolInt, BoolInt)
     :. (Maybe Int, Maybe UTCTime)))
-> ((Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent,
     Maybe BoolInt, Maybe MemberId)
    :. ChatItemForwardedFromRow)
-> ((SMsgDirection d, UTCTime, CIContent d, MemberName, MemberName,
     CIStatus d, Maybe MsgContentTag, Maybe SharedMsgId,
     Maybe ChatItemId, BoolInt)
    :. ((UTCTime, UTCTime, Maybe BoolInt, BoolInt, BoolInt)
        :. (Maybe Int, Maybe UTCTime)))
   :. ((Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent,
        Maybe BoolInt, Maybe MemberId)
       :. ChatItemForwardedFromRow)
forall h t. h -> t -> h :. t
:. (Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe BoolInt,
 Maybe MemberId)
quoteRow' (Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe BoolInt,
 Maybe MemberId)
-> ChatItemForwardedFromRow
-> (Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent,
    Maybe BoolInt, Maybe MemberId)
   :. ChatItemForwardedFromRow
forall h t. h -> t -> h :. t
:. ChatItemForwardedFromRow
forwardedFromRow)
  ChatItemId
ciId <- Connection -> IO ChatItemId
insertedRowId Connection
db
  Maybe ChatItemId -> (ChatItemId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe ChatItemId
msgId_ ((ChatItemId -> IO ()) -> IO ()) -> (ChatItemId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ChatItemId
msgId -> Connection -> ChatItemId -> ChatItemId -> UTCTime -> IO ()
insertChatItemMessage_ Connection
db ChatItemId
ciId ChatItemId
msgId UTCTime
createdAt
  ChatItemId -> IO ChatItemId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatItemId
ciId
  where
    itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, Text, CIStatus d, Maybe MsgContentTag, Maybe SharedMsgId, Maybe GroupMemberId, BoolInt) :. (UTCTime, UTCTime, Maybe BoolInt, BoolInt, BoolInt) :. (Maybe Int, Maybe UTCTime)
    itemRow :: (SMsgDirection d, UTCTime, CIContent d, MemberName, MemberName,
 CIStatus d, Maybe MsgContentTag, Maybe SharedMsgId,
 Maybe ChatItemId, BoolInt)
:. ((UTCTime, UTCTime, Maybe BoolInt, BoolInt, BoolInt)
    :. (Maybe Int, Maybe UTCTime))
itemRow = (forall (d :: MsgDirection). MsgDirectionI d => SMsgDirection d
msgDirection @d, UTCTime
itemTs, CIContent d
ciContent, CIContent d -> MemberName
forall (e :: MsgDirection). CIContent e -> MemberName
toCIContentTag CIContent d
ciContent, CIContent d -> MemberName
forall (e :: MsgDirection). CIContent e -> MemberName
ciContentToText CIContent d
ciContent, CIContent d -> CIStatus d
forall (d :: MsgDirection).
MsgDirectionI d =>
CIContent d -> CIStatus d
ciCreateStatus CIContent d
ciContent, MsgContent -> MsgContentTag
msgContentTag (MsgContent -> MsgContentTag)
-> Maybe MsgContent -> Maybe MsgContentTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CIContent d -> Maybe MsgContent
forall (d :: MsgDirection). CIContent d -> Maybe MsgContent
ciMsgContent CIContent d
ciContent, Maybe SharedMsgId
sharedMsgId, Maybe ChatItemId
forwardedByMember, Bool -> BoolInt
BI Bool
includeInHistory) (SMsgDirection d, UTCTime, CIContent d, MemberName, MemberName,
 CIStatus d, Maybe MsgContentTag, Maybe SharedMsgId,
 Maybe ChatItemId, BoolInt)
-> ((UTCTime, UTCTime, Maybe BoolInt, BoolInt, BoolInt)
    :. (Maybe Int, Maybe UTCTime))
-> (SMsgDirection d, UTCTime, CIContent d, MemberName, MemberName,
    CIStatus d, Maybe MsgContentTag, Maybe SharedMsgId,
    Maybe ChatItemId, BoolInt)
   :. ((UTCTime, UTCTime, Maybe BoolInt, BoolInt, BoolInt)
       :. (Maybe Int, Maybe UTCTime))
forall h t. h -> t -> h :. t
:. (UTCTime
createdAt, UTCTime
createdAt, Bool -> BoolInt
BI (Bool -> BoolInt) -> Maybe Bool -> Maybe BoolInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> Maybe Bool
justTrue Bool
live), Bool -> BoolInt
BI Bool
userMention, Bool -> BoolInt
BI Bool
showGroupAsSender) (UTCTime, UTCTime, Maybe BoolInt, BoolInt, BoolInt)
-> (Maybe Int, Maybe UTCTime)
-> (UTCTime, UTCTime, Maybe BoolInt, BoolInt, BoolInt)
   :. (Maybe Int, Maybe UTCTime)
forall h t. h -> t -> h :. t
:. Maybe CITimed -> (Maybe Int, Maybe UTCTime)
ciTimedRow Maybe CITimed
timed
    quoteRow' :: (Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe BoolInt,
 Maybe MemberId)
quoteRow' = let (Maybe SharedMsgId
a, Maybe UTCTime
b, Maybe MsgContent
c, Maybe Bool
d, Maybe MemberId
e) = NewQuoteRow
quoteRow in (Maybe SharedMsgId
a, Maybe UTCTime
b, Maybe MsgContent
c, Bool -> BoolInt
BI (Bool -> BoolInt) -> Maybe Bool -> Maybe BoolInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
d, Maybe MemberId
e)
    idsRow :: (Maybe ContactId, Maybe GroupId, Maybe GroupMemberId, Maybe NoteFolderId)
    idsRow :: (Maybe ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
 Maybe ChatItemId)
idsRow = case ChatDirection c d
chatDirection of
      CDDirectRcv Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} -> (ChatItemId -> Maybe ChatItemId
forall a. a -> Maybe a
Just ChatItemId
contactId, Maybe ChatItemId
forall a. Maybe a
Nothing, Maybe ChatItemId
forall a. Maybe a
Nothing, Maybe ChatItemId
forall a. Maybe a
Nothing)
      CDDirectSnd Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} -> (ChatItemId -> Maybe ChatItemId
forall a. a -> Maybe a
Just ChatItemId
contactId, Maybe ChatItemId
forall a. Maybe a
Nothing, Maybe ChatItemId
forall a. Maybe a
Nothing, Maybe ChatItemId
forall a. Maybe a
Nothing)
      CDGroupRcv GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} Maybe GroupChatScopeInfo
_ GroupMember {ChatItemId
groupMemberId :: GroupMember -> ChatItemId
groupMemberId :: ChatItemId
groupMemberId} -> (Maybe ChatItemId
forall a. Maybe a
Nothing, ChatItemId -> Maybe ChatItemId
forall a. a -> Maybe a
Just ChatItemId
groupId, ChatItemId -> Maybe ChatItemId
forall a. a -> Maybe a
Just ChatItemId
groupMemberId, Maybe ChatItemId
forall a. Maybe a
Nothing)
      CDGroupSnd GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} Maybe GroupChatScopeInfo
_ -> (Maybe ChatItemId
forall a. Maybe a
Nothing, ChatItemId -> Maybe ChatItemId
forall a. a -> Maybe a
Just ChatItemId
groupId, Maybe ChatItemId
forall a. Maybe a
Nothing, Maybe ChatItemId
forall a. Maybe a
Nothing)
      CDLocalRcv NoteFolder {ChatItemId
noteFolderId :: NoteFolder -> ChatItemId
noteFolderId :: ChatItemId
noteFolderId} -> (Maybe ChatItemId
forall a. Maybe a
Nothing, Maybe ChatItemId
forall a. Maybe a
Nothing, Maybe ChatItemId
forall a. Maybe a
Nothing, ChatItemId -> Maybe ChatItemId
forall a. a -> Maybe a
Just ChatItemId
noteFolderId)
      CDLocalSnd NoteFolder {ChatItemId
noteFolderId :: NoteFolder -> ChatItemId
noteFolderId :: ChatItemId
noteFolderId} -> (Maybe ChatItemId
forall a. Maybe a
Nothing, Maybe ChatItemId
forall a. Maybe a
Nothing, Maybe ChatItemId
forall a. Maybe a
Nothing, ChatItemId -> Maybe ChatItemId
forall a. a -> Maybe a
Just ChatItemId
noteFolderId)
    groupScope :: Maybe (Maybe GroupChatScopeInfo)
    groupScope :: Maybe (Maybe GroupChatScopeInfo)
groupScope = case ChatDirection c d
chatDirection of
      CDGroupRcv GroupInfo
_ Maybe GroupChatScopeInfo
scope GroupMember
_ -> Maybe GroupChatScopeInfo -> Maybe (Maybe GroupChatScopeInfo)
forall a. a -> Maybe a
Just Maybe GroupChatScopeInfo
scope
      CDGroupSnd GroupInfo
_ Maybe GroupChatScopeInfo
scope -> Maybe GroupChatScopeInfo -> Maybe (Maybe GroupChatScopeInfo)
forall a. a -> Maybe a
Just Maybe GroupChatScopeInfo
scope
      ChatDirection c d
_ -> Maybe (Maybe GroupChatScopeInfo)
forall a. Maybe a
Nothing
    groupScopeRow :: (Maybe GroupChatScopeTag, Maybe GroupMemberId)
    groupScopeRow :: (Maybe GroupChatScopeTag, Maybe ChatItemId)
groupScopeRow = case Maybe (Maybe GroupChatScopeInfo)
groupScope of
      Just (Just GCSIMemberSupport {Maybe GroupMember
groupMember_ :: GroupChatScopeInfo -> Maybe GroupMember
groupMember_ :: Maybe GroupMember
groupMember_}) -> (GroupChatScopeTag -> Maybe GroupChatScopeTag
forall a. a -> Maybe a
Just GroupChatScopeTag
GCSTMemberSupport_, GroupMember -> ChatItemId
groupMemberId' (GroupMember -> ChatItemId)
-> Maybe GroupMember -> Maybe ChatItemId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GroupMember
groupMember_)
      Maybe (Maybe GroupChatScopeInfo)
_ -> (Maybe GroupChatScopeTag
forall a. Maybe a
Nothing, Maybe ChatItemId
forall a. Maybe a
Nothing)
    includeInHistory :: Bool
    includeInHistory :: Bool
includeInHistory = case Maybe (Maybe GroupChatScopeInfo)
groupScope of
      Just Maybe GroupChatScopeInfo
Nothing -> Maybe MsgContent -> Bool
forall a. Maybe a -> Bool
isJust (CIContent d -> Maybe MsgContent
forall (d :: MsgDirection). CIContent d -> Maybe MsgContent
ciMsgContent CIContent d
ciContent) Bool -> Bool -> Bool
&& ((MsgContent -> MsgContentTag
msgContentTag (MsgContent -> MsgContentTag)
-> Maybe MsgContent -> Maybe MsgContentTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CIContent d -> Maybe MsgContent
forall (d :: MsgDirection). CIContent d -> Maybe MsgContent
ciMsgContent CIContent d
ciContent) Maybe MsgContentTag -> Maybe MsgContentTag -> Bool
forall a. Eq a => a -> a -> Bool
/= MsgContentTag -> Maybe MsgContentTag
forall a. a -> Maybe a
Just MsgContentTag
MCReport_)
      Maybe (Maybe GroupChatScopeInfo)
_ -> Bool
False
    forwardedFromRow :: (Maybe CIForwardedFromTag, Maybe Text, Maybe MsgDirection, Maybe Int64, Maybe Int64, Maybe Int64)
    forwardedFromRow :: ChatItemForwardedFromRow
forwardedFromRow = case Maybe CIForwardedFrom
itemForwarded of
      Maybe CIForwardedFrom
Nothing ->
        (Maybe CIForwardedFromTag
forall a. Maybe a
Nothing, Maybe MemberName
forall a. Maybe a
Nothing, Maybe MsgDirection
forall a. Maybe a
Nothing, Maybe ChatItemId
forall a. Maybe a
Nothing, Maybe ChatItemId
forall a. Maybe a
Nothing, Maybe ChatItemId
forall a. Maybe a
Nothing)
      Just CIForwardedFrom
CIFFUnknown ->
        (CIForwardedFromTag -> Maybe CIForwardedFromTag
forall a. a -> Maybe a
Just CIForwardedFromTag
CIFFUnknown_, Maybe MemberName
forall a. Maybe a
Nothing, Maybe MsgDirection
forall a. Maybe a
Nothing, Maybe ChatItemId
forall a. Maybe a
Nothing, Maybe ChatItemId
forall a. Maybe a
Nothing, Maybe ChatItemId
forall a. Maybe a
Nothing)
      Just CIFFContact {MemberName
chatName :: MemberName
chatName :: CIForwardedFrom -> MemberName
chatName, MsgDirection
msgDir :: MsgDirection
msgDir :: CIForwardedFrom -> MsgDirection
msgDir, Maybe ChatItemId
contactId :: Maybe ChatItemId
contactId :: CIForwardedFrom -> Maybe ChatItemId
contactId, Maybe ChatItemId
chatItemId :: Maybe ChatItemId
chatItemId :: CIForwardedFrom -> Maybe ChatItemId
chatItemId} ->
        (CIForwardedFromTag -> Maybe CIForwardedFromTag
forall a. a -> Maybe a
Just CIForwardedFromTag
CIFFContact_, MemberName -> Maybe MemberName
forall a. a -> Maybe a
Just MemberName
chatName, MsgDirection -> Maybe MsgDirection
forall a. a -> Maybe a
Just MsgDirection
msgDir, Maybe ChatItemId
contactId, Maybe ChatItemId
forall a. Maybe a
Nothing, Maybe ChatItemId
chatItemId)
      Just CIFFGroup {MemberName
chatName :: CIForwardedFrom -> MemberName
chatName :: MemberName
chatName, MsgDirection
msgDir :: CIForwardedFrom -> MsgDirection
msgDir :: MsgDirection
msgDir, Maybe ChatItemId
groupId :: Maybe ChatItemId
groupId :: CIForwardedFrom -> Maybe ChatItemId
groupId, Maybe ChatItemId
chatItemId :: CIForwardedFrom -> Maybe ChatItemId
chatItemId :: Maybe ChatItemId
chatItemId} ->
        (CIForwardedFromTag -> Maybe CIForwardedFromTag
forall a. a -> Maybe a
Just CIForwardedFromTag
CIFFGroup_, MemberName -> Maybe MemberName
forall a. a -> Maybe a
Just MemberName
chatName, MsgDirection -> Maybe MsgDirection
forall a. a -> Maybe a
Just MsgDirection
msgDir, Maybe ChatItemId
forall a. Maybe a
Nothing, Maybe ChatItemId
groupId, Maybe ChatItemId
chatItemId)

ciTimedRow :: Maybe CITimed -> (Maybe Int, Maybe UTCTime)
ciTimedRow :: Maybe CITimed -> (Maybe Int, Maybe UTCTime)
ciTimedRow (Just CITimed {Int
ttl :: Int
ttl :: CITimed -> Int
ttl, Maybe UTCTime
deleteAt :: Maybe UTCTime
deleteAt :: CITimed -> Maybe UTCTime
deleteAt}) = (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
ttl, Maybe UTCTime
deleteAt)
ciTimedRow Maybe CITimed
_ = (Maybe Int
forall a. Maybe a
Nothing, Maybe UTCTime
forall a. Maybe a
Nothing)

insertChatItemMessage_ :: DB.Connection -> ChatItemId -> MessageId -> UTCTime -> IO ()
insertChatItemMessage_ :: Connection -> ChatItemId -> ChatItemId -> UTCTime -> IO ()
insertChatItemMessage_ Connection
db ChatItemId
ciId ChatItemId
msgId UTCTime
ts = Connection
-> Query -> (ChatItemId, ChatItemId, UTCTime, UTCTime) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"INSERT INTO chat_item_messages (chat_item_id, message_id, created_at, updated_at) VALUES (?,?,?,?)" (ChatItemId
ciId, ChatItemId
msgId, UTCTime
ts, UTCTime
ts)

getChatItemQuote_ :: ChatTypeQuotable c => DB.Connection -> User -> ChatDirection c 'MDRcv -> QuotedMsg -> IO (CIQuote c)
getChatItemQuote_ :: forall (c :: ChatType).
ChatTypeQuotable c =>
Connection
-> User -> ChatDirection c 'MDRcv -> QuotedMsg -> IO (CIQuote c)
getChatItemQuote_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId, ChatItemId
userContactId :: ChatItemId
userContactId :: User -> ChatItemId
userContactId} ChatDirection c 'MDRcv
chatDirection QuotedMsg {msgRef :: QuotedMsg -> MsgRef
msgRef = MsgRef {Maybe SharedMsgId
msgId :: MsgRef -> Maybe SharedMsgId
msgId :: Maybe SharedMsgId
msgId, UTCTime
sentAt :: MsgRef -> UTCTime
sentAt :: UTCTime
sentAt, Bool
sent :: MsgRef -> Bool
sent :: Bool
sent, Maybe MemberId
memberId :: MsgRef -> Maybe MemberId
memberId :: Maybe MemberId
memberId}, MsgContent
content :: QuotedMsg -> MsgContent
content :: MsgContent
content} =
  case ChatDirection c 'MDRcv
chatDirection of
    CDDirectRcv Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} -> ChatItemId -> Bool -> IO (CIQuote 'CTDirect)
getDirectChatItemQuote_ ChatItemId
contactId (Bool -> Bool
not Bool
sent)
    CDGroupRcv GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId, membership :: GroupInfo -> GroupMember
membership = GroupMember {memberId :: GroupMember -> MemberId
memberId = MemberId
userMemberId}} Maybe GroupChatScopeInfo
_s sender :: GroupMember
sender@GroupMember {groupMemberId :: GroupMember -> ChatItemId
groupMemberId = ChatItemId
senderGMId, memberId :: GroupMember -> MemberId
memberId = MemberId
senderMemberId} ->
      case Maybe MemberId
memberId of
        Just MemberId
mId
          | MemberId
mId MemberId -> MemberId -> Bool
forall a. Eq a => a -> a -> Bool
== MemberId
userMemberId -> (Maybe ChatItemId -> CIQDirection 'CTGroup -> CIQuote 'CTGroup
forall (c :: ChatType).
Maybe ChatItemId -> CIQDirection c -> CIQuote c
`ciQuote` CIQDirection 'CTGroup
CIQGroupSnd) (Maybe ChatItemId -> CIQuote c)
-> IO (Maybe ChatItemId) -> IO (CIQuote c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChatItemId -> IO (Maybe ChatItemId)
getUserGroupChatItemId_ ChatItemId
groupId
          | MemberId
mId MemberId -> MemberId -> Bool
forall a. Eq a => a -> a -> Bool
== MemberId
senderMemberId -> (Maybe ChatItemId -> CIQDirection 'CTGroup -> CIQuote 'CTGroup
forall (c :: ChatType).
Maybe ChatItemId -> CIQDirection c -> CIQuote c
`ciQuote` Maybe GroupMember -> CIQDirection 'CTGroup
CIQGroupRcv (GroupMember -> Maybe GroupMember
forall a. a -> Maybe a
Just GroupMember
sender)) (Maybe ChatItemId -> CIQuote c)
-> IO (Maybe ChatItemId) -> IO (CIQuote c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChatItemId -> ChatItemId -> IO (Maybe ChatItemId)
getGroupChatItemId_ ChatItemId
groupId ChatItemId
senderGMId
          | Bool
otherwise -> ChatItemId -> MemberId -> IO (CIQuote 'CTGroup)
getGroupChatItemQuote_ ChatItemId
groupId MemberId
mId
        Maybe MemberId
_ -> CIQuote c -> IO (CIQuote c)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CIQuote c -> IO (CIQuote c))
-> (CIQDirection 'CTGroup -> CIQuote c)
-> CIQDirection 'CTGroup
-> IO (CIQuote c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ChatItemId -> CIQDirection 'CTGroup -> CIQuote 'CTGroup
forall (c :: ChatType).
Maybe ChatItemId -> CIQDirection c -> CIQuote c
ciQuote Maybe ChatItemId
forall a. Maybe a
Nothing (CIQDirection 'CTGroup -> IO (CIQuote c))
-> CIQDirection 'CTGroup -> IO (CIQuote c)
forall a b. (a -> b) -> a -> b
$ Maybe GroupMember -> CIQDirection 'CTGroup
CIQGroupRcv Maybe GroupMember
forall a. Maybe a
Nothing
  where
    ciQuote :: Maybe ChatItemId -> CIQDirection c -> CIQuote c
    ciQuote :: forall (c :: ChatType).
Maybe ChatItemId -> CIQDirection c -> CIQuote c
ciQuote Maybe ChatItemId
itemId CIQDirection c
dir = CIQDirection c
-> Maybe ChatItemId
-> Maybe SharedMsgId
-> UTCTime
-> MsgContent
-> Maybe MarkdownList
-> CIQuote c
forall (c :: ChatType).
CIQDirection c
-> Maybe ChatItemId
-> Maybe SharedMsgId
-> UTCTime
-> MsgContent
-> Maybe MarkdownList
-> CIQuote c
CIQuote CIQDirection c
dir Maybe ChatItemId
itemId Maybe SharedMsgId
msgId UTCTime
sentAt MsgContent
content (Maybe MarkdownList -> CIQuote c)
-> (MemberName -> Maybe MarkdownList) -> MemberName -> CIQuote c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemberName -> Maybe MarkdownList
parseMaybeMarkdownList (MemberName -> CIQuote c) -> MemberName -> CIQuote c
forall a b. (a -> b) -> a -> b
$ MsgContent -> MemberName
msgContentText MsgContent
content
    getDirectChatItemQuote_ :: Int64 -> Bool -> IO (CIQuote 'CTDirect)
    getDirectChatItemQuote_ :: ChatItemId -> Bool -> IO (CIQuote 'CTDirect)
getDirectChatItemQuote_ ChatItemId
contactId Bool
userSent = do
      (Maybe ChatItemId -> CIQuote 'CTDirect)
-> IO (Maybe ChatItemId) -> IO (CIQuote 'CTDirect)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe ChatItemId -> CIQuote 'CTDirect
ciQuoteDirect (IO (Maybe ChatItemId) -> IO (CIQuote 'CTDirect))
-> (IO [Only ChatItemId] -> IO (Maybe ChatItemId))
-> IO [Only ChatItemId]
-> IO (CIQuote 'CTDirect)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only ChatItemId -> ChatItemId)
-> IO [Only ChatItemId] -> IO (Maybe ChatItemId)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly (IO [Only ChatItemId] -> IO (CIQuote 'CTDirect))
-> IO [Only ChatItemId] -> IO (CIQuote 'CTDirect)
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> (ChatItemId, ChatItemId, Maybe SharedMsgId, BoolInt)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          Query
"SELECT chat_item_id FROM chat_items WHERE user_id = ? AND contact_id = ? AND shared_msg_id = ? AND item_sent = ?"
          (ChatItemId
userId, ChatItemId
contactId, Maybe SharedMsgId
msgId, Bool -> BoolInt
BI Bool
userSent)
      where
        ciQuoteDirect :: Maybe ChatItemId -> CIQuote 'CTDirect
        ciQuoteDirect :: Maybe ChatItemId -> CIQuote 'CTDirect
ciQuoteDirect = (Maybe ChatItemId -> CIQDirection 'CTDirect -> CIQuote 'CTDirect
forall (c :: ChatType).
Maybe ChatItemId -> CIQDirection c -> CIQuote c
`ciQuote` if Bool
userSent then CIQDirection 'CTDirect
CIQDirectSnd else CIQDirection 'CTDirect
CIQDirectRcv)
    getUserGroupChatItemId_ :: Int64 -> IO (Maybe ChatItemId)
    getUserGroupChatItemId_ :: ChatItemId -> IO (Maybe ChatItemId)
getUserGroupChatItemId_ ChatItemId
groupId =
      (Only ChatItemId -> ChatItemId)
-> IO [Only ChatItemId] -> IO (Maybe ChatItemId)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly (IO [Only ChatItemId] -> IO (Maybe ChatItemId))
-> IO [Only ChatItemId] -> IO (Maybe ChatItemId)
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> (ChatItemId, ChatItemId, Maybe SharedMsgId, MsgDirection)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          Query
"SELECT chat_item_id FROM chat_items WHERE user_id = ? AND group_id = ? AND shared_msg_id = ? AND item_sent = ? AND group_member_id IS NULL"
          (ChatItemId
userId, ChatItemId
groupId, Maybe SharedMsgId
msgId, MsgDirection
MDSnd)
    getGroupChatItemId_ :: Int64 -> GroupMemberId -> IO (Maybe ChatItemId)
    getGroupChatItemId_ :: ChatItemId -> ChatItemId -> IO (Maybe ChatItemId)
getGroupChatItemId_ ChatItemId
groupId ChatItemId
groupMemberId =
      (Only ChatItemId -> ChatItemId)
-> IO [Only ChatItemId] -> IO (Maybe ChatItemId)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly (IO [Only ChatItemId] -> IO (Maybe ChatItemId))
-> IO [Only ChatItemId] -> IO (Maybe ChatItemId)
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> (ChatItemId, ChatItemId, Maybe SharedMsgId, MsgDirection,
    ChatItemId)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          Query
"SELECT chat_item_id FROM chat_items WHERE user_id = ? AND group_id = ? AND shared_msg_id = ? AND item_sent = ? AND group_member_id = ?"
          (ChatItemId
userId, ChatItemId
groupId, Maybe SharedMsgId
msgId, MsgDirection
MDRcv, ChatItemId
groupMemberId)
    getGroupChatItemQuote_ :: Int64 -> MemberId -> IO (CIQuote 'CTGroup)
    getGroupChatItemQuote_ :: ChatItemId -> MemberId -> IO (CIQuote 'CTGroup)
getGroupChatItemQuote_ ChatItemId
groupId MemberId
mId = do
      [Only (Maybe ChatItemId) :. GroupMemberRow] -> CIQuote 'CTGroup
ciQuoteGroup
        ([Only (Maybe ChatItemId) :. GroupMemberRow] -> CIQuote 'CTGroup)
-> IO [Only (Maybe ChatItemId) :. GroupMemberRow]
-> IO (CIQuote 'CTGroup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (Maybe SharedMsgId, ChatItemId, ChatItemId, MemberId)
-> IO [Only (Maybe ChatItemId) :. GroupMemberRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT i.chat_item_id,
              -- GroupMember
              m.group_member_id, m.group_id, m.index_in_group, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
              m.member_status, m.show_messages, m.member_restriction, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
              p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
              m.created_at, m.updated_at,
              m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts
            FROM group_members m
            JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
            LEFT JOIN contacts c ON m.contact_id = c.contact_id
            LEFT JOIN chat_items i ON i.user_id = m.user_id
                                      AND i.group_id = m.group_id
                                      AND m.group_member_id = i.group_member_id
                                      AND i.shared_msg_id = ?
            WHERE m.user_id = ? AND m.group_id = ? AND m.member_id = ?
          |]
          (Maybe SharedMsgId
msgId, ChatItemId
userId, ChatItemId
groupId, MemberId
mId)
      where
        ciQuoteGroup :: [Only (Maybe ChatItemId) :. GroupMemberRow] -> CIQuote 'CTGroup
        ciQuoteGroup :: [Only (Maybe ChatItemId) :. GroupMemberRow] -> CIQuote 'CTGroup
ciQuoteGroup [] = Maybe ChatItemId -> CIQDirection 'CTGroup -> CIQuote 'CTGroup
forall (c :: ChatType).
Maybe ChatItemId -> CIQDirection c -> CIQuote c
ciQuote Maybe ChatItemId
forall a. Maybe a
Nothing (CIQDirection 'CTGroup -> CIQuote 'CTGroup)
-> CIQDirection 'CTGroup -> CIQuote 'CTGroup
forall a b. (a -> b) -> a -> b
$ Maybe GroupMember -> CIQDirection 'CTGroup
CIQGroupRcv Maybe GroupMember
forall a. Maybe a
Nothing
        ciQuoteGroup ((Only Maybe ChatItemId
itemId :. GroupMemberRow
memberRow) : [Only (Maybe ChatItemId) :. GroupMemberRow]
_) = Maybe ChatItemId -> CIQDirection 'CTGroup -> CIQuote 'CTGroup
forall (c :: ChatType).
Maybe ChatItemId -> CIQDirection c -> CIQuote c
ciQuote Maybe ChatItemId
itemId (CIQDirection 'CTGroup -> CIQuote 'CTGroup)
-> (GroupMember -> CIQDirection 'CTGroup)
-> GroupMember
-> CIQuote 'CTGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe GroupMember -> CIQDirection 'CTGroup
CIQGroupRcv (Maybe GroupMember -> CIQDirection 'CTGroup)
-> (GroupMember -> Maybe GroupMember)
-> GroupMember
-> CIQDirection 'CTGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupMember -> Maybe GroupMember
forall a. a -> Maybe a
Just (GroupMember -> CIQuote 'CTGroup)
-> GroupMember -> CIQuote 'CTGroup
forall a b. (a -> b) -> a -> b
$ ChatItemId -> GroupMemberRow -> GroupMember
toGroupMember ChatItemId
userContactId GroupMemberRow
memberRow

getChatPreviews :: DB.Connection -> VersionRangeChat -> User -> Bool -> PaginationByTime -> ChatListQuery -> IO [Either StoreError AChat]
getChatPreviews :: Connection
-> VersionRangeChat
-> User
-> Bool
-> PaginationByTime
-> ChatListQuery
-> IO [Either StoreError AChat]
getChatPreviews Connection
db VersionRangeChat
vr User
user Bool
withPCC PaginationByTime
pagination ChatListQuery
query = do
  [AChatPreviewData]
directChats <- Connection
-> User
-> PaginationByTime
-> ChatListQuery
-> IO [AChatPreviewData]
findDirectChatPreviews_ Connection
db User
user PaginationByTime
pagination ChatListQuery
query
  [AChatPreviewData]
groupChats <- Connection
-> User
-> PaginationByTime
-> ChatListQuery
-> IO [AChatPreviewData]
findGroupChatPreviews_ Connection
db User
user PaginationByTime
pagination ChatListQuery
query
  [AChatPreviewData]
localChats <- Connection
-> User
-> PaginationByTime
-> ChatListQuery
-> IO [AChatPreviewData]
findLocalChatPreviews_ Connection
db User
user PaginationByTime
pagination ChatListQuery
query
  [AChatPreviewData]
cReqChats <- Connection
-> User
-> PaginationByTime
-> ChatListQuery
-> IO [AChatPreviewData]
getContactRequestChatPreviews_ Connection
db User
user PaginationByTime
pagination ChatListQuery
query
  [AChatPreviewData]
connChats <- if Bool
withPCC then Connection
-> User
-> PaginationByTime
-> ChatListQuery
-> IO [AChatPreviewData]
getContactConnectionChatPreviews_ Connection
db User
user PaginationByTime
pagination ChatListQuery
query else [AChatPreviewData] -> IO [AChatPreviewData]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  let refs :: [AChatPreviewData]
refs = [AChatPreviewData] -> [AChatPreviewData]
sortTake ([AChatPreviewData] -> [AChatPreviewData])
-> [AChatPreviewData] -> [AChatPreviewData]
forall a b. (a -> b) -> a -> b
$ [[AChatPreviewData]] -> [AChatPreviewData]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[AChatPreviewData]
directChats, [AChatPreviewData]
groupChats, [AChatPreviewData]
localChats, [AChatPreviewData]
cReqChats, [AChatPreviewData]
connChats]
  (AChatPreviewData -> IO (Either StoreError AChat))
-> [AChatPreviewData] -> IO [Either StoreError AChat]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ExceptT StoreError IO AChat -> IO (Either StoreError AChat)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO AChat -> IO (Either StoreError AChat))
-> (AChatPreviewData -> ExceptT StoreError IO AChat)
-> AChatPreviewData
-> IO (Either StoreError AChat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AChatPreviewData -> ExceptT StoreError IO AChat
getChatPreview) [AChatPreviewData]
refs
  where
    ts :: AChatPreviewData -> UTCTime
    ts :: AChatPreviewData -> UTCTime
ts (ACPD SChatType c
_ ChatPreviewData c
cpd) = case ChatPreviewData c
cpd of
      (DirectChatPD UTCTime
t ChatItemId
_ Maybe ChatItemId
_ ChatStats
_) -> UTCTime
t
      (GroupChatPD UTCTime
t ChatItemId
_ Maybe ChatItemId
_ ChatStats
_) -> UTCTime
t
      (LocalChatPD UTCTime
t ChatItemId
_ Maybe ChatItemId
_ ChatStats
_) -> UTCTime
t
      (ContactRequestPD UTCTime
t AChat
_) -> UTCTime
t
      (ContactConnectionPD UTCTime
t AChat
_) -> UTCTime
t
    sortTake :: [AChatPreviewData] -> [AChatPreviewData]
sortTake = case PaginationByTime
pagination of
      PTLast Int
count -> Int -> [AChatPreviewData] -> [AChatPreviewData]
forall a. Int -> [a] -> [a]
take Int
count ([AChatPreviewData] -> [AChatPreviewData])
-> ([AChatPreviewData] -> [AChatPreviewData])
-> [AChatPreviewData]
-> [AChatPreviewData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AChatPreviewData -> AChatPreviewData -> Ordering)
-> [AChatPreviewData] -> [AChatPreviewData]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((AChatPreviewData -> Down UTCTime)
-> AChatPreviewData -> AChatPreviewData -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((AChatPreviewData -> Down UTCTime)
 -> AChatPreviewData -> AChatPreviewData -> Ordering)
-> (AChatPreviewData -> Down UTCTime)
-> AChatPreviewData
-> AChatPreviewData
-> Ordering
forall a b. (a -> b) -> a -> b
$ UTCTime -> Down UTCTime
forall a. a -> Down a
Down (UTCTime -> Down UTCTime)
-> (AChatPreviewData -> UTCTime)
-> AChatPreviewData
-> Down UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AChatPreviewData -> UTCTime
ts)
      PTAfter UTCTime
_ Int
count -> [AChatPreviewData] -> [AChatPreviewData]
forall a. [a] -> [a]
reverse ([AChatPreviewData] -> [AChatPreviewData])
-> ([AChatPreviewData] -> [AChatPreviewData])
-> [AChatPreviewData]
-> [AChatPreviewData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [AChatPreviewData] -> [AChatPreviewData]
forall a. Int -> [a] -> [a]
take Int
count ([AChatPreviewData] -> [AChatPreviewData])
-> ([AChatPreviewData] -> [AChatPreviewData])
-> [AChatPreviewData]
-> [AChatPreviewData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AChatPreviewData -> AChatPreviewData -> Ordering)
-> [AChatPreviewData] -> [AChatPreviewData]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((AChatPreviewData -> UTCTime)
-> AChatPreviewData -> AChatPreviewData -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing AChatPreviewData -> UTCTime
ts)
      PTBefore UTCTime
_ Int
count -> Int -> [AChatPreviewData] -> [AChatPreviewData]
forall a. Int -> [a] -> [a]
take Int
count ([AChatPreviewData] -> [AChatPreviewData])
-> ([AChatPreviewData] -> [AChatPreviewData])
-> [AChatPreviewData]
-> [AChatPreviewData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AChatPreviewData -> AChatPreviewData -> Ordering)
-> [AChatPreviewData] -> [AChatPreviewData]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((AChatPreviewData -> Down UTCTime)
-> AChatPreviewData -> AChatPreviewData -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((AChatPreviewData -> Down UTCTime)
 -> AChatPreviewData -> AChatPreviewData -> Ordering)
-> (AChatPreviewData -> Down UTCTime)
-> AChatPreviewData
-> AChatPreviewData
-> Ordering
forall a b. (a -> b) -> a -> b
$ UTCTime -> Down UTCTime
forall a. a -> Down a
Down (UTCTime -> Down UTCTime)
-> (AChatPreviewData -> UTCTime)
-> AChatPreviewData
-> Down UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AChatPreviewData -> UTCTime
ts)
    getChatPreview :: AChatPreviewData -> ExceptT StoreError IO AChat
    getChatPreview :: AChatPreviewData -> ExceptT StoreError IO AChat
getChatPreview (ACPD SChatType c
cType ChatPreviewData c
cpd) = case SChatType c
cType of
      SChatType c
SCTDirect -> Connection
-> VersionRangeChat
-> User
-> ChatPreviewData 'CTDirect
-> ExceptT StoreError IO AChat
getDirectChatPreview_ Connection
db VersionRangeChat
vr User
user ChatPreviewData c
ChatPreviewData 'CTDirect
cpd
      SChatType c
SCTGroup -> Connection
-> VersionRangeChat
-> User
-> ChatPreviewData 'CTGroup
-> ExceptT StoreError IO AChat
getGroupChatPreview_ Connection
db VersionRangeChat
vr User
user ChatPreviewData c
ChatPreviewData 'CTGroup
cpd
      SChatType c
SCTLocal -> Connection
-> User -> ChatPreviewData 'CTLocal -> ExceptT StoreError IO AChat
getLocalChatPreview_ Connection
db User
user ChatPreviewData c
ChatPreviewData 'CTLocal
cpd
      SChatType c
SCTContactRequest -> let (ContactRequestPD UTCTime
_ AChat
chat) = ChatPreviewData c
cpd in AChat -> ExceptT StoreError IO AChat
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AChat
chat
      SChatType c
SCTContactConnection -> let (ContactConnectionPD UTCTime
_ AChat
chat) = ChatPreviewData c
cpd in AChat -> ExceptT StoreError IO AChat
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AChat
chat

data ChatPreviewData (c :: ChatType) where
  DirectChatPD :: UTCTime -> ContactId -> Maybe ChatItemId -> ChatStats -> ChatPreviewData 'CTDirect
  GroupChatPD :: UTCTime -> GroupId -> Maybe ChatItemId -> ChatStats -> ChatPreviewData 'CTGroup
  LocalChatPD :: UTCTime -> NoteFolderId -> Maybe ChatItemId -> ChatStats -> ChatPreviewData 'CTLocal
  ContactRequestPD :: UTCTime -> AChat -> ChatPreviewData 'CTContactRequest
  ContactConnectionPD :: UTCTime -> AChat -> ChatPreviewData 'CTContactConnection

data AChatPreviewData = forall c. ChatTypeI c => ACPD (SChatType c) (ChatPreviewData c)

type ChatStatsRow = (Int, ChatItemId, BoolInt)

toChatStats :: ChatStatsRow -> ChatStats
toChatStats :: ChatStatsRow -> ChatStats
toChatStats (Int
unreadCount, ChatItemId
minUnreadItemId, BI Bool
unreadChat) =
  ChatStats {Int
unreadCount :: Int
unreadCount :: Int
unreadCount, unreadMentions :: Int
unreadMentions = Int
0, reportsCount :: Int
reportsCount = Int
0, ChatItemId
minUnreadItemId :: ChatItemId
minUnreadItemId :: ChatItemId
minUnreadItemId, Bool
unreadChat :: Bool
unreadChat :: Bool
unreadChat}

type GroupStatsRow = (Int, Int, Int, ChatItemId, BoolInt)

toGroupStats :: GroupStatsRow -> ChatStats
toGroupStats :: GroupStatsRow -> ChatStats
toGroupStats (Int
unreadCount, Int
unreadMentions, Int
reportsCount, ChatItemId
minUnreadItemId, BI Bool
unreadChat) =
  ChatStats {Int
unreadCount :: Int
unreadCount :: Int
unreadCount, Int
unreadMentions :: Int
unreadMentions :: Int
unreadMentions, Int
reportsCount :: Int
reportsCount :: Int
reportsCount, ChatItemId
minUnreadItemId :: ChatItemId
minUnreadItemId :: ChatItemId
minUnreadItemId, Bool
unreadChat :: Bool
unreadChat :: Bool
unreadChat}

findDirectChatPreviews_ :: DB.Connection -> User -> PaginationByTime -> ChatListQuery -> IO [AChatPreviewData]
findDirectChatPreviews_ :: Connection
-> User
-> PaginationByTime
-> ChatListQuery
-> IO [AChatPreviewData]
findDirectChatPreviews_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} PaginationByTime
pagination ChatListQuery
clq =
  (((ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow)
 -> AChatPreviewData)
-> [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
-> [AChatPreviewData]
forall a b. (a -> b) -> [a] -> [b]
map ((ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow)
-> AChatPreviewData
toPreview ([(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
 -> [AChatPreviewData])
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
-> IO [AChatPreviewData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
getPreviews
  where
    toPreview :: (ContactId, UTCTime, Maybe ChatItemId) :. ChatStatsRow -> AChatPreviewData
    toPreview :: ((ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow)
-> AChatPreviewData
toPreview ((ChatItemId
contactId, UTCTime
ts, Maybe ChatItemId
lastItemId_) :. ChatStatsRow
statsRow) =
      SChatType 'CTDirect
-> ChatPreviewData 'CTDirect -> AChatPreviewData
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> ChatPreviewData c -> AChatPreviewData
ACPD SChatType 'CTDirect
SCTDirect (ChatPreviewData 'CTDirect -> AChatPreviewData)
-> ChatPreviewData 'CTDirect -> AChatPreviewData
forall a b. (a -> b) -> a -> b
$ UTCTime
-> ChatItemId
-> Maybe ChatItemId
-> ChatStats
-> ChatPreviewData 'CTDirect
DirectChatPD UTCTime
ts ChatItemId
contactId Maybe ChatItemId
lastItemId_ (ChatStatsRow -> ChatStats
toChatStats ChatStatsRow
statsRow)
    baseQuery :: Query
baseQuery =
      [sql|
        SELECT
          ct.contact_id,
          ct.chat_ts,
          (
            SELECT chat_item_id
            FROM chat_items ci
            WHERE ci.user_id = ? AND ci.contact_id = ct.contact_id
            ORDER BY ci.created_at DESC
            LIMIT 1
          ) AS chat_item_id,
          COALESCE(ChatStats.UnreadCount, 0),
          COALESCE(ChatStats.MinUnread, 0),
          ct.unread_chat
        FROM contacts ct
        LEFT JOIN (
          SELECT contact_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
          FROM chat_items
          WHERE user_id = ? AND contact_id IS NOT NULL AND item_status = ?
          GROUP BY contact_id
        ) ChatStats ON ChatStats.contact_id = ct.contact_id
      |]
    baseParams :: (ChatItemId, ChatItemId, CIStatus 'MDRcv)
baseParams = (ChatItemId
userId, ChatItemId
userId, CIStatus 'MDRcv
CISRcvNew)
    getPreviews :: IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
getPreviews = case ChatListQuery
clq of
      CLQFilters {favorite :: ChatListQuery -> Bool
favorite = Bool
False, unread :: ChatListQuery -> Bool
unread = Bool
False} -> do
        let q :: Query
q = Query
baseQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE ct.user_id = ? AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used = 1"
            p :: (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
p = (ChatItemId, ChatItemId, CIStatus 'MDRcv)
baseParams (ChatItemId, ChatItemId, CIStatus 'MDRcv)
-> Only ChatItemId
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
forall h t. h -> t -> h :. t
:. ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
userId
        Query
-> ((ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId)
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
forall p.
ToRow p =>
Query
-> p
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
queryWithPagination Query
q (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
p
      CLQFilters {favorite :: ChatListQuery -> Bool
favorite = Bool
True, unread :: ChatListQuery -> Bool
unread = Bool
False} -> do
        let q :: Query
q =
              Query
baseQuery
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" "
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> [sql|
                      WHERE ct.user_id = ? AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used = 1
                        AND ct.favorite = 1
                   |]
            p :: (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
p = (ChatItemId, ChatItemId, CIStatus 'MDRcv)
baseParams (ChatItemId, ChatItemId, CIStatus 'MDRcv)
-> Only ChatItemId
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
forall h t. h -> t -> h :. t
:. ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
userId
        Query
-> ((ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId)
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
forall p.
ToRow p =>
Query
-> p
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
queryWithPagination Query
q (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
p
      CLQFilters {favorite :: ChatListQuery -> Bool
favorite = Bool
False, unread :: ChatListQuery -> Bool
unread = Bool
True} -> do
        let q :: Query
q =
              Query
baseQuery
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" "
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> [sql|
                      WHERE ct.user_id = ? AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used = 1
                        AND (ct.unread_chat = 1 OR ChatStats.UnreadCount > 0)
                   |]
            p :: (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
p = (ChatItemId, ChatItemId, CIStatus 'MDRcv)
baseParams (ChatItemId, ChatItemId, CIStatus 'MDRcv)
-> Only ChatItemId
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
forall h t. h -> t -> h :. t
:. ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
userId
        Query
-> ((ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId)
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
forall p.
ToRow p =>
Query
-> p
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
queryWithPagination Query
q (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
p
      CLQFilters {favorite :: ChatListQuery -> Bool
favorite = Bool
True, unread :: ChatListQuery -> Bool
unread = Bool
True} -> do
        let q :: Query
q =
              Query
baseQuery
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" "
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> [sql|
                      WHERE ct.user_id = ? AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used = 1
                        AND (ct.favorite = 1
                          OR ct.unread_chat = 1 OR ChatStats.UnreadCount > 0)
                   |]
            p :: (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
p = (ChatItemId, ChatItemId, CIStatus 'MDRcv)
baseParams (ChatItemId, ChatItemId, CIStatus 'MDRcv)
-> Only ChatItemId
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
forall h t. h -> t -> h :. t
:. ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
userId
        Query
-> ((ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId)
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
forall p.
ToRow p =>
Query
-> p
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
queryWithPagination Query
q (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
p
      CLQSearch {FilePath
search :: FilePath
search :: ChatListQuery -> FilePath
search} -> do
        let q :: Query
q =
              Query
baseQuery
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" "
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> [sql|
                      JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
                      WHERE ct.user_id = ? AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used = 1
                        AND (
                          LOWER(ct.local_display_name) LIKE '%' || ? || '%'
                          OR LOWER(cp.display_name) LIKE '%' || ? || '%'
                          OR LOWER(cp.full_name) LIKE '%' || ? || '%'
                          OR LOWER(cp.short_descr) LIKE '%' || ? || '%'
                          OR LOWER(cp.local_alias) LIKE '%' || ? || '%'
                        )
                   |]
            s :: FilePath
s = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
search
            p :: (ChatItemId, ChatItemId, CIStatus 'MDRcv)
:. (ChatItemId, FilePath, FilePath, FilePath, FilePath, FilePath)
p = (ChatItemId, ChatItemId, CIStatus 'MDRcv)
baseParams (ChatItemId, ChatItemId, CIStatus 'MDRcv)
-> (ChatItemId, FilePath, FilePath, FilePath, FilePath, FilePath)
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv)
   :. (ChatItemId, FilePath, FilePath, FilePath, FilePath, FilePath)
forall h t. h -> t -> h :. t
:. (ChatItemId
userId, FilePath
s, FilePath
s, FilePath
s, FilePath
s, FilePath
s)
        Query
-> ((ChatItemId, ChatItemId, CIStatus 'MDRcv)
    :. (ChatItemId, FilePath, FilePath, FilePath, FilePath, FilePath))
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
forall p.
ToRow p =>
Query
-> p
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
queryWithPagination Query
q (ChatItemId, ChatItemId, CIStatus 'MDRcv)
:. (ChatItemId, FilePath, FilePath, FilePath, FilePath, FilePath)
p
    queryWithPagination :: ToRow p => Query -> p -> IO [(ContactId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
    queryWithPagination :: forall p.
ToRow p =>
Query
-> p
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
queryWithPagination Query
query p
params = case PaginationByTime
pagination of
      PTLast Int
count -> Connection
-> Query
-> (p :. Only Int)
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
query Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" ORDER BY ct.chat_ts DESC LIMIT ?") (p
params p -> Only Int -> p :. Only Int
forall h t. h -> t -> h :. t
:. Int -> Only Int
forall a. a -> Only a
Only Int
count)
      PTAfter UTCTime
ts Int
count -> Connection
-> Query
-> (p :. (UTCTime, Int))
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
query Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND ct.chat_ts > ? ORDER BY ct.chat_ts ASC LIMIT ?") (p
params p -> (UTCTime, Int) -> p :. (UTCTime, Int)
forall h t. h -> t -> h :. t
:. (UTCTime
ts, Int
count))
      PTBefore UTCTime
ts Int
count -> Connection
-> Query
-> (p :. (UTCTime, Int))
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
query Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND ct.chat_ts < ? ORDER BY ct.chat_ts DESC LIMIT ?") (p
params p -> (UTCTime, Int) -> p :. (UTCTime, Int)
forall h t. h -> t -> h :. t
:. (UTCTime
ts, Int
count))

getDirectChatPreview_ :: DB.Connection -> VersionRangeChat -> User -> ChatPreviewData 'CTDirect -> ExceptT StoreError IO AChat
getDirectChatPreview_ :: Connection
-> VersionRangeChat
-> User
-> ChatPreviewData 'CTDirect
-> ExceptT StoreError IO AChat
getDirectChatPreview_ Connection
db VersionRangeChat
vr User
user (DirectChatPD UTCTime
_ ChatItemId
contactId Maybe ChatItemId
lastItemId_ ChatStats
stats) = do
  Contact
contact <- Connection
-> VersionRangeChat
-> User
-> ChatItemId
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user ChatItemId
contactId
  UTCTime
ts <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  [CChatItem 'CTDirect]
lastItem <- case Maybe ChatItemId
lastItemId_ of
    Just ChatItemId
lastItemId -> do
      CChatItem 'CTDirect
previewItem <- IO (CChatItem 'CTDirect)
-> ExceptT StoreError IO (CChatItem 'CTDirect)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (CChatItem 'CTDirect)
 -> ExceptT StoreError IO (CChatItem 'CTDirect))
-> IO (CChatItem 'CTDirect)
-> ExceptT StoreError IO (CChatItem 'CTDirect)
forall a b. (a -> b) -> a -> b
$ Connection
-> User
-> Contact
-> UTCTime
-> ChatItemId
-> IO (CChatItem 'CTDirect)
safeGetDirectItem Connection
db User
user Contact
contact UTCTime
ts ChatItemId
lastItemId
      [CChatItem 'CTDirect]
-> ExceptT StoreError IO [CChatItem 'CTDirect]
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [CChatItem 'CTDirect
previewItem]
    Maybe ChatItemId
Nothing -> [CChatItem 'CTDirect]
-> ExceptT StoreError IO [CChatItem 'CTDirect]
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  AChat -> ExceptT StoreError IO AChat
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AChat -> ExceptT StoreError IO AChat)
-> AChat -> ExceptT StoreError IO AChat
forall a b. (a -> b) -> a -> b
$ SChatType 'CTDirect -> Chat 'CTDirect -> AChat
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> Chat c -> AChat
AChat SChatType 'CTDirect
SCTDirect (ChatInfo 'CTDirect
-> [CChatItem 'CTDirect] -> ChatStats -> Chat 'CTDirect
forall (c :: ChatType).
ChatInfo c -> [CChatItem c] -> ChatStats -> Chat c
Chat (Contact -> ChatInfo 'CTDirect
DirectChat Contact
contact) [CChatItem 'CTDirect]
lastItem ChatStats
stats)

findGroupChatPreviews_ :: DB.Connection -> User -> PaginationByTime -> ChatListQuery -> IO [AChatPreviewData]
findGroupChatPreviews_ :: Connection
-> User
-> PaginationByTime
-> ChatListQuery
-> IO [AChatPreviewData]
findGroupChatPreviews_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} PaginationByTime
pagination ChatListQuery
clq =
  (((ChatItemId, UTCTime, Maybe ChatItemId) :. GroupStatsRow)
 -> AChatPreviewData)
-> [(ChatItemId, UTCTime, Maybe ChatItemId) :. GroupStatsRow]
-> [AChatPreviewData]
forall a b. (a -> b) -> [a] -> [b]
map ((ChatItemId, UTCTime, Maybe ChatItemId) :. GroupStatsRow)
-> AChatPreviewData
toPreview ([(ChatItemId, UTCTime, Maybe ChatItemId) :. GroupStatsRow]
 -> [AChatPreviewData])
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. GroupStatsRow]
-> IO [AChatPreviewData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. GroupStatsRow]
getPreviews
  where
    toPreview :: (GroupId, UTCTime, Maybe ChatItemId) :. GroupStatsRow -> AChatPreviewData
    toPreview :: ((ChatItemId, UTCTime, Maybe ChatItemId) :. GroupStatsRow)
-> AChatPreviewData
toPreview ((ChatItemId
groupId, UTCTime
ts, Maybe ChatItemId
lastItemId_) :. GroupStatsRow
statsRow) =
      SChatType 'CTGroup -> ChatPreviewData 'CTGroup -> AChatPreviewData
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> ChatPreviewData c -> AChatPreviewData
ACPD SChatType 'CTGroup
SCTGroup (ChatPreviewData 'CTGroup -> AChatPreviewData)
-> ChatPreviewData 'CTGroup -> AChatPreviewData
forall a b. (a -> b) -> a -> b
$ UTCTime
-> ChatItemId
-> Maybe ChatItemId
-> ChatStats
-> ChatPreviewData 'CTGroup
GroupChatPD UTCTime
ts ChatItemId
groupId Maybe ChatItemId
lastItemId_ (GroupStatsRow -> ChatStats
toGroupStats GroupStatsRow
statsRow)
    baseQuery :: Query
baseQuery =
      [sql|
        SELECT
          g.group_id,
          g.chat_ts,
          (
            SELECT chat_item_id
            FROM chat_items ci
            WHERE ci.user_id = ? AND ci.group_id = g.group_id AND ci.group_scope_tag IS NULL AND ci.group_scope_group_member_id IS NULL
            ORDER BY ci.item_ts DESC
            LIMIT 1
          ) AS chat_item_id,
          COALESCE(ChatStats.UnreadCount, 0),
          COALESCE(ChatStats.UnreadMentions, 0),
          COALESCE(ReportCount.Count, 0),
          COALESCE(ChatStats.MinUnread, 0),
          g.unread_chat
        FROM groups g
        LEFT JOIN (
          SELECT group_id, COUNT(1) AS UnreadCount, SUM(user_mention) as UnreadMentions, MIN(chat_item_id) AS MinUnread
          FROM chat_items
          WHERE user_id = ? AND group_id IS NOT NULL AND group_scope_tag IS NULL AND group_scope_group_member_id IS NULL AND item_status = ?
          GROUP BY group_id
        ) ChatStats ON ChatStats.group_id = g.group_id
        LEFT JOIN (
          SELECT group_id, COUNT(1) AS Count
          FROM chat_items
          WHERE user_id = ? AND group_id IS NOT NULL
            AND msg_content_tag = ? AND item_deleted = ? AND item_sent = 0
          GROUP BY group_id
        ) ReportCount ON ReportCount.group_id = g.group_id
      |]
    baseParams :: (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
 MsgContentTag, BoolInt)
baseParams = (ChatItemId
userId, ChatItemId
userId, CIStatus 'MDRcv
CISRcvNew, ChatItemId
userId, MsgContentTag
MCReport_, Bool -> BoolInt
BI Bool
False)
    getPreviews :: IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. GroupStatsRow]
getPreviews = case ChatListQuery
clq of
      CLQFilters {favorite :: ChatListQuery -> Bool
favorite = Bool
False, unread :: ChatListQuery -> Bool
unread = Bool
False} -> do
        let q :: Query
q = Query
baseQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE g.user_id = ?"
            p :: (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
 MsgContentTag, BoolInt)
:. Only ChatItemId
p = (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
 MsgContentTag, BoolInt)
baseParams (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
 MsgContentTag, BoolInt)
-> Only ChatItemId
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
    MsgContentTag, BoolInt)
   :. Only ChatItemId
forall h t. h -> t -> h :. t
:. ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
userId
        Query
-> ((ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
     MsgContentTag, BoolInt)
    :. Only ChatItemId)
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. GroupStatsRow]
forall p.
ToRow p =>
Query
-> p
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. GroupStatsRow]
queryWithPagination Query
q (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
 MsgContentTag, BoolInt)
:. Only ChatItemId
p
      CLQFilters {favorite :: ChatListQuery -> Bool
favorite = Bool
True, unread :: ChatListQuery -> Bool
unread = Bool
False} -> do
        let q :: Query
q =
              Query
baseQuery
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" "
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> [sql|
                      WHERE g.user_id = ?
                        AND g.favorite = 1
                   |]
            p :: (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
 MsgContentTag, BoolInt)
:. Only ChatItemId
p = (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
 MsgContentTag, BoolInt)
baseParams (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
 MsgContentTag, BoolInt)
-> Only ChatItemId
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
    MsgContentTag, BoolInt)
   :. Only ChatItemId
forall h t. h -> t -> h :. t
:. ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
userId
        Query
-> ((ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
     MsgContentTag, BoolInt)
    :. Only ChatItemId)
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. GroupStatsRow]
forall p.
ToRow p =>
Query
-> p
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. GroupStatsRow]
queryWithPagination Query
q (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
 MsgContentTag, BoolInt)
:. Only ChatItemId
p
      CLQFilters {favorite :: ChatListQuery -> Bool
favorite = Bool
False, unread :: ChatListQuery -> Bool
unread = Bool
True} -> do
        let q :: Query
q =
              Query
baseQuery
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" "
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> [sql|
                      WHERE g.user_id = ?
                        AND (g.unread_chat = 1 OR ChatStats.UnreadCount > 0)
                   |]
            p :: (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
 MsgContentTag, BoolInt)
:. Only ChatItemId
p = (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
 MsgContentTag, BoolInt)
baseParams (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
 MsgContentTag, BoolInt)
-> Only ChatItemId
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
    MsgContentTag, BoolInt)
   :. Only ChatItemId
forall h t. h -> t -> h :. t
:. ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
userId
        Query
-> ((ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
     MsgContentTag, BoolInt)
    :. Only ChatItemId)
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. GroupStatsRow]
forall p.
ToRow p =>
Query
-> p
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. GroupStatsRow]
queryWithPagination Query
q (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
 MsgContentTag, BoolInt)
:. Only ChatItemId
p
      CLQFilters {favorite :: ChatListQuery -> Bool
favorite = Bool
True, unread :: ChatListQuery -> Bool
unread = Bool
True} -> do
        let q :: Query
q =
              Query
baseQuery
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" "
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> [sql|
                      WHERE g.user_id = ?
                        AND (g.favorite = 1
                          OR g.unread_chat = 1 OR ChatStats.UnreadCount > 0)
                   |]
            p :: (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
 MsgContentTag, BoolInt)
:. Only ChatItemId
p = (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
 MsgContentTag, BoolInt)
baseParams (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
 MsgContentTag, BoolInt)
-> Only ChatItemId
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
    MsgContentTag, BoolInt)
   :. Only ChatItemId
forall h t. h -> t -> h :. t
:. ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
userId
        Query
-> ((ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
     MsgContentTag, BoolInt)
    :. Only ChatItemId)
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. GroupStatsRow]
forall p.
ToRow p =>
Query
-> p
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. GroupStatsRow]
queryWithPagination Query
q (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
 MsgContentTag, BoolInt)
:. Only ChatItemId
p
      CLQSearch {FilePath
search :: ChatListQuery -> FilePath
search :: FilePath
search} -> do
        let q :: Query
q =
              Query
baseQuery
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" "
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> [sql|
                      JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
                      WHERE g.user_id = ?
                        AND (
                          LOWER(g.local_display_name) LIKE '%' || ? || '%'
                          OR LOWER(gp.display_name) LIKE '%' || ? || '%'
                          OR LOWER(gp.full_name) LIKE '%' || ? || '%'
                          OR LOWER(gp.short_descr) LIKE '%' || ? || '%'
                          OR LOWER(gp.description) LIKE '%' || ? || '%'
                        )
                   |]
            s :: FilePath
s = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
search
            p :: (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
 MsgContentTag, BoolInt)
:. (ChatItemId, FilePath, FilePath, FilePath, FilePath, FilePath)
p = (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
 MsgContentTag, BoolInt)
baseParams (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
 MsgContentTag, BoolInt)
-> (ChatItemId, FilePath, FilePath, FilePath, FilePath, FilePath)
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
    MsgContentTag, BoolInt)
   :. (ChatItemId, FilePath, FilePath, FilePath, FilePath, FilePath)
forall h t. h -> t -> h :. t
:. (ChatItemId
userId, FilePath
s, FilePath
s, FilePath
s, FilePath
s, FilePath
s)
        Query
-> ((ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
     MsgContentTag, BoolInt)
    :. (ChatItemId, FilePath, FilePath, FilePath, FilePath, FilePath))
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. GroupStatsRow]
forall p.
ToRow p =>
Query
-> p
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. GroupStatsRow]
queryWithPagination Query
q (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId,
 MsgContentTag, BoolInt)
:. (ChatItemId, FilePath, FilePath, FilePath, FilePath, FilePath)
p
    queryWithPagination :: ToRow p => Query -> p -> IO [(GroupId, UTCTime, Maybe ChatItemId) :. GroupStatsRow]
    queryWithPagination :: forall p.
ToRow p =>
Query
-> p
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. GroupStatsRow]
queryWithPagination Query
query p
params = case PaginationByTime
pagination of
      PTLast Int
count -> Connection
-> Query
-> (p :. Only Int)
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. GroupStatsRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
query Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" ORDER BY g.chat_ts DESC LIMIT ?") (p
params p -> Only Int -> p :. Only Int
forall h t. h -> t -> h :. t
:. Int -> Only Int
forall a. a -> Only a
Only Int
count)
      PTAfter UTCTime
ts Int
count -> Connection
-> Query
-> (p :. (UTCTime, Int))
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. GroupStatsRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
query Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND g.chat_ts > ? ORDER BY g.chat_ts ASC LIMIT ?") (p
params p -> (UTCTime, Int) -> p :. (UTCTime, Int)
forall h t. h -> t -> h :. t
:. (UTCTime
ts, Int
count))
      PTBefore UTCTime
ts Int
count -> Connection
-> Query
-> (p :. (UTCTime, Int))
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. GroupStatsRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
query Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND g.chat_ts < ? ORDER BY g.chat_ts DESC LIMIT ?") (p
params p -> (UTCTime, Int) -> p :. (UTCTime, Int)
forall h t. h -> t -> h :. t
:. (UTCTime
ts, Int
count))

getGroupChatPreview_ :: DB.Connection -> VersionRangeChat -> User -> ChatPreviewData 'CTGroup -> ExceptT StoreError IO AChat
getGroupChatPreview_ :: Connection
-> VersionRangeChat
-> User
-> ChatPreviewData 'CTGroup
-> ExceptT StoreError IO AChat
getGroupChatPreview_ Connection
db VersionRangeChat
vr User
user (GroupChatPD UTCTime
_ ChatItemId
groupId Maybe ChatItemId
lastItemId_ ChatStats
stats) = do
  GroupInfo
groupInfo <- Connection
-> VersionRangeChat
-> User
-> ChatItemId
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user ChatItemId
groupId
  UTCTime
ts <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  [CChatItem 'CTGroup]
lastItem <- case Maybe ChatItemId
lastItemId_ of
    Just ChatItemId
lastItemId -> do
      CChatItem 'CTGroup
previewItem <- IO (CChatItem 'CTGroup)
-> ExceptT StoreError IO (CChatItem 'CTGroup)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (CChatItem 'CTGroup)
 -> ExceptT StoreError IO (CChatItem 'CTGroup))
-> IO (CChatItem 'CTGroup)
-> ExceptT StoreError IO (CChatItem 'CTGroup)
forall a b. (a -> b) -> a -> b
$ Connection
-> User
-> GroupInfo
-> UTCTime
-> ChatItemId
-> IO (CChatItem 'CTGroup)
safeGetGroupItem Connection
db User
user GroupInfo
groupInfo UTCTime
ts ChatItemId
lastItemId
      [CChatItem 'CTGroup] -> ExceptT StoreError IO [CChatItem 'CTGroup]
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [CChatItem 'CTGroup
previewItem]
    Maybe ChatItemId
Nothing -> [CChatItem 'CTGroup] -> ExceptT StoreError IO [CChatItem 'CTGroup]
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  AChat -> ExceptT StoreError IO AChat
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AChat -> ExceptT StoreError IO AChat)
-> AChat -> ExceptT StoreError IO AChat
forall a b. (a -> b) -> a -> b
$ SChatType 'CTGroup -> Chat 'CTGroup -> AChat
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> Chat c -> AChat
AChat SChatType 'CTGroup
SCTGroup (ChatInfo 'CTGroup
-> [CChatItem 'CTGroup] -> ChatStats -> Chat 'CTGroup
forall (c :: ChatType).
ChatInfo c -> [CChatItem c] -> ChatStats -> Chat c
Chat (GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
groupInfo Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing) [CChatItem 'CTGroup]
lastItem ChatStats
stats)

findLocalChatPreviews_ :: DB.Connection -> User -> PaginationByTime -> ChatListQuery -> IO [AChatPreviewData]
findLocalChatPreviews_ :: Connection
-> User
-> PaginationByTime
-> ChatListQuery
-> IO [AChatPreviewData]
findLocalChatPreviews_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} PaginationByTime
pagination ChatListQuery
clq =
  (((ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow)
 -> AChatPreviewData)
-> [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
-> [AChatPreviewData]
forall a b. (a -> b) -> [a] -> [b]
map ((ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow)
-> AChatPreviewData
toPreview ([(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
 -> [AChatPreviewData])
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
-> IO [AChatPreviewData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
getPreviews
  where
    toPreview :: (NoteFolderId, UTCTime, Maybe ChatItemId) :. ChatStatsRow -> AChatPreviewData
    toPreview :: ((ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow)
-> AChatPreviewData
toPreview ((ChatItemId
noteFolderId, UTCTime
ts, Maybe ChatItemId
lastItemId_) :. ChatStatsRow
statsRow) =
      SChatType 'CTLocal -> ChatPreviewData 'CTLocal -> AChatPreviewData
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> ChatPreviewData c -> AChatPreviewData
ACPD SChatType 'CTLocal
SCTLocal (ChatPreviewData 'CTLocal -> AChatPreviewData)
-> ChatPreviewData 'CTLocal -> AChatPreviewData
forall a b. (a -> b) -> a -> b
$ UTCTime
-> ChatItemId
-> Maybe ChatItemId
-> ChatStats
-> ChatPreviewData 'CTLocal
LocalChatPD UTCTime
ts ChatItemId
noteFolderId Maybe ChatItemId
lastItemId_ (ChatStatsRow -> ChatStats
toChatStats ChatStatsRow
statsRow)
    baseQuery :: Query
baseQuery =
      [sql|
        SELECT
          nf.note_folder_id,
          nf.chat_ts,
          (
            SELECT chat_item_id
            FROM chat_items ci
            WHERE ci.user_id = ? AND ci.note_folder_id = nf.note_folder_id
            ORDER BY ci.created_at DESC
            LIMIT 1
          ) AS chat_item_id,
          COALESCE(ChatStats.UnreadCount, 0),
          COALESCE(ChatStats.MinUnread, 0),
          nf.unread_chat
        FROM note_folders nf
        LEFT JOIN (
          SELECT note_folder_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
          FROM chat_items
          WHERE user_id = ? AND note_folder_id IS NOT NULL AND item_status = ?
          GROUP BY note_folder_id
        ) ChatStats ON ChatStats.note_folder_id = nf.note_folder_id
      |]
    baseParams :: (ChatItemId, ChatItemId, CIStatus 'MDRcv)
baseParams = (ChatItemId
userId, ChatItemId
userId, CIStatus 'MDRcv
CISRcvNew)
    getPreviews :: IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
getPreviews = case ChatListQuery
clq of
      CLQFilters {favorite :: ChatListQuery -> Bool
favorite = Bool
False, unread :: ChatListQuery -> Bool
unread = Bool
False} -> do
        let q :: Query
q = Query
baseQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE nf.user_id = ?"
            p :: (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
p = (ChatItemId, ChatItemId, CIStatus 'MDRcv)
baseParams (ChatItemId, ChatItemId, CIStatus 'MDRcv)
-> Only ChatItemId
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
forall h t. h -> t -> h :. t
:. ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
userId
        Query
-> ((ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId)
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
forall p.
ToRow p =>
Query
-> p
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
queryWithPagination Query
q (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
p
      CLQFilters {favorite :: ChatListQuery -> Bool
favorite = Bool
True, unread :: ChatListQuery -> Bool
unread = Bool
False} -> do
        let q :: Query
q =
              Query
baseQuery
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" "
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> [sql|
                      WHERE nf.user_id = ?
                        AND nf.favorite = 1
                   |]
            p :: (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
p = (ChatItemId, ChatItemId, CIStatus 'MDRcv)
baseParams (ChatItemId, ChatItemId, CIStatus 'MDRcv)
-> Only ChatItemId
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
forall h t. h -> t -> h :. t
:. ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
userId
        Query
-> ((ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId)
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
forall p.
ToRow p =>
Query
-> p
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
queryWithPagination Query
q (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
p
      CLQFilters {favorite :: ChatListQuery -> Bool
favorite = Bool
False, unread :: ChatListQuery -> Bool
unread = Bool
True} -> do
        let q :: Query
q =
              Query
baseQuery
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" "
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> [sql|
                      WHERE nf.user_id = ?
                        AND (nf.unread_chat = 1 OR ChatStats.UnreadCount > 0)
                   |]
            p :: (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
p = (ChatItemId, ChatItemId, CIStatus 'MDRcv)
baseParams (ChatItemId, ChatItemId, CIStatus 'MDRcv)
-> Only ChatItemId
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
forall h t. h -> t -> h :. t
:. ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
userId
        Query
-> ((ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId)
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
forall p.
ToRow p =>
Query
-> p
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
queryWithPagination Query
q (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
p
      CLQFilters {favorite :: ChatListQuery -> Bool
favorite = Bool
True, unread :: ChatListQuery -> Bool
unread = Bool
True} -> do
        let q :: Query
q =
              Query
baseQuery
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" "
                Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> [sql|
                      WHERE nf.user_id = ?
                        AND (nf.favorite = 1
                          OR nf.unread_chat = 1 OR ChatStats.UnreadCount > 0)
                   |]
            p :: (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
p = (ChatItemId, ChatItemId, CIStatus 'MDRcv)
baseParams (ChatItemId, ChatItemId, CIStatus 'MDRcv)
-> Only ChatItemId
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
forall h t. h -> t -> h :. t
:. ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
userId
        Query
-> ((ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId)
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
forall p.
ToRow p =>
Query
-> p
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
queryWithPagination Query
q (ChatItemId, ChatItemId, CIStatus 'MDRcv) :. Only ChatItemId
p
      CLQSearch {} -> [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    queryWithPagination :: ToRow p => Query -> p -> IO [(NoteFolderId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
    queryWithPagination :: forall p.
ToRow p =>
Query
-> p
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
queryWithPagination Query
query p
params = case PaginationByTime
pagination of
      PTLast Int
count -> Connection
-> Query
-> (p :. Only Int)
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
query Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" ORDER BY nf.chat_ts DESC LIMIT ?") (p
params p -> Only Int -> p :. Only Int
forall h t. h -> t -> h :. t
:. Int -> Only Int
forall a. a -> Only a
Only Int
count)
      PTAfter UTCTime
ts Int
count -> Connection
-> Query
-> (p :. (UTCTime, Int))
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
query Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND nf.chat_ts > ? ORDER BY nf.chat_ts ASC LIMIT ?") (p
params p -> (UTCTime, Int) -> p :. (UTCTime, Int)
forall h t. h -> t -> h :. t
:. (UTCTime
ts, Int
count))
      PTBefore UTCTime
ts Int
count -> Connection
-> Query
-> (p :. (UTCTime, Int))
-> IO [(ChatItemId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
query Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND nf.chat_ts < ? ORDER BY nf.chat_ts DESC LIMIT ?") (p
params p -> (UTCTime, Int) -> p :. (UTCTime, Int)
forall h t. h -> t -> h :. t
:. (UTCTime
ts, Int
count))

getLocalChatPreview_ :: DB.Connection -> User -> ChatPreviewData 'CTLocal -> ExceptT StoreError IO AChat
getLocalChatPreview_ :: Connection
-> User -> ChatPreviewData 'CTLocal -> ExceptT StoreError IO AChat
getLocalChatPreview_ Connection
db User
user (LocalChatPD UTCTime
_ ChatItemId
noteFolderId Maybe ChatItemId
lastItemId_ ChatStats
stats) = do
  NoteFolder
nf <- Connection
-> User -> ChatItemId -> ExceptT StoreError IO NoteFolder
getNoteFolder Connection
db User
user ChatItemId
noteFolderId
  UTCTime
ts <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  [CChatItem 'CTLocal]
lastItem <- case Maybe ChatItemId
lastItemId_ of
    Just ChatItemId
lastItemId -> do
      CChatItem 'CTLocal
previewItem <- IO (CChatItem 'CTLocal)
-> ExceptT StoreError IO (CChatItem 'CTLocal)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (CChatItem 'CTLocal)
 -> ExceptT StoreError IO (CChatItem 'CTLocal))
-> IO (CChatItem 'CTLocal)
-> ExceptT StoreError IO (CChatItem 'CTLocal)
forall a b. (a -> b) -> a -> b
$ Connection
-> User
-> NoteFolder
-> UTCTime
-> ChatItemId
-> IO (CChatItem 'CTLocal)
safeGetLocalItem Connection
db User
user NoteFolder
nf UTCTime
ts ChatItemId
lastItemId
      [CChatItem 'CTLocal] -> ExceptT StoreError IO [CChatItem 'CTLocal]
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [CChatItem 'CTLocal
previewItem]
    Maybe ChatItemId
Nothing -> [CChatItem 'CTLocal] -> ExceptT StoreError IO [CChatItem 'CTLocal]
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  AChat -> ExceptT StoreError IO AChat
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AChat -> ExceptT StoreError IO AChat)
-> AChat -> ExceptT StoreError IO AChat
forall a b. (a -> b) -> a -> b
$ SChatType 'CTLocal -> Chat 'CTLocal -> AChat
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> Chat c -> AChat
AChat SChatType 'CTLocal
SCTLocal (ChatInfo 'CTLocal
-> [CChatItem 'CTLocal] -> ChatStats -> Chat 'CTLocal
forall (c :: ChatType).
ChatInfo c -> [CChatItem c] -> ChatStats -> Chat c
Chat (NoteFolder -> ChatInfo 'CTLocal
LocalChat NoteFolder
nf) [CChatItem 'CTLocal]
lastItem ChatStats
stats)

-- this function can be changed so it never fails, not only avoid failure on invalid json
toLocalChatItem :: UTCTime -> ChatItemRow -> Either StoreError (CChatItem 'CTLocal)
toLocalChatItem :: UTCTime -> ChatItemRow -> Either StoreError (CChatItem 'CTLocal)
toLocalChatItem UTCTime
currentTs ((ChatItemId
itemId, UTCTime
itemTs, AMsgDirection SMsgDirection d
msgDir, MemberName
itemContentText, MemberName
itemText, ACIStatus
itemStatus, Maybe BoolInt
sentViaProxy, Maybe SharedMsgId
sharedMsgId) :. (Int
itemDeleted, Maybe UTCTime
deletedTs, Maybe BoolInt
itemEdited, UTCTime
createdAt, UTCTime
updatedAt) :. ChatItemForwardedFromRow
forwardedFromRow :. (Maybe Int
timedTTL, Maybe UTCTime
timedDeleteAt, Maybe BoolInt
itemLive, BI Bool
userMention) :. (Maybe ChatItemId
fileId_, Maybe FilePath
fileName_, Maybe Integer
fileSize_, Maybe FilePath
filePath, Maybe SbKey
fileKey, Maybe CbNonce
fileNonce, Maybe ACIFileStatus
fileStatus_, Maybe FileProtocol
fileProtocol_)) =
  ACIContent -> Either StoreError (CChatItem 'CTLocal)
chatItem (ACIContent -> Either StoreError (CChatItem 'CTLocal))
-> ACIContent -> Either StoreError (CChatItem 'CTLocal)
forall a b. (a -> b) -> a -> b
$ ACIContent -> Either FilePath ACIContent -> ACIContent
forall b a. b -> Either a b -> b
fromRight ACIContent
invalid (Either FilePath ACIContent -> ACIContent)
-> Either FilePath ACIContent -> ACIContent
forall a b. (a -> b) -> a -> b
$ MemberName -> Either FilePath ACIContent
dbParseACIContent MemberName
itemContentText
  where
    invalid :: ACIContent
invalid = SMsgDirection d -> CIContent d -> ACIContent
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIContent d -> ACIContent
ACIContent SMsgDirection d
msgDir (CIContent d -> ACIContent) -> CIContent d -> ACIContent
forall a b. (a -> b) -> a -> b
$ MemberName -> CIContent d
forall (d :: MsgDirection). MemberName -> CIContent d
CIInvalidJSON MemberName
itemContentText
    chatItem :: ACIContent -> Either StoreError (CChatItem 'CTLocal)
chatItem ACIContent
itemContent = case (ACIContent
itemContent, ACIStatus
itemStatus, Maybe ACIFileStatus
fileStatus_) of
      (ACIContent SMsgDirection d
SMDSnd CIContent d
ciContent, ACIStatus SMsgDirection d
SMDSnd CIStatus d
ciStatus, Just (AFS SMsgDirection d
SMDSnd CIFileStatus d
fileStatus)) ->
        CChatItem 'CTLocal -> Either StoreError (CChatItem 'CTLocal)
forall a b. b -> Either a b
Right (CChatItem 'CTLocal -> Either StoreError (CChatItem 'CTLocal))
-> CChatItem 'CTLocal -> Either StoreError (CChatItem 'CTLocal)
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDSnd
-> CIDirection 'CTLocal 'MDSnd
-> CIStatus 'MDSnd
-> CIContent 'MDSnd
-> Maybe (CIFile 'MDSnd)
-> CChatItem 'CTLocal
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d
-> CIDirection 'CTLocal d
-> CIStatus d
-> CIContent d
-> Maybe (CIFile d)
-> CChatItem 'CTLocal
cItem SMsgDirection 'MDSnd
SMDSnd CIDirection 'CTLocal 'MDSnd
CILocalSnd CIStatus d
CIStatus 'MDSnd
ciStatus CIContent d
CIContent 'MDSnd
ciContent (CIFileStatus 'MDSnd -> Maybe (CIFile 'MDSnd)
forall (d :: MsgDirection). CIFileStatus d -> Maybe (CIFile d)
maybeCIFile CIFileStatus d
CIFileStatus 'MDSnd
fileStatus)
      (ACIContent SMsgDirection d
SMDSnd CIContent d
ciContent, ACIStatus SMsgDirection d
SMDSnd CIStatus d
ciStatus, Maybe ACIFileStatus
Nothing) ->
        CChatItem 'CTLocal -> Either StoreError (CChatItem 'CTLocal)
forall a b. b -> Either a b
Right (CChatItem 'CTLocal -> Either StoreError (CChatItem 'CTLocal))
-> CChatItem 'CTLocal -> Either StoreError (CChatItem 'CTLocal)
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDSnd
-> CIDirection 'CTLocal 'MDSnd
-> CIStatus 'MDSnd
-> CIContent 'MDSnd
-> Maybe (CIFile 'MDSnd)
-> CChatItem 'CTLocal
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d
-> CIDirection 'CTLocal d
-> CIStatus d
-> CIContent d
-> Maybe (CIFile d)
-> CChatItem 'CTLocal
cItem SMsgDirection 'MDSnd
SMDSnd CIDirection 'CTLocal 'MDSnd
CILocalSnd CIStatus d
CIStatus 'MDSnd
ciStatus CIContent d
CIContent 'MDSnd
ciContent Maybe (CIFile 'MDSnd)
forall a. Maybe a
Nothing
      (ACIContent SMsgDirection d
SMDRcv CIContent d
ciContent, ACIStatus SMsgDirection d
SMDRcv CIStatus d
ciStatus, Just (AFS SMsgDirection d
SMDRcv CIFileStatus d
fileStatus)) ->
        CChatItem 'CTLocal -> Either StoreError (CChatItem 'CTLocal)
forall a b. b -> Either a b
Right (CChatItem 'CTLocal -> Either StoreError (CChatItem 'CTLocal))
-> CChatItem 'CTLocal -> Either StoreError (CChatItem 'CTLocal)
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDRcv
-> CIDirection 'CTLocal 'MDRcv
-> CIStatus 'MDRcv
-> CIContent 'MDRcv
-> Maybe (CIFile 'MDRcv)
-> CChatItem 'CTLocal
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d
-> CIDirection 'CTLocal d
-> CIStatus d
-> CIContent d
-> Maybe (CIFile d)
-> CChatItem 'CTLocal
cItem SMsgDirection 'MDRcv
SMDRcv CIDirection 'CTLocal 'MDRcv
CILocalRcv CIStatus d
CIStatus 'MDRcv
ciStatus CIContent d
CIContent 'MDRcv
ciContent (CIFileStatus 'MDRcv -> Maybe (CIFile 'MDRcv)
forall (d :: MsgDirection). CIFileStatus d -> Maybe (CIFile d)
maybeCIFile CIFileStatus d
CIFileStatus 'MDRcv
fileStatus)
      (ACIContent SMsgDirection d
SMDRcv CIContent d
ciContent, ACIStatus SMsgDirection d
SMDRcv CIStatus d
ciStatus, Maybe ACIFileStatus
Nothing) ->
        CChatItem 'CTLocal -> Either StoreError (CChatItem 'CTLocal)
forall a b. b -> Either a b
Right (CChatItem 'CTLocal -> Either StoreError (CChatItem 'CTLocal))
-> CChatItem 'CTLocal -> Either StoreError (CChatItem 'CTLocal)
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDRcv
-> CIDirection 'CTLocal 'MDRcv
-> CIStatus 'MDRcv
-> CIContent 'MDRcv
-> Maybe (CIFile 'MDRcv)
-> CChatItem 'CTLocal
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d
-> CIDirection 'CTLocal d
-> CIStatus d
-> CIContent d
-> Maybe (CIFile d)
-> CChatItem 'CTLocal
cItem SMsgDirection 'MDRcv
SMDRcv CIDirection 'CTLocal 'MDRcv
CILocalRcv CIStatus d
CIStatus 'MDRcv
ciStatus CIContent d
CIContent 'MDRcv
ciContent Maybe (CIFile 'MDRcv)
forall a. Maybe a
Nothing
      (ACIContent, ACIStatus, Maybe ACIFileStatus)
_ -> Either StoreError (CChatItem 'CTLocal)
badItem
    maybeCIFile :: CIFileStatus d -> Maybe (CIFile d)
    maybeCIFile :: forall (d :: MsgDirection). CIFileStatus d -> Maybe (CIFile d)
maybeCIFile CIFileStatus d
fileStatus =
      case (Maybe ChatItemId
fileId_, Maybe FilePath
fileName_, Maybe Integer
fileSize_, Maybe FileProtocol
fileProtocol_) of
        (Just ChatItemId
fileId, Just FilePath
fileName, Just Integer
fileSize, Just FileProtocol
fileProtocol) ->
          let cfArgs :: Maybe CryptoFileArgs
cfArgs = SbKey -> CbNonce -> CryptoFileArgs
CFArgs (SbKey -> CbNonce -> CryptoFileArgs)
-> Maybe SbKey -> Maybe (CbNonce -> CryptoFileArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SbKey
fileKey Maybe (CbNonce -> CryptoFileArgs)
-> Maybe CbNonce -> Maybe CryptoFileArgs
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe CbNonce
fileNonce
              fileSource :: Maybe CryptoFile
fileSource = (FilePath -> Maybe CryptoFileArgs -> CryptoFile
`CryptoFile` Maybe CryptoFileArgs
cfArgs) (FilePath -> CryptoFile) -> Maybe FilePath -> Maybe CryptoFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
filePath
           in CIFile d -> Maybe (CIFile d)
forall a. a -> Maybe a
Just CIFile {ChatItemId
fileId :: ChatItemId
fileId :: ChatItemId
fileId, FilePath
fileName :: FilePath
fileName :: FilePath
fileName, Integer
fileSize :: Integer
fileSize :: Integer
fileSize, Maybe CryptoFile
fileSource :: Maybe CryptoFile
fileSource :: Maybe CryptoFile
fileSource, CIFileStatus d
fileStatus :: CIFileStatus d
fileStatus :: CIFileStatus d
fileStatus, FileProtocol
fileProtocol :: FileProtocol
fileProtocol :: FileProtocol
fileProtocol}
        (Maybe ChatItemId, Maybe FilePath, Maybe Integer,
 Maybe FileProtocol)
_ -> Maybe (CIFile d)
forall a. Maybe a
Nothing
    cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTLocal d -> CIStatus d -> CIContent d -> Maybe (CIFile d) -> CChatItem 'CTLocal
    cItem :: forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d
-> CIDirection 'CTLocal d
-> CIStatus d
-> CIContent d
-> Maybe (CIFile d)
-> CChatItem 'CTLocal
cItem SMsgDirection d
d CIDirection 'CTLocal d
chatDir CIStatus d
ciStatus CIContent d
content Maybe (CIFile d)
file =
      SMsgDirection d -> ChatItem 'CTLocal d -> CChatItem 'CTLocal
forall (c :: ChatType) (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> ChatItem c d -> CChatItem c
CChatItem SMsgDirection d
d ChatItem {CIDirection 'CTLocal d
chatDir :: CIDirection 'CTLocal d
chatDir :: CIDirection 'CTLocal d
chatDir, meta :: CIMeta 'CTLocal d
meta = CIContent d -> CIStatus d -> CIMeta 'CTLocal d
forall (d :: MsgDirection).
CIContent d -> CIStatus d -> CIMeta 'CTLocal d
ciMeta CIContent d
content CIStatus d
ciStatus, CIContent d
content :: CIContent d
content :: CIContent d
content, mentions :: Map MemberName CIMention
mentions = Map MemberName CIMention
forall k a. Map k a
M.empty, formattedText :: Maybe MarkdownList
formattedText = MemberName -> Maybe MarkdownList
parseMaybeMarkdownList MemberName
itemText, quotedItem :: Maybe (CIQuote 'CTLocal)
quotedItem = Maybe (CIQuote 'CTLocal)
forall a. Maybe a
Nothing, reactions :: [CIReactionCount]
reactions = [], Maybe (CIFile d)
file :: Maybe (CIFile d)
file :: Maybe (CIFile d)
file}
    badItem :: Either StoreError (CChatItem 'CTLocal)
badItem = StoreError -> Either StoreError (CChatItem 'CTLocal)
forall a b. a -> Either a b
Left (StoreError -> Either StoreError (CChatItem 'CTLocal))
-> StoreError -> Either StoreError (CChatItem 'CTLocal)
forall a b. (a -> b) -> a -> b
$ ChatItemId -> Maybe UTCTime -> StoreError
SEBadChatItem ChatItemId
itemId (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
itemTs)
    ciMeta :: CIContent d -> CIStatus d -> CIMeta 'CTLocal d
    ciMeta :: forall (d :: MsgDirection).
CIContent d -> CIStatus d -> CIMeta 'CTLocal d
ciMeta CIContent d
content CIStatus d
status =
      let itemDeleted' :: Maybe (CIDeleted 'CTLocal)
itemDeleted' = case Int
itemDeleted of
            Int
DBCINotDeleted -> Maybe (CIDeleted 'CTLocal)
forall a. Maybe a
Nothing
            Int
_ -> CIDeleted 'CTLocal -> Maybe (CIDeleted 'CTLocal)
forall a. a -> Maybe a
Just (forall (c :: ChatType). Maybe UTCTime -> CIDeleted c
CIDeleted @'CTLocal Maybe UTCTime
deletedTs)
          itemEdited' :: Bool
itemEdited' = Bool -> (BoolInt -> Bool) -> Maybe BoolInt -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False BoolInt -> Bool
unBI Maybe BoolInt
itemEdited
          itemForwarded :: Maybe CIForwardedFrom
itemForwarded = ChatItemForwardedFromRow -> Maybe CIForwardedFrom
toCIForwardedFrom ChatItemForwardedFromRow
forwardedFromRow
       in ChatItemId
-> CIContent d
-> MemberName
-> CIStatus d
-> Maybe Bool
-> Maybe SharedMsgId
-> Maybe CIForwardedFrom
-> Maybe (CIDeleted 'CTLocal)
-> Bool
-> Maybe CITimed
-> Maybe Bool
-> Bool
-> UTCTime
-> UTCTime
-> Maybe ChatItemId
-> Bool
-> UTCTime
-> UTCTime
-> CIMeta 'CTLocal d
forall (c :: ChatType) (d :: MsgDirection).
ChatTypeI c =>
ChatItemId
-> CIContent d
-> MemberName
-> CIStatus d
-> Maybe Bool
-> Maybe SharedMsgId
-> Maybe CIForwardedFrom
-> Maybe (CIDeleted c)
-> Bool
-> Maybe CITimed
-> Maybe Bool
-> Bool
-> UTCTime
-> UTCTime
-> Maybe ChatItemId
-> Bool
-> UTCTime
-> UTCTime
-> CIMeta c d
mkCIMeta ChatItemId
itemId CIContent d
content MemberName
itemText CIStatus d
status (BoolInt -> Bool
unBI (BoolInt -> Bool) -> Maybe BoolInt -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BoolInt
sentViaProxy) Maybe SharedMsgId
sharedMsgId Maybe CIForwardedFrom
itemForwarded Maybe (CIDeleted 'CTLocal)
itemDeleted' Bool
itemEdited' Maybe CITimed
ciTimed (BoolInt -> Bool
unBI (BoolInt -> Bool) -> Maybe BoolInt -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BoolInt
itemLive) Bool
userMention UTCTime
currentTs UTCTime
itemTs Maybe ChatItemId
forall a. Maybe a
Nothing Bool
False UTCTime
createdAt UTCTime
updatedAt
    ciTimed :: Maybe CITimed
    ciTimed :: Maybe CITimed
ciTimed = Maybe Int
timedTTL Maybe Int -> (Int -> Maybe CITimed) -> Maybe CITimed
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
ttl -> CITimed -> Maybe CITimed
forall a. a -> Maybe a
Just CITimed {Int
ttl :: Int
ttl :: Int
ttl, deleteAt :: Maybe UTCTime
deleteAt = Maybe UTCTime
timedDeleteAt}

getContactRequestChatPreviews_ :: DB.Connection -> User -> PaginationByTime -> ChatListQuery -> IO [AChatPreviewData]
getContactRequestChatPreviews_ :: Connection
-> User
-> PaginationByTime
-> ChatListQuery
-> IO [AChatPreviewData]
getContactRequestChatPreviews_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} PaginationByTime
pagination ChatListQuery
clq = case ChatListQuery
clq of
  CLQFilters {favorite :: ChatListQuery -> Bool
favorite = Bool
False, unread :: ChatListQuery -> Bool
unread = Bool
False} -> (ContactRequestRow -> AChatPreviewData)
-> [ContactRequestRow] -> [AChatPreviewData]
forall a b. (a -> b) -> [a] -> [b]
map ContactRequestRow -> AChatPreviewData
toPreview ([ContactRequestRow] -> [AChatPreviewData])
-> IO [ContactRequestRow] -> IO [AChatPreviewData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [ContactRequestRow]
getPreviews FilePath
""
  CLQFilters {favorite :: ChatListQuery -> Bool
favorite = Bool
True, unread :: ChatListQuery -> Bool
unread = Bool
False} -> [AChatPreviewData] -> IO [AChatPreviewData]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  CLQFilters {favorite :: ChatListQuery -> Bool
favorite = Bool
False, unread :: ChatListQuery -> Bool
unread = Bool
True} -> (ContactRequestRow -> AChatPreviewData)
-> [ContactRequestRow] -> [AChatPreviewData]
forall a b. (a -> b) -> [a] -> [b]
map ContactRequestRow -> AChatPreviewData
toPreview ([ContactRequestRow] -> [AChatPreviewData])
-> IO [ContactRequestRow] -> IO [AChatPreviewData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [ContactRequestRow]
getPreviews FilePath
""
  CLQFilters {favorite :: ChatListQuery -> Bool
favorite = Bool
True, unread :: ChatListQuery -> Bool
unread = Bool
True} -> (ContactRequestRow -> AChatPreviewData)
-> [ContactRequestRow] -> [AChatPreviewData]
forall a b. (a -> b) -> [a] -> [b]
map ContactRequestRow -> AChatPreviewData
toPreview ([ContactRequestRow] -> [AChatPreviewData])
-> IO [ContactRequestRow] -> IO [AChatPreviewData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [ContactRequestRow]
getPreviews FilePath
""
  CLQSearch {FilePath
search :: ChatListQuery -> FilePath
search :: FilePath
search} -> (ContactRequestRow -> AChatPreviewData)
-> [ContactRequestRow] -> [AChatPreviewData]
forall a b. (a -> b) -> [a] -> [b]
map ContactRequestRow -> AChatPreviewData
toPreview ([ContactRequestRow] -> [AChatPreviewData])
-> IO [ContactRequestRow] -> IO [AChatPreviewData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [ContactRequestRow]
getPreviews FilePath
search
  where
    query :: Query
query =
      [sql|
        SELECT
          cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id,
          cr.contact_id, cr.business_group_id, cr.user_contact_link_id,
          cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, cr.xcontact_id,
          cr.pq_support, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
          cr.created_at, cr.updated_at,
          cr.peer_chat_min_version, cr.peer_chat_max_version
        FROM contact_requests cr
        JOIN contact_profiles p ON p.contact_profile_id = cr.contact_profile_id
        JOIN user_contact_links uc ON uc.user_contact_link_id = cr.user_contact_link_id
        WHERE cr.user_id = ?
          AND uc.user_id = ?
          AND uc.local_display_name = ''
          AND uc.group_id IS NULL
          AND cr.contact_id IS NULL
          AND cr.business_group_id IS NULL
          AND (
            LOWER(cr.local_display_name) LIKE '%' || ? || '%'
            OR LOWER(p.display_name) LIKE '%' || ? || '%'
            OR LOWER(p.full_name) LIKE '%' || ? || '%'
            OR LOWER(p.short_descr) LIKE '%' || ? || '%'
          )
      |]
    params :: FilePath
-> (ChatItemId, ChatItemId, FilePath, FilePath, FilePath, FilePath)
params FilePath
search = let s :: FilePath
s = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
search in (ChatItemId
userId, ChatItemId
userId, FilePath
s, FilePath
s, FilePath
s, FilePath
s)
    getPreviews :: FilePath -> IO [ContactRequestRow]
getPreviews FilePath
search = case PaginationByTime
pagination of
      PTLast Int
count -> Connection
-> Query
-> ((ChatItemId, ChatItemId, FilePath, FilePath, FilePath,
     FilePath)
    :. Only Int)
-> IO [ContactRequestRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
query Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" ORDER BY cr.updated_at DESC LIMIT ?") (FilePath
-> (ChatItemId, ChatItemId, FilePath, FilePath, FilePath, FilePath)
params FilePath
search (ChatItemId, ChatItemId, FilePath, FilePath, FilePath, FilePath)
-> Only Int
-> (ChatItemId, ChatItemId, FilePath, FilePath, FilePath, FilePath)
   :. Only Int
forall h t. h -> t -> h :. t
:. Int -> Only Int
forall a. a -> Only a
Only Int
count)
      PTAfter UTCTime
ts Int
count -> Connection
-> Query
-> ((ChatItemId, ChatItemId, FilePath, FilePath, FilePath,
     FilePath)
    :. (UTCTime, Int))
-> IO [ContactRequestRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
query Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND cr.updated_at > ? ORDER BY cr.updated_at ASC LIMIT ?") (FilePath
-> (ChatItemId, ChatItemId, FilePath, FilePath, FilePath, FilePath)
params FilePath
search (ChatItemId, ChatItemId, FilePath, FilePath, FilePath, FilePath)
-> (UTCTime, Int)
-> (ChatItemId, ChatItemId, FilePath, FilePath, FilePath, FilePath)
   :. (UTCTime, Int)
forall h t. h -> t -> h :. t
:. (UTCTime
ts, Int
count))
      PTBefore UTCTime
ts Int
count -> Connection
-> Query
-> ((ChatItemId, ChatItemId, FilePath, FilePath, FilePath,
     FilePath)
    :. (UTCTime, Int))
-> IO [ContactRequestRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
query Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND cr.updated_at < ? ORDER BY cr.updated_at DESC LIMIT ?") (FilePath
-> (ChatItemId, ChatItemId, FilePath, FilePath, FilePath, FilePath)
params FilePath
search (ChatItemId, ChatItemId, FilePath, FilePath, FilePath, FilePath)
-> (UTCTime, Int)
-> (ChatItemId, ChatItemId, FilePath, FilePath, FilePath, FilePath)
   :. (UTCTime, Int)
forall h t. h -> t -> h :. t
:. (UTCTime
ts, Int
count))
    toPreview :: ContactRequestRow -> AChatPreviewData
    toPreview :: ContactRequestRow -> AChatPreviewData
toPreview ContactRequestRow
cReqRow =
      let cReq :: UserContactRequest
cReq@UserContactRequest {UTCTime
updatedAt :: UTCTime
updatedAt :: UserContactRequest -> UTCTime
updatedAt} = ContactRequestRow -> UserContactRequest
toContactRequest ContactRequestRow
cReqRow
          aChat :: AChat
aChat = SChatType 'CTContactRequest -> Chat 'CTContactRequest -> AChat
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> Chat c -> AChat
AChat SChatType 'CTContactRequest
SCTContactRequest (Chat 'CTContactRequest -> AChat)
-> Chat 'CTContactRequest -> AChat
forall a b. (a -> b) -> a -> b
$ ChatInfo 'CTContactRequest
-> [CChatItem 'CTContactRequest]
-> ChatStats
-> Chat 'CTContactRequest
forall (c :: ChatType).
ChatInfo c -> [CChatItem c] -> ChatStats -> Chat c
Chat (UserContactRequest -> ChatInfo 'CTContactRequest
ContactRequest UserContactRequest
cReq) [] ChatStats
emptyChatStats
       in SChatType 'CTContactRequest
-> ChatPreviewData 'CTContactRequest -> AChatPreviewData
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> ChatPreviewData c -> AChatPreviewData
ACPD SChatType 'CTContactRequest
SCTContactRequest (ChatPreviewData 'CTContactRequest -> AChatPreviewData)
-> ChatPreviewData 'CTContactRequest -> AChatPreviewData
forall a b. (a -> b) -> a -> b
$ UTCTime -> AChat -> ChatPreviewData 'CTContactRequest
ContactRequestPD UTCTime
updatedAt AChat
aChat

getContactConnectionChatPreviews_ :: DB.Connection -> User -> PaginationByTime -> ChatListQuery -> IO [AChatPreviewData]
getContactConnectionChatPreviews_ :: Connection
-> User
-> PaginationByTime
-> ChatListQuery
-> IO [AChatPreviewData]
getContactConnectionChatPreviews_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} PaginationByTime
pagination ChatListQuery
clq = case ChatListQuery
clq of
  CLQFilters {favorite :: ChatListQuery -> Bool
favorite = Bool
False, unread :: ChatListQuery -> Bool
unread = Bool
False} -> ((ChatItemId, ConnId, ConnStatus, Maybe ConnId, Maybe ChatItemId,
  Maybe GroupLinkId, Maybe ChatItemId, Maybe ConnReqInvitation,
  Maybe ShortLinkInvitation, MemberName, UTCTime, UTCTime)
 -> AChatPreviewData)
-> [(ChatItemId, ConnId, ConnStatus, Maybe ConnId,
     Maybe ChatItemId, Maybe GroupLinkId, Maybe ChatItemId,
     Maybe ConnReqInvitation, Maybe ShortLinkInvitation, MemberName,
     UTCTime, UTCTime)]
-> [AChatPreviewData]
forall a b. (a -> b) -> [a] -> [b]
map (ChatItemId, ConnId, ConnStatus, Maybe ConnId, Maybe ChatItemId,
 Maybe GroupLinkId, Maybe ChatItemId, Maybe ConnReqInvitation,
 Maybe ShortLinkInvitation, MemberName, UTCTime, UTCTime)
-> AChatPreviewData
toPreview ([(ChatItemId, ConnId, ConnStatus, Maybe ConnId, Maybe ChatItemId,
   Maybe GroupLinkId, Maybe ChatItemId, Maybe ConnReqInvitation,
   Maybe ShortLinkInvitation, MemberName, UTCTime, UTCTime)]
 -> [AChatPreviewData])
-> IO
     [(ChatItemId, ConnId, ConnStatus, Maybe ConnId, Maybe ChatItemId,
       Maybe GroupLinkId, Maybe ChatItemId, Maybe ConnReqInvitation,
       Maybe ShortLinkInvitation, MemberName, UTCTime, UTCTime)]
-> IO [AChatPreviewData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
-> IO
     [(ChatItemId, ConnId, ConnStatus, Maybe ConnId, Maybe ChatItemId,
       Maybe GroupLinkId, Maybe ChatItemId, Maybe ConnReqInvitation,
       Maybe ShortLinkInvitation, MemberName, UTCTime, UTCTime)]
getPreviews FilePath
""
  CLQFilters {favorite :: ChatListQuery -> Bool
favorite = Bool
True, unread :: ChatListQuery -> Bool
unread = Bool
False} -> [AChatPreviewData] -> IO [AChatPreviewData]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  CLQFilters {favorite :: ChatListQuery -> Bool
favorite = Bool
False, unread :: ChatListQuery -> Bool
unread = Bool
True} -> [AChatPreviewData] -> IO [AChatPreviewData]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  CLQFilters {favorite :: ChatListQuery -> Bool
favorite = Bool
True, unread :: ChatListQuery -> Bool
unread = Bool
True} -> [AChatPreviewData] -> IO [AChatPreviewData]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  CLQSearch {FilePath
search :: ChatListQuery -> FilePath
search :: FilePath
search} -> ((ChatItemId, ConnId, ConnStatus, Maybe ConnId, Maybe ChatItemId,
  Maybe GroupLinkId, Maybe ChatItemId, Maybe ConnReqInvitation,
  Maybe ShortLinkInvitation, MemberName, UTCTime, UTCTime)
 -> AChatPreviewData)
-> [(ChatItemId, ConnId, ConnStatus, Maybe ConnId,
     Maybe ChatItemId, Maybe GroupLinkId, Maybe ChatItemId,
     Maybe ConnReqInvitation, Maybe ShortLinkInvitation, MemberName,
     UTCTime, UTCTime)]
-> [AChatPreviewData]
forall a b. (a -> b) -> [a] -> [b]
map (ChatItemId, ConnId, ConnStatus, Maybe ConnId, Maybe ChatItemId,
 Maybe GroupLinkId, Maybe ChatItemId, Maybe ConnReqInvitation,
 Maybe ShortLinkInvitation, MemberName, UTCTime, UTCTime)
-> AChatPreviewData
toPreview ([(ChatItemId, ConnId, ConnStatus, Maybe ConnId, Maybe ChatItemId,
   Maybe GroupLinkId, Maybe ChatItemId, Maybe ConnReqInvitation,
   Maybe ShortLinkInvitation, MemberName, UTCTime, UTCTime)]
 -> [AChatPreviewData])
-> IO
     [(ChatItemId, ConnId, ConnStatus, Maybe ConnId, Maybe ChatItemId,
       Maybe GroupLinkId, Maybe ChatItemId, Maybe ConnReqInvitation,
       Maybe ShortLinkInvitation, MemberName, UTCTime, UTCTime)]
-> IO [AChatPreviewData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
-> IO
     [(ChatItemId, ConnId, ConnStatus, Maybe ConnId, Maybe ChatItemId,
       Maybe GroupLinkId, Maybe ChatItemId, Maybe ConnReqInvitation,
       Maybe ShortLinkInvitation, MemberName, UTCTime, UTCTime)]
getPreviews FilePath
search
  where
    query :: Query
query =
      [sql|
        SELECT
          connection_id, agent_conn_id, conn_status, via_contact_uri_hash, via_user_contact_link, group_link_id,
          custom_user_profile_id, conn_req_inv, short_link_inv, local_alias, created_at, updated_at
        FROM connections
        WHERE user_id = ?
          AND conn_type = ?
          AND conn_status != ?
          AND contact_id IS NULL
          AND conn_level = 0
          AND via_contact IS NULL
          AND (via_group_link = 0 OR (via_group_link = 1 AND group_link_id IS NOT NULL))
          AND LOWER(local_alias) LIKE '%' || LOWER(?) || '%'
      |]
    params :: FilePath -> (ChatItemId, ConnType, ConnStatus, FilePath)
params FilePath
search = (ChatItemId
userId, ConnType
ConnContact, ConnStatus
ConnPrepared, FilePath
search)
    getPreviews :: FilePath
-> IO
     [(ChatItemId, ConnId, ConnStatus, Maybe ConnId, Maybe ChatItemId,
       Maybe GroupLinkId, Maybe ChatItemId, Maybe ConnReqInvitation,
       Maybe ShortLinkInvitation, MemberName, UTCTime, UTCTime)]
getPreviews FilePath
search = case PaginationByTime
pagination of
      PTLast Int
count -> Connection
-> Query
-> ((ChatItemId, ConnType, ConnStatus, FilePath) :. Only Int)
-> IO
     [(ChatItemId, ConnId, ConnStatus, Maybe ConnId, Maybe ChatItemId,
       Maybe GroupLinkId, Maybe ChatItemId, Maybe ConnReqInvitation,
       Maybe ShortLinkInvitation, MemberName, UTCTime, UTCTime)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
query Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" ORDER BY updated_at DESC LIMIT ?") (FilePath -> (ChatItemId, ConnType, ConnStatus, FilePath)
params FilePath
search (ChatItemId, ConnType, ConnStatus, FilePath)
-> Only Int
-> (ChatItemId, ConnType, ConnStatus, FilePath) :. Only Int
forall h t. h -> t -> h :. t
:. Int -> Only Int
forall a. a -> Only a
Only Int
count)
      PTAfter UTCTime
ts Int
count -> Connection
-> Query
-> ((ChatItemId, ConnType, ConnStatus, FilePath) :. (UTCTime, Int))
-> IO
     [(ChatItemId, ConnId, ConnStatus, Maybe ConnId, Maybe ChatItemId,
       Maybe GroupLinkId, Maybe ChatItemId, Maybe ConnReqInvitation,
       Maybe ShortLinkInvitation, MemberName, UTCTime, UTCTime)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
query Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND updated_at > ? ORDER BY updated_at ASC LIMIT ?") (FilePath -> (ChatItemId, ConnType, ConnStatus, FilePath)
params FilePath
search (ChatItemId, ConnType, ConnStatus, FilePath)
-> (UTCTime, Int)
-> (ChatItemId, ConnType, ConnStatus, FilePath) :. (UTCTime, Int)
forall h t. h -> t -> h :. t
:. (UTCTime
ts, Int
count))
      PTBefore UTCTime
ts Int
count -> Connection
-> Query
-> ((ChatItemId, ConnType, ConnStatus, FilePath) :. (UTCTime, Int))
-> IO
     [(ChatItemId, ConnId, ConnStatus, Maybe ConnId, Maybe ChatItemId,
       Maybe GroupLinkId, Maybe ChatItemId, Maybe ConnReqInvitation,
       Maybe ShortLinkInvitation, MemberName, UTCTime, UTCTime)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
query Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND updated_at < ? ORDER BY updated_at DESC LIMIT ?") (FilePath -> (ChatItemId, ConnType, ConnStatus, FilePath)
params FilePath
search (ChatItemId, ConnType, ConnStatus, FilePath)
-> (UTCTime, Int)
-> (ChatItemId, ConnType, ConnStatus, FilePath) :. (UTCTime, Int)
forall h t. h -> t -> h :. t
:. (UTCTime
ts, Int
count))
    toPreview :: (Int64, ConnId, ConnStatus, Maybe ByteString, Maybe Int64, Maybe GroupLinkId, Maybe Int64, Maybe ConnReqInvitation, Maybe ShortLinkInvitation, LocalAlias, UTCTime, UTCTime) -> AChatPreviewData
    toPreview :: (ChatItemId, ConnId, ConnStatus, Maybe ConnId, Maybe ChatItemId,
 Maybe GroupLinkId, Maybe ChatItemId, Maybe ConnReqInvitation,
 Maybe ShortLinkInvitation, MemberName, UTCTime, UTCTime)
-> AChatPreviewData
toPreview (ChatItemId, ConnId, ConnStatus, Maybe ConnId, Maybe ChatItemId,
 Maybe GroupLinkId, Maybe ChatItemId, Maybe ConnReqInvitation,
 Maybe ShortLinkInvitation, MemberName, UTCTime, UTCTime)
connRow =
      let conn :: PendingContactConnection
conn@PendingContactConnection {UTCTime
updatedAt :: UTCTime
updatedAt :: PendingContactConnection -> UTCTime
updatedAt} = (ChatItemId, ConnId, ConnStatus, Maybe ConnId, Maybe ChatItemId,
 Maybe GroupLinkId, Maybe ChatItemId, Maybe ConnReqInvitation,
 Maybe ShortLinkInvitation, MemberName, UTCTime, UTCTime)
-> PendingContactConnection
toPendingContactConnection (ChatItemId, ConnId, ConnStatus, Maybe ConnId, Maybe ChatItemId,
 Maybe GroupLinkId, Maybe ChatItemId, Maybe ConnReqInvitation,
 Maybe ShortLinkInvitation, MemberName, UTCTime, UTCTime)
connRow
          aChat :: AChat
aChat = SChatType 'CTContactConnection
-> Chat 'CTContactConnection -> AChat
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> Chat c -> AChat
AChat SChatType 'CTContactConnection
SCTContactConnection (Chat 'CTContactConnection -> AChat)
-> Chat 'CTContactConnection -> AChat
forall a b. (a -> b) -> a -> b
$ ChatInfo 'CTContactConnection
-> [CChatItem 'CTContactConnection]
-> ChatStats
-> Chat 'CTContactConnection
forall (c :: ChatType).
ChatInfo c -> [CChatItem c] -> ChatStats -> Chat c
Chat (PendingContactConnection -> ChatInfo 'CTContactConnection
ContactConnection PendingContactConnection
conn) [] ChatStats
emptyChatStats
       in SChatType 'CTContactConnection
-> ChatPreviewData 'CTContactConnection -> AChatPreviewData
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> ChatPreviewData c -> AChatPreviewData
ACPD SChatType 'CTContactConnection
SCTContactConnection (ChatPreviewData 'CTContactConnection -> AChatPreviewData)
-> ChatPreviewData 'CTContactConnection -> AChatPreviewData
forall a b. (a -> b) -> a -> b
$ UTCTime -> AChat -> ChatPreviewData 'CTContactConnection
ContactConnectionPD UTCTime
updatedAt AChat
aChat

checkContactHasItems :: DB.Connection -> User -> Contact -> IO Bool
checkContactHasItems :: Connection -> User -> Contact -> IO Bool
checkContactHasItems Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} =
  Only Bool -> Bool
forall a. Only a -> a
fromOnly (Only Bool -> Bool)
-> ([Only Bool] -> Only Bool) -> [Only Bool] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Only Bool] -> Only Bool
forall a. HasCallStack => [a] -> a
head
    ([Only Bool] -> Bool) -> IO [Only Bool] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> (ChatItemId, ChatItemId) -> IO [Only Bool]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      Query
"SELECT EXISTS (SELECT 1 FROM chat_items WHERE user_id = ? AND contact_id = ?)"
      (ChatItemId
userId, ChatItemId
contactId)

getDirectChat :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ChatPagination -> Maybe Text -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChat :: Connection
-> VersionRangeChat
-> User
-> ChatItemId
-> ChatPagination
-> Maybe MemberName
-> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChat Connection
db VersionRangeChat
vr User
user ChatItemId
contactId ChatPagination
pagination Maybe MemberName
search_ = do
  let search :: MemberName
search = MemberName -> Maybe MemberName -> MemberName
forall a. a -> Maybe a -> a
fromMaybe MemberName
"" Maybe MemberName
search_
  Contact
ct <- Connection
-> VersionRangeChat
-> User
-> ChatItemId
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user ChatItemId
contactId
  case ChatPagination
pagination of
    CPLast Int
count -> IO (Chat 'CTDirect, Maybe NavigationInfo)
-> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Chat 'CTDirect, Maybe NavigationInfo)
 -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo))
-> IO (Chat 'CTDirect, Maybe NavigationInfo)
-> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
forall a b. (a -> b) -> a -> b
$ (,Maybe NavigationInfo
forall a. Maybe a
Nothing) (Chat 'CTDirect -> (Chat 'CTDirect, Maybe NavigationInfo))
-> IO (Chat 'CTDirect) -> IO (Chat 'CTDirect, Maybe NavigationInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> User -> Contact -> Int -> MemberName -> IO (Chat 'CTDirect)
getDirectChatLast_ Connection
db User
user Contact
ct Int
count MemberName
search
    CPAfter ChatItemId
afterId Int
count -> (,Maybe NavigationInfo
forall a. Maybe a
Nothing) (Chat 'CTDirect -> (Chat 'CTDirect, Maybe NavigationInfo))
-> ExceptT StoreError IO (Chat 'CTDirect)
-> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> User
-> Contact
-> ChatItemId
-> Int
-> MemberName
-> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChatAfter_ Connection
db User
user Contact
ct ChatItemId
afterId Int
count MemberName
search
    CPBefore ChatItemId
beforeId Int
count -> (,Maybe NavigationInfo
forall a. Maybe a
Nothing) (Chat 'CTDirect -> (Chat 'CTDirect, Maybe NavigationInfo))
-> ExceptT StoreError IO (Chat 'CTDirect)
-> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> User
-> Contact
-> ChatItemId
-> Int
-> MemberName
-> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChatBefore_ Connection
db User
user Contact
ct ChatItemId
beforeId Int
count MemberName
search
    CPAround ChatItemId
aroundId Int
count -> Connection
-> User
-> Contact
-> ChatItemId
-> Int
-> MemberName
-> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChatAround_ Connection
db User
user Contact
ct ChatItemId
aroundId Int
count MemberName
search
    CPInitial Int
count -> do
      Bool -> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (MemberName -> Bool
T.null MemberName
search) (ExceptT StoreError IO () -> ExceptT StoreError IO ())
-> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ StoreError -> ExceptT StoreError IO ()
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO ())
-> StoreError -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> StoreError
SEInternalError FilePath
"initial chat pagination doesn't support search"
      Connection
-> User
-> Contact
-> Int
-> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChatInitial_ Connection
db User
user Contact
ct Int
count

-- the last items in reverse order (the last item in the conversation is the first in the returned list)
getDirectChatLast_ :: DB.Connection -> User -> Contact -> Int -> Text -> IO (Chat 'CTDirect)
getDirectChatLast_ :: Connection
-> User -> Contact -> Int -> MemberName -> IO (Chat 'CTDirect)
getDirectChatLast_ Connection
db User
user Contact
ct Int
count MemberName
search = do
  [ChatItemId]
ciIds <- Connection
-> User -> Contact -> Int -> MemberName -> IO [ChatItemId]
getDirectChatItemIdsLast_ Connection
db User
user Contact
ct Int
count MemberName
search
  UTCTime
ts <- IO UTCTime
getCurrentTime
  [CChatItem 'CTDirect]
cis <- (ChatItemId -> IO (CChatItem 'CTDirect))
-> [ChatItemId] -> IO [CChatItem 'CTDirect]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Connection
-> User
-> Contact
-> UTCTime
-> ChatItemId
-> IO (CChatItem 'CTDirect)
safeGetDirectItem Connection
db User
user Contact
ct UTCTime
ts) [ChatItemId]
ciIds
  Chat 'CTDirect -> IO (Chat 'CTDirect)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chat 'CTDirect -> IO (Chat 'CTDirect))
-> Chat 'CTDirect -> IO (Chat 'CTDirect)
forall a b. (a -> b) -> a -> b
$ ChatInfo 'CTDirect
-> [CChatItem 'CTDirect] -> ChatStats -> Chat 'CTDirect
forall (c :: ChatType).
ChatInfo c -> [CChatItem c] -> ChatStats -> Chat c
Chat (Contact -> ChatInfo 'CTDirect
DirectChat Contact
ct) ([CChatItem 'CTDirect] -> [CChatItem 'CTDirect]
forall a. [a] -> [a]
reverse [CChatItem 'CTDirect]
cis) ChatStats
emptyChatStats

getDirectChatItemIdsLast_ :: DB.Connection -> User -> Contact -> Int -> Text -> IO [ChatItemId]
getDirectChatItemIdsLast_ :: Connection
-> User -> Contact -> Int -> MemberName -> IO [ChatItemId]
getDirectChatItemIdsLast_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} Int
count MemberName
search =
  (Only ChatItemId -> ChatItemId)
-> [Only ChatItemId] -> [ChatItemId]
forall a b. (a -> b) -> [a] -> [b]
map Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly
    ([Only ChatItemId] -> [ChatItemId])
-> IO [Only ChatItemId] -> IO [ChatItemId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (ChatItemId, ChatItemId, MemberName, Int)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT chat_item_id
        FROM chat_items
        WHERE user_id = ? AND contact_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
        ORDER BY created_at DESC, chat_item_id DESC
        LIMIT ?
      |]
      (ChatItemId
userId, ChatItemId
contactId, MemberName
search, Int
count)

safeGetDirectItem :: DB.Connection -> User -> Contact -> UTCTime -> ChatItemId -> IO (CChatItem 'CTDirect)
safeGetDirectItem :: Connection
-> User
-> Contact
-> UTCTime
-> ChatItemId
-> IO (CChatItem 'CTDirect)
safeGetDirectItem Connection
db User
user Contact
ct UTCTime
currentTs ChatItemId
itemId =
  ExceptT StoreError IO (CChatItem 'CTDirect)
-> IO (Either StoreError (CChatItem 'CTDirect))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (Connection
-> User
-> Contact
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectCIWithReactions Connection
db User
user Contact
ct ChatItemId
itemId)
    IO (Either StoreError (CChatItem 'CTDirect))
-> (Either StoreError (CChatItem 'CTDirect)
    -> IO (CChatItem 'CTDirect))
-> IO (CChatItem 'CTDirect)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CChatItem 'CTDirect -> IO (CChatItem 'CTDirect)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CChatItem 'CTDirect -> IO (CChatItem 'CTDirect))
-> (Either StoreError (CChatItem 'CTDirect) -> CChatItem 'CTDirect)
-> Either StoreError (CChatItem 'CTDirect)
-> IO (CChatItem 'CTDirect)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTCTime
-> ChatItemId
-> Either StoreError (CChatItem 'CTDirect)
-> CChatItem 'CTDirect
safeToDirectItem UTCTime
currentTs ChatItemId
itemId

safeToDirectItem :: UTCTime -> ChatItemId -> Either StoreError (CChatItem 'CTDirect) -> CChatItem 'CTDirect
safeToDirectItem :: UTCTime
-> ChatItemId
-> Either StoreError (CChatItem 'CTDirect)
-> CChatItem 'CTDirect
safeToDirectItem UTCTime
currentTs ChatItemId
itemId = \case
  Right CChatItem 'CTDirect
ci -> CChatItem 'CTDirect
ci
  Left e :: StoreError
e@(SEBadChatItem ChatItemId
_ (Just UTCTime
itemTs)) -> UTCTime -> StoreError -> CChatItem 'CTDirect
badDirectItem UTCTime
itemTs StoreError
e
  Left StoreError
e -> UTCTime -> StoreError -> CChatItem 'CTDirect
badDirectItem UTCTime
currentTs StoreError
e
  where
    badDirectItem :: UTCTime -> StoreError -> CChatItem 'CTDirect
    badDirectItem :: UTCTime -> StoreError -> CChatItem 'CTDirect
badDirectItem UTCTime
ts StoreError
e =
      let errorText :: MemberName
errorText = FilePath -> MemberName
T.pack (FilePath -> MemberName) -> FilePath -> MemberName
forall a b. (a -> b) -> a -> b
$ StoreError -> FilePath
forall a. Show a => a -> FilePath
show StoreError
e
       in SMsgDirection 'MDSnd
-> ChatItem 'CTDirect 'MDSnd -> CChatItem 'CTDirect
forall (c :: ChatType) (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> ChatItem c d -> CChatItem c
CChatItem
            SMsgDirection 'MDSnd
SMDSnd
            ChatItem
              { chatDir :: CIDirection 'CTDirect 'MDSnd
chatDir = CIDirection 'CTDirect 'MDSnd
CIDirectSnd,
                meta :: CIMeta 'CTDirect 'MDSnd
meta = ChatItemId -> UTCTime -> MemberName -> CIMeta 'CTDirect 'MDSnd
forall (c :: ChatType).
ChatItemId -> UTCTime -> MemberName -> CIMeta c 'MDSnd
dummyMeta ChatItemId
itemId UTCTime
ts MemberName
errorText,
                content :: CIContent 'MDSnd
content = MemberName -> CIContent 'MDSnd
forall (d :: MsgDirection). MemberName -> CIContent d
CIInvalidJSON MemberName
errorText,
                mentions :: Map MemberName CIMention
mentions = Map MemberName CIMention
forall k a. Map k a
M.empty,
                formattedText :: Maybe MarkdownList
formattedText = Maybe MarkdownList
forall a. Maybe a
Nothing,
                quotedItem :: Maybe (CIQuote 'CTDirect)
quotedItem = Maybe (CIQuote 'CTDirect)
forall a. Maybe a
Nothing,
                reactions :: [CIReactionCount]
reactions = [],
                file :: Maybe (CIFile 'MDSnd)
file = Maybe (CIFile 'MDSnd)
forall a. Maybe a
Nothing
              }

getDirectChatItemLast :: DB.Connection -> User -> ContactId -> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectChatItemLast :: Connection
-> User
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectChatItemLast Connection
db user :: User
user@User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
contactId = do
  ChatItemId
chatItemId <-
    IO (Either StoreError ChatItemId)
-> ExceptT StoreError IO ChatItemId
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError ChatItemId)
 -> ExceptT StoreError IO ChatItemId)
-> (IO [Only ChatItemId] -> IO (Either StoreError ChatItemId))
-> IO [Only ChatItemId]
-> ExceptT StoreError IO ChatItemId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only ChatItemId -> ChatItemId)
-> StoreError
-> IO [Only ChatItemId]
-> IO (Either StoreError ChatItemId)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly (ChatItemId -> StoreError
SEChatItemNotFoundByContactId ChatItemId
contactId) (IO [Only ChatItemId] -> ExceptT StoreError IO ChatItemId)
-> IO [Only ChatItemId] -> ExceptT StoreError IO ChatItemId
forall a b. (a -> b) -> a -> b
$
      Connection
-> Query -> (ChatItemId, ChatItemId) -> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT chat_item_id
          FROM chat_items
          WHERE user_id = ? AND contact_id = ?
          ORDER BY created_at DESC, chat_item_id DESC
          LIMIT 1
        |]
        (ChatItemId
userId, ChatItemId
contactId)
  Connection
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectChatItem Connection
db User
user ChatItemId
contactId ChatItemId
chatItemId

getDirectChatAfter_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChatAfter_ :: Connection
-> User
-> Contact
-> ChatItemId
-> Int
-> MemberName
-> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChatAfter_ Connection
db User
user ct :: Contact
ct@Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} ChatItemId
afterId Int
count MemberName
search = do
  CChatItem 'CTDirect
afterCI <- Connection
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectChatItem Connection
db User
user ChatItemId
contactId ChatItemId
afterId
  [ChatItemId]
ciIds <- IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId])
-> IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a b. (a -> b) -> a -> b
$ Connection
-> User
-> Contact
-> CChatItem 'CTDirect
-> Int
-> MemberName
-> IO [ChatItemId]
getDirectCIsAfter_ Connection
db User
user Contact
ct CChatItem 'CTDirect
afterCI Int
count MemberName
search
  UTCTime
ts <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  [CChatItem 'CTDirect]
cis <- IO [CChatItem 'CTDirect]
-> ExceptT StoreError IO [CChatItem 'CTDirect]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [CChatItem 'CTDirect]
 -> ExceptT StoreError IO [CChatItem 'CTDirect])
-> IO [CChatItem 'CTDirect]
-> ExceptT StoreError IO [CChatItem 'CTDirect]
forall a b. (a -> b) -> a -> b
$ (ChatItemId -> IO (CChatItem 'CTDirect))
-> [ChatItemId] -> IO [CChatItem 'CTDirect]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Connection
-> User
-> Contact
-> UTCTime
-> ChatItemId
-> IO (CChatItem 'CTDirect)
safeGetDirectItem Connection
db User
user Contact
ct UTCTime
ts) [ChatItemId]
ciIds
  Chat 'CTDirect -> ExceptT StoreError IO (Chat 'CTDirect)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chat 'CTDirect -> ExceptT StoreError IO (Chat 'CTDirect))
-> Chat 'CTDirect -> ExceptT StoreError IO (Chat 'CTDirect)
forall a b. (a -> b) -> a -> b
$ ChatInfo 'CTDirect
-> [CChatItem 'CTDirect] -> ChatStats -> Chat 'CTDirect
forall (c :: ChatType).
ChatInfo c -> [CChatItem c] -> ChatStats -> Chat c
Chat (Contact -> ChatInfo 'CTDirect
DirectChat Contact
ct) [CChatItem 'CTDirect]
cis ChatStats
emptyChatStats

getDirectCIsAfter_ :: DB.Connection -> User -> Contact -> CChatItem 'CTDirect -> Int -> Text -> IO [ChatItemId]
getDirectCIsAfter_ :: Connection
-> User
-> Contact
-> CChatItem 'CTDirect
-> Int
-> MemberName
-> IO [ChatItemId]
getDirectCIsAfter_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} CChatItem 'CTDirect
afterCI Int
count MemberName
search =
  (Only ChatItemId -> ChatItemId)
-> [Only ChatItemId] -> [ChatItemId]
forall a b. (a -> b) -> [a] -> [b]
map Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly
    ([Only ChatItemId] -> [ChatItemId])
-> IO [Only ChatItemId] -> IO [ChatItemId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (ChatItemId, ChatItemId, MemberName, UTCTime, UTCTime,
    ChatItemId, Int)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT chat_item_id
        FROM chat_items
        WHERE user_id = ? AND contact_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
          AND (created_at > ? OR (created_at = ? AND chat_item_id > ?))
        ORDER BY created_at ASC, chat_item_id ASC
        LIMIT ?
      |]
      (ChatItemId
userId, ChatItemId
contactId, MemberName
search, CChatItem 'CTDirect -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
ciCreatedAt CChatItem 'CTDirect
afterCI, CChatItem 'CTDirect -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
ciCreatedAt CChatItem 'CTDirect
afterCI, CChatItem 'CTDirect -> ChatItemId
forall (c :: ChatType). CChatItem c -> ChatItemId
cChatItemId CChatItem 'CTDirect
afterCI, Int
count)

getDirectChatBefore_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChatBefore_ :: Connection
-> User
-> Contact
-> ChatItemId
-> Int
-> MemberName
-> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChatBefore_ Connection
db User
user ct :: Contact
ct@Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} ChatItemId
beforeId Int
count MemberName
search = do
  CChatItem 'CTDirect
beforeCI <- Connection
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectChatItem Connection
db User
user ChatItemId
contactId ChatItemId
beforeId
  [ChatItemId]
ciIds <- IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId])
-> IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a b. (a -> b) -> a -> b
$ Connection
-> User
-> Contact
-> CChatItem 'CTDirect
-> Int
-> MemberName
-> IO [ChatItemId]
getDirectCIsBefore_ Connection
db User
user Contact
ct CChatItem 'CTDirect
beforeCI Int
count MemberName
search
  UTCTime
ts <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  [CChatItem 'CTDirect]
cis <- IO [CChatItem 'CTDirect]
-> ExceptT StoreError IO [CChatItem 'CTDirect]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [CChatItem 'CTDirect]
 -> ExceptT StoreError IO [CChatItem 'CTDirect])
-> IO [CChatItem 'CTDirect]
-> ExceptT StoreError IO [CChatItem 'CTDirect]
forall a b. (a -> b) -> a -> b
$ (ChatItemId -> IO (CChatItem 'CTDirect))
-> [ChatItemId] -> IO [CChatItem 'CTDirect]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Connection
-> User
-> Contact
-> UTCTime
-> ChatItemId
-> IO (CChatItem 'CTDirect)
safeGetDirectItem Connection
db User
user Contact
ct UTCTime
ts) [ChatItemId]
ciIds
  Chat 'CTDirect -> ExceptT StoreError IO (Chat 'CTDirect)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chat 'CTDirect -> ExceptT StoreError IO (Chat 'CTDirect))
-> Chat 'CTDirect -> ExceptT StoreError IO (Chat 'CTDirect)
forall a b. (a -> b) -> a -> b
$ ChatInfo 'CTDirect
-> [CChatItem 'CTDirect] -> ChatStats -> Chat 'CTDirect
forall (c :: ChatType).
ChatInfo c -> [CChatItem c] -> ChatStats -> Chat c
Chat (Contact -> ChatInfo 'CTDirect
DirectChat Contact
ct) ([CChatItem 'CTDirect] -> [CChatItem 'CTDirect]
forall a. [a] -> [a]
reverse [CChatItem 'CTDirect]
cis) ChatStats
emptyChatStats

getDirectCIsBefore_ :: DB.Connection -> User -> Contact -> CChatItem 'CTDirect -> Int -> Text -> IO [ChatItemId]
getDirectCIsBefore_ :: Connection
-> User
-> Contact
-> CChatItem 'CTDirect
-> Int
-> MemberName
-> IO [ChatItemId]
getDirectCIsBefore_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} CChatItem 'CTDirect
beforeCI Int
count MemberName
search =
  (Only ChatItemId -> ChatItemId)
-> [Only ChatItemId] -> [ChatItemId]
forall a b. (a -> b) -> [a] -> [b]
map Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly
    ([Only ChatItemId] -> [ChatItemId])
-> IO [Only ChatItemId] -> IO [ChatItemId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (ChatItemId, ChatItemId, MemberName, UTCTime, UTCTime,
    ChatItemId, Int)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT chat_item_id
        FROM chat_items
        WHERE user_id = ? AND contact_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
          AND (created_at < ? OR (created_at = ? AND chat_item_id < ?))
        ORDER BY created_at DESC, chat_item_id DESC
        LIMIT ?
      |]
      (ChatItemId
userId, ChatItemId
contactId, MemberName
search, CChatItem 'CTDirect -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
ciCreatedAt CChatItem 'CTDirect
beforeCI, CChatItem 'CTDirect -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
ciCreatedAt CChatItem 'CTDirect
beforeCI, CChatItem 'CTDirect -> ChatItemId
forall (c :: ChatType). CChatItem c -> ChatItemId
cChatItemId CChatItem 'CTDirect
beforeCI, Int
count)

getDirectChatAround_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChatAround_ :: Connection
-> User
-> Contact
-> ChatItemId
-> Int
-> MemberName
-> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChatAround_ Connection
db User
user Contact
ct ChatItemId
aroundId Int
count MemberName
search = do
  ChatStats
stats <- IO ChatStats -> ExceptT StoreError IO ChatStats
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ChatStats -> ExceptT StoreError IO ChatStats)
-> IO ChatStats -> ExceptT StoreError IO ChatStats
forall a b. (a -> b) -> a -> b
$ Connection -> User -> Contact -> IO ChatStats
getContactStats_ Connection
db User
user Contact
ct
  Connection
-> User
-> Contact
-> ChatItemId
-> Int
-> MemberName
-> ChatStats
-> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChatAround' Connection
db User
user Contact
ct ChatItemId
aroundId Int
count MemberName
search ChatStats
stats

getDirectChatAround' :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> Text -> ChatStats -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChatAround' :: Connection
-> User
-> Contact
-> ChatItemId
-> Int
-> MemberName
-> ChatStats
-> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChatAround' Connection
db User
user ct :: Contact
ct@Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} ChatItemId
aroundId Int
count MemberName
search ChatStats
stats = do
  CChatItem 'CTDirect
aroundCI <- Connection
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectChatItem Connection
db User
user ChatItemId
contactId ChatItemId
aroundId
  [ChatItemId]
beforeIds <- IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId])
-> IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a b. (a -> b) -> a -> b
$ Connection
-> User
-> Contact
-> CChatItem 'CTDirect
-> Int
-> MemberName
-> IO [ChatItemId]
getDirectCIsBefore_ Connection
db User
user Contact
ct CChatItem 'CTDirect
aroundCI Int
count MemberName
search
  [ChatItemId]
afterIds <- IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId])
-> IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a b. (a -> b) -> a -> b
$ Connection
-> User
-> Contact
-> CChatItem 'CTDirect
-> Int
-> MemberName
-> IO [ChatItemId]
getDirectCIsAfter_ Connection
db User
user Contact
ct CChatItem 'CTDirect
aroundCI Int
count MemberName
search
  UTCTime
ts <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  [CChatItem 'CTDirect]
beforeCIs <- IO [CChatItem 'CTDirect]
-> ExceptT StoreError IO [CChatItem 'CTDirect]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [CChatItem 'CTDirect]
 -> ExceptT StoreError IO [CChatItem 'CTDirect])
-> IO [CChatItem 'CTDirect]
-> ExceptT StoreError IO [CChatItem 'CTDirect]
forall a b. (a -> b) -> a -> b
$ (ChatItemId -> IO (CChatItem 'CTDirect))
-> [ChatItemId] -> IO [CChatItem 'CTDirect]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Connection
-> User
-> Contact
-> UTCTime
-> ChatItemId
-> IO (CChatItem 'CTDirect)
safeGetDirectItem Connection
db User
user Contact
ct UTCTime
ts) [ChatItemId]
beforeIds
  [CChatItem 'CTDirect]
afterCIs <- IO [CChatItem 'CTDirect]
-> ExceptT StoreError IO [CChatItem 'CTDirect]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [CChatItem 'CTDirect]
 -> ExceptT StoreError IO [CChatItem 'CTDirect])
-> IO [CChatItem 'CTDirect]
-> ExceptT StoreError IO [CChatItem 'CTDirect]
forall a b. (a -> b) -> a -> b
$ (ChatItemId -> IO (CChatItem 'CTDirect))
-> [ChatItemId] -> IO [CChatItem 'CTDirect]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Connection
-> User
-> Contact
-> UTCTime
-> ChatItemId
-> IO (CChatItem 'CTDirect)
safeGetDirectItem Connection
db User
user Contact
ct UTCTime
ts) [ChatItemId]
afterIds
  let cis :: [CChatItem 'CTDirect]
cis = [CChatItem 'CTDirect] -> [CChatItem 'CTDirect]
forall a. [a] -> [a]
reverse [CChatItem 'CTDirect]
beforeCIs [CChatItem 'CTDirect]
-> [CChatItem 'CTDirect] -> [CChatItem 'CTDirect]
forall a. Semigroup a => a -> a -> a
<> [CChatItem 'CTDirect
aroundCI] [CChatItem 'CTDirect]
-> [CChatItem 'CTDirect] -> [CChatItem 'CTDirect]
forall a. Semigroup a => a -> a -> a
<> [CChatItem 'CTDirect]
afterCIs
  NavigationInfo
navInfo <- IO NavigationInfo -> ExceptT StoreError IO NavigationInfo
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NavigationInfo -> ExceptT StoreError IO NavigationInfo)
-> IO NavigationInfo -> ExceptT StoreError IO NavigationInfo
forall a b. (a -> b) -> a -> b
$ [CChatItem 'CTDirect] -> IO NavigationInfo
getNavInfo [CChatItem 'CTDirect]
cis
  (Chat 'CTDirect, Maybe NavigationInfo)
-> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatInfo 'CTDirect
-> [CChatItem 'CTDirect] -> ChatStats -> Chat 'CTDirect
forall (c :: ChatType).
ChatInfo c -> [CChatItem c] -> ChatStats -> Chat c
Chat (Contact -> ChatInfo 'CTDirect
DirectChat Contact
ct) [CChatItem 'CTDirect]
cis ChatStats
stats, NavigationInfo -> Maybe NavigationInfo
forall a. a -> Maybe a
Just NavigationInfo
navInfo)
  where
    getNavInfo :: [CChatItem 'CTDirect] -> IO NavigationInfo
getNavInfo [CChatItem 'CTDirect]
cis_ = case [CChatItem 'CTDirect]
cis_ of
      [] -> NavigationInfo -> IO NavigationInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NavigationInfo -> IO NavigationInfo)
-> NavigationInfo -> IO NavigationInfo
forall a b. (a -> b) -> a -> b
$ Int -> Int -> NavigationInfo
NavigationInfo Int
0 Int
0
      [CChatItem 'CTDirect]
cis -> Connection
-> User -> Contact -> CChatItem 'CTDirect -> IO NavigationInfo
getContactNavInfo_ Connection
db User
user Contact
ct ([CChatItem 'CTDirect] -> CChatItem 'CTDirect
forall a. HasCallStack => [a] -> a
last [CChatItem 'CTDirect]
cis)

getDirectChatInitial_ :: DB.Connection -> User -> Contact -> Int -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChatInitial_ :: Connection
-> User
-> Contact
-> Int
-> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChatInitial_ Connection
db User
user Contact
ct Int
count = do
  IO (Maybe ChatItemId) -> ExceptT StoreError IO (Maybe ChatItemId)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Connection -> User -> Contact -> IO (Maybe ChatItemId)
getContactMinUnreadId_ Connection
db User
user Contact
ct) ExceptT StoreError IO (Maybe ChatItemId)
-> (Maybe ChatItemId
    -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo))
-> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
forall a b.
ExceptT StoreError IO a
-> (a -> ExceptT StoreError IO b) -> ExceptT StoreError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just ChatItemId
minUnreadItemId -> do
      Int
unreadCount <- IO Int -> ExceptT StoreError IO Int
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> ExceptT StoreError IO Int)
-> IO Int -> ExceptT StoreError IO Int
forall a b. (a -> b) -> a -> b
$ Connection -> User -> Contact -> IO Int
getContactUnreadCount_ Connection
db User
user Contact
ct
      let stats :: ChatStats
stats = ChatStats
emptyChatStats {unreadCount, minUnreadItemId}
      Connection
-> User
-> Contact
-> ChatItemId
-> Int
-> MemberName
-> ChatStats
-> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChatAround' Connection
db User
user Contact
ct ChatItemId
minUnreadItemId Int
count MemberName
"" ChatStats
stats
    Maybe ChatItemId
Nothing -> IO (Chat 'CTDirect, Maybe NavigationInfo)
-> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Chat 'CTDirect, Maybe NavigationInfo)
 -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo))
-> IO (Chat 'CTDirect, Maybe NavigationInfo)
-> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
forall a b. (a -> b) -> a -> b
$ (,NavigationInfo -> Maybe NavigationInfo
forall a. a -> Maybe a
Just (NavigationInfo -> Maybe NavigationInfo)
-> NavigationInfo -> Maybe NavigationInfo
forall a b. (a -> b) -> a -> b
$ Int -> Int -> NavigationInfo
NavigationInfo Int
0 Int
0) (Chat 'CTDirect -> (Chat 'CTDirect, Maybe NavigationInfo))
-> IO (Chat 'CTDirect) -> IO (Chat 'CTDirect, Maybe NavigationInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> User -> Contact -> Int -> MemberName -> IO (Chat 'CTDirect)
getDirectChatLast_ Connection
db User
user Contact
ct Int
count MemberName
""

getContactStats_ :: DB.Connection -> User -> Contact -> IO ChatStats
getContactStats_ :: Connection -> User -> Contact -> IO ChatStats
getContactStats_ Connection
db User
user Contact
ct = do
  ChatItemId
minUnreadItemId <- ChatItemId -> Maybe ChatItemId -> ChatItemId
forall a. a -> Maybe a -> a
fromMaybe ChatItemId
0 (Maybe ChatItemId -> ChatItemId)
-> IO (Maybe ChatItemId) -> IO ChatItemId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> User -> Contact -> IO (Maybe ChatItemId)
getContactMinUnreadId_ Connection
db User
user Contact
ct
  Int
unreadCount <- Connection -> User -> Contact -> IO Int
getContactUnreadCount_ Connection
db User
user Contact
ct
  ChatStats -> IO ChatStats
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatStats
emptyChatStats {unreadCount, minUnreadItemId}

getContactMinUnreadId_ :: DB.Connection -> User -> Contact -> IO (Maybe ChatItemId)
getContactMinUnreadId_ :: Connection -> User -> Contact -> IO (Maybe ChatItemId)
getContactMinUnreadId_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} =
  (Maybe (Maybe ChatItemId) -> Maybe ChatItemId)
-> IO (Maybe (Maybe ChatItemId)) -> IO (Maybe ChatItemId)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe ChatItemId) -> Maybe ChatItemId
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (Maybe (Maybe ChatItemId)) -> IO (Maybe ChatItemId))
-> (IO [Only (Maybe ChatItemId)] -> IO (Maybe (Maybe ChatItemId)))
-> IO [Only (Maybe ChatItemId)]
-> IO (Maybe ChatItemId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only (Maybe ChatItemId) -> Maybe ChatItemId)
-> IO [Only (Maybe ChatItemId)] -> IO (Maybe (Maybe ChatItemId))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only (Maybe ChatItemId) -> Maybe ChatItemId
forall a. Only a -> a
fromOnly (IO [Only (Maybe ChatItemId)] -> IO (Maybe ChatItemId))
-> IO [Only (Maybe ChatItemId)] -> IO (Maybe ChatItemId)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv)
-> IO [Only (Maybe ChatItemId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT chat_item_id
        FROM chat_items
        WHERE user_id = ? AND contact_id = ? AND item_status = ?
        ORDER BY created_at ASC, chat_item_id ASC
        LIMIT 1
      |]
      (ChatItemId
userId, ChatItemId
contactId, CIStatus 'MDRcv
CISRcvNew)

getContactUnreadCount_ :: DB.Connection -> User -> Contact -> IO Int
getContactUnreadCount_ :: Connection -> User -> Contact -> IO Int
getContactUnreadCount_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} =
  Only Int -> Int
forall a. Only a -> a
fromOnly (Only Int -> Int) -> ([Only Int] -> Only Int) -> [Only Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Only Int] -> Only Int
forall a. HasCallStack => [a] -> a
head
    ([Only Int] -> Int) -> IO [Only Int] -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv)
-> IO [Only Int]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT COUNT(1)
        FROM chat_items
        WHERE user_id = ? AND contact_id = ? AND item_status = ?
      |]
      (ChatItemId
userId, ChatItemId
contactId, CIStatus 'MDRcv
CISRcvNew)

getContactNavInfo_ :: DB.Connection -> User -> Contact -> CChatItem 'CTDirect -> IO NavigationInfo
getContactNavInfo_ :: Connection
-> User -> Contact -> CChatItem 'CTDirect -> IO NavigationInfo
getContactNavInfo_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} CChatItem 'CTDirect
afterCI = do
  Int
afterUnread <- IO Int
getAfterUnreadCount
  Int
afterTotal <- IO Int
getAfterTotalCount
  NavigationInfo -> IO NavigationInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NavigationInfo {Int
afterUnread :: Int
afterUnread :: Int
afterUnread, Int
afterTotal :: Int
afterTotal :: Int
afterTotal}
  where
    getAfterUnreadCount :: IO Int
    getAfterUnreadCount :: IO Int
getAfterUnreadCount =
      Only Int -> Int
forall a. Only a -> a
fromOnly (Only Int -> Int) -> ([Only Int] -> Only Int) -> [Only Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Only Int] -> Only Int
forall a. HasCallStack => [a] -> a
head
        ([Only Int] -> Int) -> IO [Only Int] -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> ((ChatItemId, ChatItemId, CIStatus 'MDRcv, UTCTime)
    :. (ChatItemId, ChatItemId, CIStatus 'MDRcv, UTCTime, ChatItemId))
-> IO [Only Int]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT COUNT(1)
            FROM (
              SELECT 1
              FROM chat_items
              WHERE user_id = ? AND contact_id = ? AND item_status = ?
                AND created_at > ?
              UNION ALL
              SELECT 1
              FROM chat_items
              WHERE user_id = ? AND contact_id = ? AND item_status = ?
                AND created_at = ? AND chat_item_id > ?
            ) ci
          |]
          ( (ChatItemId
userId, ChatItemId
contactId, CIStatus 'MDRcv
CISRcvNew, CChatItem 'CTDirect -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
ciCreatedAt CChatItem 'CTDirect
afterCI)
              (ChatItemId, ChatItemId, CIStatus 'MDRcv, UTCTime)
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv, UTCTime, ChatItemId)
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv, UTCTime)
   :. (ChatItemId, ChatItemId, CIStatus 'MDRcv, UTCTime, ChatItemId)
forall h t. h -> t -> h :. t
:. (ChatItemId
userId, ChatItemId
contactId, CIStatus 'MDRcv
CISRcvNew, CChatItem 'CTDirect -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
ciCreatedAt CChatItem 'CTDirect
afterCI, CChatItem 'CTDirect -> ChatItemId
forall (c :: ChatType). CChatItem c -> ChatItemId
cChatItemId CChatItem 'CTDirect
afterCI)
          )
    getAfterTotalCount :: IO Int
    getAfterTotalCount :: IO Int
getAfterTotalCount =
      Only Int -> Int
forall a. Only a -> a
fromOnly (Only Int -> Int) -> ([Only Int] -> Only Int) -> [Only Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Only Int] -> Only Int
forall a. HasCallStack => [a] -> a
head
        ([Only Int] -> Int) -> IO [Only Int] -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> ((ChatItemId, ChatItemId, UTCTime)
    :. (ChatItemId, ChatItemId, UTCTime, ChatItemId))
-> IO [Only Int]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT COUNT(1)
            FROM (
              SELECT 1
              FROM chat_items
              WHERE user_id = ? AND contact_id = ?
                AND created_at > ?
              UNION ALL
              SELECT 1
              FROM chat_items
              WHERE user_id = ? AND contact_id = ?
                AND created_at = ? AND chat_item_id > ?
            ) ci
          |]
          ( (ChatItemId
userId, ChatItemId
contactId, CChatItem 'CTDirect -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
ciCreatedAt CChatItem 'CTDirect
afterCI)
              (ChatItemId, ChatItemId, UTCTime)
-> (ChatItemId, ChatItemId, UTCTime, ChatItemId)
-> (ChatItemId, ChatItemId, UTCTime)
   :. (ChatItemId, ChatItemId, UTCTime, ChatItemId)
forall h t. h -> t -> h :. t
:. (ChatItemId
userId, ChatItemId
contactId, CChatItem 'CTDirect -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
ciCreatedAt CChatItem 'CTDirect
afterCI, CChatItem 'CTDirect -> ChatItemId
forall (c :: ChatType). CChatItem c -> ChatItemId
cChatItemId CChatItem 'CTDirect
afterCI)
          )

getGroupChat :: DB.Connection -> VersionRangeChat -> User -> Int64 -> Maybe GroupChatScope -> Maybe MsgContentTag -> ChatPagination -> Maybe Text -> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
getGroupChat :: Connection
-> VersionRangeChat
-> User
-> ChatItemId
-> Maybe GroupChatScope
-> Maybe MsgContentTag
-> ChatPagination
-> Maybe MemberName
-> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
getGroupChat Connection
db VersionRangeChat
vr User
user ChatItemId
groupId Maybe GroupChatScope
scope_ Maybe MsgContentTag
contentFilter ChatPagination
pagination Maybe MemberName
search_ = do
  let search :: MemberName
search = MemberName -> Maybe MemberName -> MemberName
forall a. a -> Maybe a -> a
fromMaybe MemberName
"" Maybe MemberName
search_
  GroupInfo
g <- Connection
-> VersionRangeChat
-> User
-> ChatItemId
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user ChatItemId
groupId
  Maybe GroupChatScopeInfo
scopeInfo <- (GroupChatScope -> ExceptT StoreError IO GroupChatScopeInfo)
-> Maybe GroupChatScope
-> ExceptT StoreError IO (Maybe GroupChatScopeInfo)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> GroupChatScope
-> ExceptT StoreError IO GroupChatScopeInfo
getCreateGroupChatScopeInfo Connection
db VersionRangeChat
vr User
user GroupInfo
g) Maybe GroupChatScope
scope_
  case ChatPagination
pagination of
    CPLast Int
count -> (,Maybe NavigationInfo
forall a. Maybe a
Nothing) (Chat 'CTGroup -> (Chat 'CTGroup, Maybe NavigationInfo))
-> ExceptT StoreError IO (Chat 'CTGroup)
-> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> Int
-> MemberName
-> ChatStats
-> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChatLast_ Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo Maybe MsgContentTag
contentFilter Int
count MemberName
search ChatStats
emptyChatStats
    CPAfter ChatItemId
afterId Int
count -> (,Maybe NavigationInfo
forall a. Maybe a
Nothing) (Chat 'CTGroup -> (Chat 'CTGroup, Maybe NavigationInfo))
-> ExceptT StoreError IO (Chat 'CTGroup)
-> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> ChatItemId
-> Int
-> MemberName
-> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChatAfter_ Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo Maybe MsgContentTag
contentFilter ChatItemId
afterId Int
count MemberName
search
    CPBefore ChatItemId
beforeId Int
count -> (,Maybe NavigationInfo
forall a. Maybe a
Nothing) (Chat 'CTGroup -> (Chat 'CTGroup, Maybe NavigationInfo))
-> ExceptT StoreError IO (Chat 'CTGroup)
-> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> ChatItemId
-> Int
-> MemberName
-> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChatBefore_ Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo Maybe MsgContentTag
contentFilter ChatItemId
beforeId Int
count MemberName
search
    CPAround ChatItemId
aroundId Int
count -> Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> ChatItemId
-> Int
-> MemberName
-> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
getGroupChatAround_ Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo Maybe MsgContentTag
contentFilter ChatItemId
aroundId Int
count MemberName
search
    CPInitial Int
count -> do
      Bool -> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (MemberName -> Bool
T.null MemberName
search) (ExceptT StoreError IO () -> ExceptT StoreError IO ())
-> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ StoreError -> ExceptT StoreError IO ()
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO ())
-> StoreError -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> StoreError
SEInternalError FilePath
"initial chat pagination doesn't support search"
      Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> Int
-> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
getGroupChatInitial_ Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo Maybe MsgContentTag
contentFilter Int
count

getCreateGroupChatScopeInfo :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupChatScope -> ExceptT StoreError IO GroupChatScopeInfo
getCreateGroupChatScopeInfo :: Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> GroupChatScope
-> ExceptT StoreError IO GroupChatScopeInfo
getCreateGroupChatScopeInfo Connection
db VersionRangeChat
vr User
user GroupInfo {GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} = \case
  GCSMemberSupport Maybe ChatItemId
Nothing -> do
    Bool -> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe GroupSupportChat -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe GroupSupportChat -> Bool) -> Maybe GroupSupportChat -> Bool
forall a b. (a -> b) -> a -> b
$ GroupMember -> Maybe GroupSupportChat
supportChat GroupMember
membership) (ExceptT StoreError IO () -> ExceptT StoreError IO ())
-> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ do
      UTCTime
ts <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> ChatItemId -> UTCTime -> IO ()
setSupportChatTs Connection
db (GroupMember -> ChatItemId
groupMemberId' GroupMember
membership) UTCTime
ts
    GroupChatScopeInfo -> ExceptT StoreError IO GroupChatScopeInfo
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupChatScopeInfo -> ExceptT StoreError IO GroupChatScopeInfo)
-> GroupChatScopeInfo -> ExceptT StoreError IO GroupChatScopeInfo
forall a b. (a -> b) -> a -> b
$ GCSIMemberSupport {groupMember_ :: Maybe GroupMember
groupMember_ = Maybe GroupMember
forall a. Maybe a
Nothing}
  GCSMemberSupport (Just ChatItemId
gmId) -> do
    GroupMember
m <- Connection
-> VersionRangeChat
-> User
-> ChatItemId
-> ExceptT StoreError IO GroupMember
getGroupMemberById Connection
db VersionRangeChat
vr User
user ChatItemId
gmId
    Bool -> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe GroupSupportChat -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe GroupSupportChat -> Bool) -> Maybe GroupSupportChat -> Bool
forall a b. (a -> b) -> a -> b
$ GroupMember -> Maybe GroupSupportChat
supportChat GroupMember
m) (ExceptT StoreError IO () -> ExceptT StoreError IO ())
-> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ do
      UTCTime
ts <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> ChatItemId -> UTCTime -> IO ()
setSupportChatTs Connection
db ChatItemId
gmId UTCTime
ts
    GroupChatScopeInfo -> ExceptT StoreError IO GroupChatScopeInfo
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GCSIMemberSupport {groupMember_ :: Maybe GroupMember
groupMember_ = GroupMember -> Maybe GroupMember
forall a. a -> Maybe a
Just GroupMember
m}

getGroupChatScopeInfoForItem :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> ChatItemId -> ExceptT StoreError IO (Maybe GroupChatScopeInfo)
getGroupChatScopeInfoForItem :: Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> ChatItemId
-> ExceptT StoreError IO (Maybe GroupChatScopeInfo)
getGroupChatScopeInfoForItem Connection
db VersionRangeChat
vr User
user GroupInfo
g ChatItemId
itemId =
  Connection
-> ChatItemId -> ExceptT StoreError IO (Maybe GroupChatScope)
getGroupChatScopeForItem_ Connection
db ChatItemId
itemId ExceptT StoreError IO (Maybe GroupChatScope)
-> (Maybe GroupChatScope
    -> ExceptT StoreError IO (Maybe GroupChatScopeInfo))
-> ExceptT StoreError IO (Maybe GroupChatScopeInfo)
forall a b.
ExceptT StoreError IO a
-> (a -> ExceptT StoreError IO b) -> ExceptT StoreError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (GroupChatScope -> ExceptT StoreError IO GroupChatScopeInfo)
-> Maybe GroupChatScope
-> ExceptT StoreError IO (Maybe GroupChatScopeInfo)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> GroupChatScope
-> ExceptT StoreError IO GroupChatScopeInfo
getGroupChatScopeInfo Connection
db VersionRangeChat
vr User
user GroupInfo
g)

getGroupChatScopeInfo :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupChatScope -> ExceptT StoreError IO GroupChatScopeInfo
getGroupChatScopeInfo :: Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> GroupChatScope
-> ExceptT StoreError IO GroupChatScopeInfo
getGroupChatScopeInfo Connection
db VersionRangeChat
vr User
user GroupInfo {GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} = \case
  GCSMemberSupport Maybe ChatItemId
Nothing -> case GroupMember -> Maybe GroupSupportChat
supportChat GroupMember
membership of
    Maybe GroupSupportChat
Nothing -> StoreError -> ExceptT StoreError IO GroupChatScopeInfo
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO GroupChatScopeInfo)
-> StoreError -> ExceptT StoreError IO GroupChatScopeInfo
forall a b. (a -> b) -> a -> b
$ FilePath -> StoreError
SEInternalError FilePath
"no moderators support chat"
    Just GroupSupportChat
_supportChat -> GroupChatScopeInfo -> ExceptT StoreError IO GroupChatScopeInfo
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupChatScopeInfo -> ExceptT StoreError IO GroupChatScopeInfo)
-> GroupChatScopeInfo -> ExceptT StoreError IO GroupChatScopeInfo
forall a b. (a -> b) -> a -> b
$ GCSIMemberSupport {groupMember_ :: Maybe GroupMember
groupMember_ = Maybe GroupMember
forall a. Maybe a
Nothing}
  GCSMemberSupport (Just ChatItemId
gmId) -> do
    GroupMember
m <- Connection
-> VersionRangeChat
-> User
-> ChatItemId
-> ExceptT StoreError IO GroupMember
getGroupMemberById Connection
db VersionRangeChat
vr User
user ChatItemId
gmId
    case GroupMember -> Maybe GroupSupportChat
supportChat GroupMember
m of
      Maybe GroupSupportChat
Nothing -> StoreError -> ExceptT StoreError IO GroupChatScopeInfo
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO GroupChatScopeInfo)
-> StoreError -> ExceptT StoreError IO GroupChatScopeInfo
forall a b. (a -> b) -> a -> b
$ FilePath -> StoreError
SEInternalError FilePath
"no support chat"
      Just GroupSupportChat
_supportChat -> GroupChatScopeInfo -> ExceptT StoreError IO GroupChatScopeInfo
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GCSIMemberSupport {groupMember_ :: Maybe GroupMember
groupMember_ = GroupMember -> Maybe GroupMember
forall a. a -> Maybe a
Just GroupMember
m}

getGroupChatScopeForItem_ :: DB.Connection -> ChatItemId -> ExceptT StoreError IO (Maybe GroupChatScope)
getGroupChatScopeForItem_ :: Connection
-> ChatItemId -> ExceptT StoreError IO (Maybe GroupChatScope)
getGroupChatScopeForItem_ Connection
db ChatItemId
itemId =
  IO (Either StoreError (Maybe GroupChatScope))
-> ExceptT StoreError IO (Maybe GroupChatScope)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (Maybe GroupChatScope))
 -> ExceptT StoreError IO (Maybe GroupChatScope))
-> (IO [(Maybe GroupChatScopeTag, Maybe (Maybe ChatItemId))]
    -> IO (Either StoreError (Maybe GroupChatScope)))
-> IO [(Maybe GroupChatScopeTag, Maybe (Maybe ChatItemId))]
-> ExceptT StoreError IO (Maybe GroupChatScope)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe GroupChatScopeTag, Maybe (Maybe ChatItemId))
 -> Maybe GroupChatScope)
-> StoreError
-> IO [(Maybe GroupChatScopeTag, Maybe (Maybe ChatItemId))]
-> IO (Either StoreError (Maybe GroupChatScope))
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (Maybe GroupChatScopeTag, Maybe (Maybe ChatItemId))
-> Maybe GroupChatScope
toScope (ChatItemId -> StoreError
SEChatItemNotFound ChatItemId
itemId) (IO [(Maybe GroupChatScopeTag, Maybe (Maybe ChatItemId))]
 -> ExceptT StoreError IO (Maybe GroupChatScope))
-> IO [(Maybe GroupChatScopeTag, Maybe (Maybe ChatItemId))]
-> ExceptT StoreError IO (Maybe GroupChatScope)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> Only ChatItemId
-> IO [(Maybe GroupChatScopeTag, Maybe (Maybe ChatItemId))]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT group_scope_tag, group_scope_group_member_id
        FROM chat_items
        WHERE chat_item_id = ?
      |]
      (ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
itemId)
  where
    toScope :: (Maybe GroupChatScopeTag, Maybe (Maybe ChatItemId))
-> Maybe GroupChatScope
toScope (Maybe GroupChatScopeTag
scopeTag, Maybe (Maybe ChatItemId)
scopeMemberId) =
      case (Maybe GroupChatScopeTag
scopeTag, Maybe (Maybe ChatItemId)
scopeMemberId) of
        (Just GroupChatScopeTag
GCSTMemberSupport_, Just Maybe ChatItemId
gmId) -> GroupChatScope -> Maybe GroupChatScope
forall a. a -> Maybe a
Just (GroupChatScope -> Maybe GroupChatScope)
-> GroupChatScope -> Maybe GroupChatScope
forall a b. (a -> b) -> a -> b
$ Maybe ChatItemId -> GroupChatScope
GCSMemberSupport Maybe ChatItemId
gmId
        (Just GroupChatScopeTag
GCSTMemberSupport_, Maybe (Maybe ChatItemId)
Nothing) -> GroupChatScope -> Maybe GroupChatScope
forall a. a -> Maybe a
Just (GroupChatScope -> Maybe GroupChatScope)
-> GroupChatScope -> Maybe GroupChatScope
forall a b. (a -> b) -> a -> b
$ Maybe ChatItemId -> GroupChatScope
GCSMemberSupport Maybe ChatItemId
forall a. Maybe a
Nothing
        (Maybe GroupChatScopeTag
Nothing, Maybe (Maybe ChatItemId)
Nothing) -> Maybe GroupChatScope
forall a. Maybe a
Nothing
        (Maybe GroupChatScopeTag
Nothing, Just Maybe ChatItemId
_) -> Maybe GroupChatScope
forall a. Maybe a
Nothing -- shouldn't happen

getGroupChatLast_ :: DB.Connection -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> Maybe MsgContentTag -> Int -> Text -> ChatStats -> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChatLast_ :: Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> Int
-> MemberName
-> ChatStats
-> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChatLast_ Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo_ Maybe MsgContentTag
contentFilter Int
count MemberName
search ChatStats
stats = do
  [ChatItemId]
ciIds <- Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> GroupItemIDsRange
-> Int
-> MemberName
-> ExceptT StoreError IO [ChatItemId]
getGroupChatItemIDs Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo_ Maybe MsgContentTag
contentFilter GroupItemIDsRange
GRLast Int
count MemberName
search
  UTCTime
ts <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  [CChatItem 'CTGroup]
cis <- (ChatItemId -> ExceptT StoreError IO (CChatItem 'CTGroup))
-> [ChatItemId] -> ExceptT StoreError IO [CChatItem 'CTGroup]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (IO (CChatItem 'CTGroup)
-> ExceptT StoreError IO (CChatItem 'CTGroup)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (CChatItem 'CTGroup)
 -> ExceptT StoreError IO (CChatItem 'CTGroup))
-> (ChatItemId -> IO (CChatItem 'CTGroup))
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTGroup)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> User
-> GroupInfo
-> UTCTime
-> ChatItemId
-> IO (CChatItem 'CTGroup)
safeGetGroupItem Connection
db User
user GroupInfo
g UTCTime
ts) [ChatItemId]
ciIds
  Chat 'CTGroup -> ExceptT StoreError IO (Chat 'CTGroup)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chat 'CTGroup -> ExceptT StoreError IO (Chat 'CTGroup))
-> Chat 'CTGroup -> ExceptT StoreError IO (Chat 'CTGroup)
forall a b. (a -> b) -> a -> b
$ ChatInfo 'CTGroup
-> [CChatItem 'CTGroup] -> ChatStats -> Chat 'CTGroup
forall (c :: ChatType).
ChatInfo c -> [CChatItem c] -> ChatStats -> Chat c
Chat (GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo_) ([CChatItem 'CTGroup] -> [CChatItem 'CTGroup]
forall a. [a] -> [a]
reverse [CChatItem 'CTGroup]
cis) ChatStats
stats

data GroupItemIDsRange = GRLast | GRAfter UTCTime ChatItemId | GRBefore UTCTime ChatItemId

getGroupChatItemIDs :: DB.Connection -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> Maybe MsgContentTag -> GroupItemIDsRange -> Int -> Text -> ExceptT StoreError IO [ChatItemId]
getGroupChatItemIDs :: Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> GroupItemIDsRange
-> Int
-> MemberName
-> ExceptT StoreError IO [ChatItemId]
getGroupChatItemIDs Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} Maybe GroupChatScopeInfo
scopeInfo_ Maybe MsgContentTag
contentFilter GroupItemIDsRange
range Int
count MemberName
search = case (Maybe GroupChatScopeInfo
scopeInfo_, Maybe MsgContentTag
contentFilter) of
  (Maybe GroupChatScopeInfo
Nothing, Maybe MsgContentTag
Nothing) ->
    IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId])
-> IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a b. (a -> b) -> a -> b
$
      Query -> (ChatItemId, ChatItemId) -> IO [ChatItemId]
forall p. ToRow p => Query -> p -> IO [ChatItemId]
idsQuery
        (Query
baseCond Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND group_scope_tag IS NULL AND group_scope_group_member_id IS NULL ")
        (ChatItemId
userId, ChatItemId
groupId)
  (Maybe GroupChatScopeInfo
Nothing, Just MsgContentTag
mcTag) ->
    IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId])
-> IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a b. (a -> b) -> a -> b
$
      Query -> (ChatItemId, ChatItemId, MsgContentTag) -> IO [ChatItemId]
forall p. ToRow p => Query -> p -> IO [ChatItemId]
idsQuery
        (Query
baseCond Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND msg_content_tag = ? ")
        (ChatItemId
userId, ChatItemId
groupId, MsgContentTag
mcTag)
  (Just GCSIMemberSupport {groupMember_ :: GroupChatScopeInfo -> Maybe GroupMember
groupMember_ = Just GroupMember
m}, Maybe MsgContentTag
Nothing) ->
    IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId])
-> IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a b. (a -> b) -> a -> b
$
      Query
-> (ChatItemId, ChatItemId, GroupChatScopeTag, ChatItemId)
-> IO [ChatItemId]
forall p. ToRow p => Query -> p -> IO [ChatItemId]
idsQuery
        (Query
baseCond Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND group_scope_tag = ? AND group_scope_group_member_id = ? ")
        (ChatItemId
userId, ChatItemId
groupId, GroupChatScopeTag
GCSTMemberSupport_, GroupMember -> ChatItemId
groupMemberId' GroupMember
m)
  (Just GCSIMemberSupport {groupMember_ :: GroupChatScopeInfo -> Maybe GroupMember
groupMember_ = Maybe GroupMember
Nothing}, Maybe MsgContentTag
Nothing) ->
    IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId])
-> IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a b. (a -> b) -> a -> b
$
      Query
-> (ChatItemId, ChatItemId, GroupChatScopeTag) -> IO [ChatItemId]
forall p. ToRow p => Query -> p -> IO [ChatItemId]
idsQuery
        (Query
baseCond Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND group_scope_tag = ? AND group_scope_group_member_id IS NULL ")
        (ChatItemId
userId, ChatItemId
groupId, GroupChatScopeTag
GCSTMemberSupport_)
  (Just GroupChatScopeInfo
_scope, Just MsgContentTag
_mcTag) ->
    StoreError -> ExceptT StoreError IO [ChatItemId]
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO [ChatItemId])
-> StoreError -> ExceptT StoreError IO [ChatItemId]
forall a b. (a -> b) -> a -> b
$ FilePath -> StoreError
SEInternalError FilePath
"group scope and content filter are not supported together"
  where
    baseQuery :: Query
baseQuery = Query
" SELECT chat_item_id FROM chat_items WHERE "
    baseCond :: Query
baseCond = Query
" user_id = ? AND group_id = ? "
    idsQuery :: ToRow p => Query -> p -> IO [ChatItemId]
    idsQuery :: forall p. ToRow p => Query -> p -> IO [ChatItemId]
idsQuery Query
c p
p = case GroupItemIDsRange
range of
      GroupItemIDsRange
GRLast -> Query -> p -> Query -> IO [ChatItemId]
forall p. ToRow p => Query -> p -> Query -> IO [ChatItemId]
rangeQuery Query
c p
p Query
" ORDER BY item_ts DESC, chat_item_id DESC "
      GRAfter UTCTime
ts ChatItemId
itemId ->
        Query
-> (p :. (Only UTCTime :. (p :. (UTCTime, ChatItemId))))
-> Query
-> IO [ChatItemId]
forall p. ToRow p => Query -> p -> Query -> IO [ChatItemId]
rangeQuery
          (Query
" item_ts > ? " Query -> Query -> Query
`orCond` Query
" item_ts = ? AND chat_item_id > ? ")
          (UTCTime
-> ChatItemId
-> p :. (Only UTCTime :. (p :. (UTCTime, ChatItemId)))
orParams UTCTime
ts ChatItemId
itemId)
          Query
" ORDER BY item_ts ASC, chat_item_id ASC "
      GRBefore UTCTime
ts ChatItemId
itemId ->
        Query
-> (p :. (Only UTCTime :. (p :. (UTCTime, ChatItemId))))
-> Query
-> IO [ChatItemId]
forall p. ToRow p => Query -> p -> Query -> IO [ChatItemId]
rangeQuery
          (Query
" item_ts < ? " Query -> Query -> Query
`orCond` Query
" item_ts = ? AND chat_item_id < ? ")
          (UTCTime
-> ChatItemId
-> p :. (Only UTCTime :. (p :. (UTCTime, ChatItemId)))
orParams UTCTime
ts ChatItemId
itemId)
          Query
" ORDER BY item_ts DESC, chat_item_id DESC "
      where
        orCond :: Query -> Query -> Query
orCond Query
c1 Query
c2 = Query
" ((" Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
c Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND " Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
c1 Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
") OR (" Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
c Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND " Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
c2 Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
")) "
        orParams :: UTCTime
-> ChatItemId
-> p :. (Only UTCTime :. (p :. (UTCTime, ChatItemId)))
orParams UTCTime
ts ChatItemId
itemId = (p
p p
-> (Only UTCTime :. (p :. (UTCTime, ChatItemId)))
-> p :. (Only UTCTime :. (p :. (UTCTime, ChatItemId)))
forall h t. h -> t -> h :. t
:. (UTCTime -> Only UTCTime
forall a. a -> Only a
Only UTCTime
ts) Only UTCTime
-> (p :. (UTCTime, ChatItemId))
-> Only UTCTime :. (p :. (UTCTime, ChatItemId))
forall h t. h -> t -> h :. t
:. p
p p -> (UTCTime, ChatItemId) -> p :. (UTCTime, ChatItemId)
forall h t. h -> t -> h :. t
:. (UTCTime
ts, ChatItemId
itemId))
    rangeQuery :: ToRow p => Query -> p -> Query -> IO [ChatItemId]
    rangeQuery :: forall p. ToRow p => Query -> p -> Query -> IO [ChatItemId]
rangeQuery Query
c p
p Query
ob
      | MemberName -> Bool
T.null MemberName
search = Query -> () -> IO [ChatItemId]
forall p. ToRow p => Query -> p -> IO [ChatItemId]
searchQuery Query
"" ()
      | Bool
otherwise = Query -> Only MemberName -> IO [ChatItemId]
forall p. ToRow p => Query -> p -> IO [ChatItemId]
searchQuery Query
" AND LOWER(item_text) LIKE '%' || LOWER(?) || '%' " (MemberName -> Only MemberName
forall a. a -> Only a
Only MemberName
search)
      where
        searchQuery :: ToRow p' => Query -> p' -> IO [ChatItemId]
        searchQuery :: forall p. ToRow p => Query -> p -> IO [ChatItemId]
searchQuery Query
c' p'
p' =
          (Only ChatItemId -> ChatItemId)
-> [Only ChatItemId] -> [ChatItemId]
forall a b. (a -> b) -> [a] -> [b]
map Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly ([Only ChatItemId] -> [ChatItemId])
-> IO [Only ChatItemId] -> IO [ChatItemId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query -> (p :. (p' :. Only Int)) -> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
baseQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
c Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
c' Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
ob Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" LIMIT ?") (p
p p -> (p' :. Only Int) -> p :. (p' :. Only Int)
forall h t. h -> t -> h :. t
:. p'
p' p' -> Only Int -> p' :. Only Int
forall h t. h -> t -> h :. t
:. Int -> Only Int
forall a. a -> Only a
Only Int
count)

safeGetGroupItem :: DB.Connection -> User -> GroupInfo -> UTCTime -> ChatItemId -> IO (CChatItem 'CTGroup)
safeGetGroupItem :: Connection
-> User
-> GroupInfo
-> UTCTime
-> ChatItemId
-> IO (CChatItem 'CTGroup)
safeGetGroupItem Connection
db User
user GroupInfo
g UTCTime
currentTs ChatItemId
itemId =
  ExceptT StoreError IO (CChatItem 'CTGroup)
-> IO (Either StoreError (CChatItem 'CTGroup))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (Connection
-> User
-> GroupInfo
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupCIWithReactions Connection
db User
user GroupInfo
g ChatItemId
itemId)
    IO (Either StoreError (CChatItem 'CTGroup))
-> (Either StoreError (CChatItem 'CTGroup)
    -> IO (CChatItem 'CTGroup))
-> IO (CChatItem 'CTGroup)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CChatItem 'CTGroup -> IO (CChatItem 'CTGroup)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CChatItem 'CTGroup -> IO (CChatItem 'CTGroup))
-> (Either StoreError (CChatItem 'CTGroup) -> CChatItem 'CTGroup)
-> Either StoreError (CChatItem 'CTGroup)
-> IO (CChatItem 'CTGroup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTCTime
-> ChatItemId
-> Either StoreError (CChatItem 'CTGroup)
-> CChatItem 'CTGroup
safeToGroupItem UTCTime
currentTs ChatItemId
itemId

safeToGroupItem :: UTCTime -> ChatItemId -> Either StoreError (CChatItem 'CTGroup) -> CChatItem 'CTGroup
safeToGroupItem :: UTCTime
-> ChatItemId
-> Either StoreError (CChatItem 'CTGroup)
-> CChatItem 'CTGroup
safeToGroupItem UTCTime
currentTs ChatItemId
itemId = \case
  Right CChatItem 'CTGroup
ci -> CChatItem 'CTGroup
ci
  Left e :: StoreError
e@(SEBadChatItem ChatItemId
_ (Just UTCTime
itemTs)) -> UTCTime -> StoreError -> CChatItem 'CTGroup
badGroupItem UTCTime
itemTs StoreError
e
  Left StoreError
e -> UTCTime -> StoreError -> CChatItem 'CTGroup
badGroupItem UTCTime
currentTs StoreError
e
  where
    badGroupItem :: UTCTime -> StoreError -> CChatItem 'CTGroup
    badGroupItem :: UTCTime -> StoreError -> CChatItem 'CTGroup
badGroupItem UTCTime
ts StoreError
e =
      let errorText :: MemberName
errorText = FilePath -> MemberName
T.pack (FilePath -> MemberName) -> FilePath -> MemberName
forall a b. (a -> b) -> a -> b
$ StoreError -> FilePath
forall a. Show a => a -> FilePath
show StoreError
e
       in SMsgDirection 'MDSnd
-> ChatItem 'CTGroup 'MDSnd -> CChatItem 'CTGroup
forall (c :: ChatType) (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> ChatItem c d -> CChatItem c
CChatItem
            SMsgDirection 'MDSnd
SMDSnd
            ChatItem
              { chatDir :: CIDirection 'CTGroup 'MDSnd
chatDir = CIDirection 'CTGroup 'MDSnd
CIGroupSnd,
                meta :: CIMeta 'CTGroup 'MDSnd
meta = ChatItemId -> UTCTime -> MemberName -> CIMeta 'CTGroup 'MDSnd
forall (c :: ChatType).
ChatItemId -> UTCTime -> MemberName -> CIMeta c 'MDSnd
dummyMeta ChatItemId
itemId UTCTime
ts MemberName
errorText,
                content :: CIContent 'MDSnd
content = MemberName -> CIContent 'MDSnd
forall (d :: MsgDirection). MemberName -> CIContent d
CIInvalidJSON MemberName
errorText,
                mentions :: Map MemberName CIMention
mentions = Map MemberName CIMention
forall k a. Map k a
M.empty,
                formattedText :: Maybe MarkdownList
formattedText = Maybe MarkdownList
forall a. Maybe a
Nothing,
                quotedItem :: Maybe (CIQuote 'CTGroup)
quotedItem = Maybe (CIQuote 'CTGroup)
forall a. Maybe a
Nothing,
                reactions :: [CIReactionCount]
reactions = [],
                file :: Maybe (CIFile 'MDSnd)
file = Maybe (CIFile 'MDSnd)
forall a. Maybe a
Nothing
              }

getGroupMemberChatItemLast :: DB.Connection -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupMemberChatItemLast :: Connection
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupMemberChatItemLast Connection
db user :: User
user@User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
groupId ChatItemId
groupMemberId = do
  ChatItemId
chatItemId <-
    IO (Either StoreError ChatItemId)
-> ExceptT StoreError IO ChatItemId
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError ChatItemId)
 -> ExceptT StoreError IO ChatItemId)
-> (IO [Only ChatItemId] -> IO (Either StoreError ChatItemId))
-> IO [Only ChatItemId]
-> ExceptT StoreError IO ChatItemId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only ChatItemId -> ChatItemId)
-> StoreError
-> IO [Only ChatItemId]
-> IO (Either StoreError ChatItemId)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly (ChatItemId -> StoreError
SEChatItemNotFoundByGroupId ChatItemId
groupId) (IO [Only ChatItemId] -> ExceptT StoreError IO ChatItemId)
-> IO [Only ChatItemId] -> ExceptT StoreError IO ChatItemId
forall a b. (a -> b) -> a -> b
$
      Connection
-> Query
-> (ChatItemId, ChatItemId, ChatItemId)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT chat_item_id
          FROM chat_items
          WHERE user_id = ? AND group_id = ? AND group_member_id = ?
          ORDER BY item_ts DESC, chat_item_id DESC
          LIMIT 1
        |]
        (ChatItemId
userId, ChatItemId
groupId, ChatItemId
groupMemberId)
  Connection
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupChatItem Connection
db User
user ChatItemId
groupId ChatItemId
chatItemId

getGroupChatAfter_ :: DB.Connection -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> Maybe MsgContentTag -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChatAfter_ :: Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> ChatItemId
-> Int
-> MemberName
-> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChatAfter_ Connection
db User
user g :: GroupInfo
g@GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} Maybe GroupChatScopeInfo
scopeInfo Maybe MsgContentTag
contentFilter ChatItemId
afterId Int
count MemberName
search = do
  CChatItem 'CTGroup
afterCI <- Connection
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupChatItem Connection
db User
user ChatItemId
groupId ChatItemId
afterId
  let range :: GroupItemIDsRange
range = UTCTime -> ChatItemId -> GroupItemIDsRange
GRAfter (CChatItem 'CTGroup -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
chatItemTs CChatItem 'CTGroup
afterCI) (CChatItem 'CTGroup -> ChatItemId
forall (c :: ChatType). CChatItem c -> ChatItemId
cChatItemId CChatItem 'CTGroup
afterCI)
  [ChatItemId]
ciIds <- Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> GroupItemIDsRange
-> Int
-> MemberName
-> ExceptT StoreError IO [ChatItemId]
getGroupChatItemIDs Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo Maybe MsgContentTag
contentFilter GroupItemIDsRange
range Int
count MemberName
search
  UTCTime
ts <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  [CChatItem 'CTGroup]
cis <- IO [CChatItem 'CTGroup]
-> ExceptT StoreError IO [CChatItem 'CTGroup]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [CChatItem 'CTGroup]
 -> ExceptT StoreError IO [CChatItem 'CTGroup])
-> IO [CChatItem 'CTGroup]
-> ExceptT StoreError IO [CChatItem 'CTGroup]
forall a b. (a -> b) -> a -> b
$ (ChatItemId -> IO (CChatItem 'CTGroup))
-> [ChatItemId] -> IO [CChatItem 'CTGroup]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Connection
-> User
-> GroupInfo
-> UTCTime
-> ChatItemId
-> IO (CChatItem 'CTGroup)
safeGetGroupItem Connection
db User
user GroupInfo
g UTCTime
ts) [ChatItemId]
ciIds
  Chat 'CTGroup -> ExceptT StoreError IO (Chat 'CTGroup)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chat 'CTGroup -> ExceptT StoreError IO (Chat 'CTGroup))
-> Chat 'CTGroup -> ExceptT StoreError IO (Chat 'CTGroup)
forall a b. (a -> b) -> a -> b
$ ChatInfo 'CTGroup
-> [CChatItem 'CTGroup] -> ChatStats -> Chat 'CTGroup
forall (c :: ChatType).
ChatInfo c -> [CChatItem c] -> ChatStats -> Chat c
Chat (GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo) [CChatItem 'CTGroup]
cis ChatStats
emptyChatStats

getGroupChatBefore_ :: DB.Connection -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> Maybe MsgContentTag -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChatBefore_ :: Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> ChatItemId
-> Int
-> MemberName
-> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChatBefore_ Connection
db User
user g :: GroupInfo
g@GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} Maybe GroupChatScopeInfo
scopeInfo Maybe MsgContentTag
contentFilter ChatItemId
beforeId Int
count MemberName
search = do
  CChatItem 'CTGroup
beforeCI <- Connection
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupChatItem Connection
db User
user ChatItemId
groupId ChatItemId
beforeId
  let range :: GroupItemIDsRange
range = UTCTime -> ChatItemId -> GroupItemIDsRange
GRBefore (CChatItem 'CTGroup -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
chatItemTs CChatItem 'CTGroup
beforeCI) (CChatItem 'CTGroup -> ChatItemId
forall (c :: ChatType). CChatItem c -> ChatItemId
cChatItemId CChatItem 'CTGroup
beforeCI)
  [ChatItemId]
ciIds <- Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> GroupItemIDsRange
-> Int
-> MemberName
-> ExceptT StoreError IO [ChatItemId]
getGroupChatItemIDs Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo Maybe MsgContentTag
contentFilter GroupItemIDsRange
range Int
count MemberName
search
  UTCTime
ts <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  [CChatItem 'CTGroup]
cis <- IO [CChatItem 'CTGroup]
-> ExceptT StoreError IO [CChatItem 'CTGroup]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [CChatItem 'CTGroup]
 -> ExceptT StoreError IO [CChatItem 'CTGroup])
-> IO [CChatItem 'CTGroup]
-> ExceptT StoreError IO [CChatItem 'CTGroup]
forall a b. (a -> b) -> a -> b
$ (ChatItemId -> IO (CChatItem 'CTGroup))
-> [ChatItemId] -> IO [CChatItem 'CTGroup]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Connection
-> User
-> GroupInfo
-> UTCTime
-> ChatItemId
-> IO (CChatItem 'CTGroup)
safeGetGroupItem Connection
db User
user GroupInfo
g UTCTime
ts) [ChatItemId]
ciIds
  Chat 'CTGroup -> ExceptT StoreError IO (Chat 'CTGroup)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chat 'CTGroup -> ExceptT StoreError IO (Chat 'CTGroup))
-> Chat 'CTGroup -> ExceptT StoreError IO (Chat 'CTGroup)
forall a b. (a -> b) -> a -> b
$ ChatInfo 'CTGroup
-> [CChatItem 'CTGroup] -> ChatStats -> Chat 'CTGroup
forall (c :: ChatType).
ChatInfo c -> [CChatItem c] -> ChatStats -> Chat c
Chat (GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo) ([CChatItem 'CTGroup] -> [CChatItem 'CTGroup]
forall a. [a] -> [a]
reverse [CChatItem 'CTGroup]
cis) ChatStats
emptyChatStats

getGroupChatAround_ :: DB.Connection -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> Maybe MsgContentTag -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
getGroupChatAround_ :: Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> ChatItemId
-> Int
-> MemberName
-> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
getGroupChatAround_ Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo Maybe MsgContentTag
contentFilter ChatItemId
aroundId Int
count MemberName
search = do
  ChatStats
stats <- Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> ExceptT StoreError IO ChatStats
getGroupStats_ Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo
  Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> ChatItemId
-> Int
-> MemberName
-> ChatStats
-> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
getGroupChatAround' Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo Maybe MsgContentTag
contentFilter ChatItemId
aroundId Int
count MemberName
search ChatStats
stats

getGroupChatAround' :: DB.Connection -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> Maybe MsgContentTag -> ChatItemId -> Int -> Text -> ChatStats -> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
getGroupChatAround' :: Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> ChatItemId
-> Int
-> MemberName
-> ChatStats
-> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
getGroupChatAround' Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo Maybe MsgContentTag
contentFilter ChatItemId
aroundId Int
count MemberName
search ChatStats
stats = do
  CChatItem 'CTGroup
aroundCI <- Connection
-> User
-> GroupInfo
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupCIWithReactions Connection
db User
user GroupInfo
g ChatItemId
aroundId
  let beforeRange :: GroupItemIDsRange
beforeRange = UTCTime -> ChatItemId -> GroupItemIDsRange
GRBefore (CChatItem 'CTGroup -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
chatItemTs CChatItem 'CTGroup
aroundCI) (CChatItem 'CTGroup -> ChatItemId
forall (c :: ChatType). CChatItem c -> ChatItemId
cChatItemId CChatItem 'CTGroup
aroundCI)
      afterRange :: GroupItemIDsRange
afterRange = UTCTime -> ChatItemId -> GroupItemIDsRange
GRAfter (CChatItem 'CTGroup -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
chatItemTs CChatItem 'CTGroup
aroundCI) (CChatItem 'CTGroup -> ChatItemId
forall (c :: ChatType). CChatItem c -> ChatItemId
cChatItemId CChatItem 'CTGroup
aroundCI)
  [ChatItemId]
beforeIds <- Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> GroupItemIDsRange
-> Int
-> MemberName
-> ExceptT StoreError IO [ChatItemId]
getGroupChatItemIDs Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo Maybe MsgContentTag
contentFilter GroupItemIDsRange
beforeRange Int
count MemberName
search
  [ChatItemId]
afterIds <- Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> GroupItemIDsRange
-> Int
-> MemberName
-> ExceptT StoreError IO [ChatItemId]
getGroupChatItemIDs Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo Maybe MsgContentTag
contentFilter GroupItemIDsRange
afterRange Int
count MemberName
search
  UTCTime
ts <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  [CChatItem 'CTGroup]
beforeCIs <- IO [CChatItem 'CTGroup]
-> ExceptT StoreError IO [CChatItem 'CTGroup]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [CChatItem 'CTGroup]
 -> ExceptT StoreError IO [CChatItem 'CTGroup])
-> IO [CChatItem 'CTGroup]
-> ExceptT StoreError IO [CChatItem 'CTGroup]
forall a b. (a -> b) -> a -> b
$ (ChatItemId -> IO (CChatItem 'CTGroup))
-> [ChatItemId] -> IO [CChatItem 'CTGroup]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Connection
-> User
-> GroupInfo
-> UTCTime
-> ChatItemId
-> IO (CChatItem 'CTGroup)
safeGetGroupItem Connection
db User
user GroupInfo
g UTCTime
ts) [ChatItemId]
beforeIds
  [CChatItem 'CTGroup]
afterCIs <- IO [CChatItem 'CTGroup]
-> ExceptT StoreError IO [CChatItem 'CTGroup]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [CChatItem 'CTGroup]
 -> ExceptT StoreError IO [CChatItem 'CTGroup])
-> IO [CChatItem 'CTGroup]
-> ExceptT StoreError IO [CChatItem 'CTGroup]
forall a b. (a -> b) -> a -> b
$ (ChatItemId -> IO (CChatItem 'CTGroup))
-> [ChatItemId] -> IO [CChatItem 'CTGroup]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Connection
-> User
-> GroupInfo
-> UTCTime
-> ChatItemId
-> IO (CChatItem 'CTGroup)
safeGetGroupItem Connection
db User
user GroupInfo
g UTCTime
ts) [ChatItemId]
afterIds
  let cis :: [CChatItem 'CTGroup]
cis = [CChatItem 'CTGroup] -> [CChatItem 'CTGroup]
forall a. [a] -> [a]
reverse [CChatItem 'CTGroup]
beforeCIs [CChatItem 'CTGroup]
-> [CChatItem 'CTGroup] -> [CChatItem 'CTGroup]
forall a. Semigroup a => a -> a -> a
<> [CChatItem 'CTGroup
aroundCI] [CChatItem 'CTGroup]
-> [CChatItem 'CTGroup] -> [CChatItem 'CTGroup]
forall a. Semigroup a => a -> a -> a
<> [CChatItem 'CTGroup]
afterCIs
  NavigationInfo
navInfo <- IO NavigationInfo -> ExceptT StoreError IO NavigationInfo
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NavigationInfo -> ExceptT StoreError IO NavigationInfo)
-> IO NavigationInfo -> ExceptT StoreError IO NavigationInfo
forall a b. (a -> b) -> a -> b
$ [CChatItem 'CTGroup] -> IO NavigationInfo
getNavInfo [CChatItem 'CTGroup]
cis
  (Chat 'CTGroup, Maybe NavigationInfo)
-> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatInfo 'CTGroup
-> [CChatItem 'CTGroup] -> ChatStats -> Chat 'CTGroup
forall (c :: ChatType).
ChatInfo c -> [CChatItem c] -> ChatStats -> Chat c
Chat (GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo) [CChatItem 'CTGroup]
cis ChatStats
stats, NavigationInfo -> Maybe NavigationInfo
forall a. a -> Maybe a
Just NavigationInfo
navInfo)
  where
    getNavInfo :: [CChatItem 'CTGroup] -> IO NavigationInfo
getNavInfo [CChatItem 'CTGroup]
cis_ = case [CChatItem 'CTGroup]
cis_ of
      [] -> NavigationInfo -> IO NavigationInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NavigationInfo -> IO NavigationInfo)
-> NavigationInfo -> IO NavigationInfo
forall a b. (a -> b) -> a -> b
$ Int -> Int -> NavigationInfo
NavigationInfo Int
0 Int
0
      [CChatItem 'CTGroup]
cis -> Connection
-> User -> GroupInfo -> CChatItem 'CTGroup -> IO NavigationInfo
getGroupNavInfo_ Connection
db User
user GroupInfo
g ([CChatItem 'CTGroup] -> CChatItem 'CTGroup
forall a. HasCallStack => [a] -> a
last [CChatItem 'CTGroup]
cis)

getGroupChatInitial_ :: DB.Connection -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> Maybe MsgContentTag -> Int -> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
getGroupChatInitial_ :: Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> Int
-> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
getGroupChatInitial_ Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo_ Maybe MsgContentTag
contentFilter Int
count = do
  Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> ExceptT StoreError IO (Maybe ChatItemId)
getGroupMinUnreadId_ Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo_ Maybe MsgContentTag
contentFilter ExceptT StoreError IO (Maybe ChatItemId)
-> (Maybe ChatItemId
    -> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo))
-> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
forall a b.
ExceptT StoreError IO a
-> (a -> ExceptT StoreError IO b) -> ExceptT StoreError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just ChatItemId
minUnreadItemId -> do
      (Int, Int)
unreadCounts <- Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> ExceptT StoreError IO (Int, Int)
getGroupUnreadCount_ Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo_ Maybe MsgContentTag
forall a. Maybe a
Nothing
      ChatStats
stats <- IO ChatStats -> ExceptT StoreError IO ChatStats
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ChatStats -> ExceptT StoreError IO ChatStats)
-> IO ChatStats -> ExceptT StoreError IO ChatStats
forall a b. (a -> b) -> a -> b
$ ChatItemId -> (Int, Int) -> IO ChatStats
getStats ChatItemId
minUnreadItemId (Int, Int)
unreadCounts
      Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> ChatItemId
-> Int
-> MemberName
-> ChatStats
-> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
getGroupChatAround' Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo_ Maybe MsgContentTag
contentFilter ChatItemId
minUnreadItemId Int
count MemberName
"" ChatStats
stats
    Maybe ChatItemId
Nothing -> do
      ChatStats
stats <- IO ChatStats -> ExceptT StoreError IO ChatStats
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ChatStats -> ExceptT StoreError IO ChatStats)
-> IO ChatStats -> ExceptT StoreError IO ChatStats
forall a b. (a -> b) -> a -> b
$ ChatItemId -> (Int, Int) -> IO ChatStats
getStats ChatItemId
0 (Int
0, Int
0)
      (,NavigationInfo -> Maybe NavigationInfo
forall a. a -> Maybe a
Just (NavigationInfo -> Maybe NavigationInfo)
-> NavigationInfo -> Maybe NavigationInfo
forall a b. (a -> b) -> a -> b
$ Int -> Int -> NavigationInfo
NavigationInfo Int
0 Int
0) (Chat 'CTGroup -> (Chat 'CTGroup, Maybe NavigationInfo))
-> ExceptT StoreError IO (Chat 'CTGroup)
-> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> Int
-> MemberName
-> ChatStats
-> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChatLast_ Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo_ Maybe MsgContentTag
contentFilter Int
count MemberName
"" ChatStats
stats
  where
    getStats :: ChatItemId -> (Int, Int) -> IO ChatStats
getStats ChatItemId
minUnreadItemId (Int
unreadCount, Int
unreadMentions) = do
      Int
reportsCount <- Connection -> User -> GroupInfo -> Bool -> IO Int
getGroupReportsCount_ Connection
db User
user GroupInfo
g Bool
False
      ChatStats -> IO ChatStats
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatStats {Int
unreadCount :: Int
unreadCount :: Int
unreadCount, Int
unreadMentions :: Int
unreadMentions :: Int
unreadMentions, Int
reportsCount :: Int
reportsCount :: Int
reportsCount, ChatItemId
minUnreadItemId :: ChatItemId
minUnreadItemId :: ChatItemId
minUnreadItemId, unreadChat :: Bool
unreadChat = Bool
False}

getGroupStats_ :: DB.Connection -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> ExceptT StoreError IO ChatStats
getGroupStats_ :: Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> ExceptT StoreError IO ChatStats
getGroupStats_ Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo_ = do
  ChatItemId
minUnreadItemId <- ChatItemId -> Maybe ChatItemId -> ChatItemId
forall a. a -> Maybe a -> a
fromMaybe ChatItemId
0 (Maybe ChatItemId -> ChatItemId)
-> ExceptT StoreError IO (Maybe ChatItemId)
-> ExceptT StoreError IO ChatItemId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> ExceptT StoreError IO (Maybe ChatItemId)
getGroupMinUnreadId_ Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo_ Maybe MsgContentTag
forall a. Maybe a
Nothing
  (Int
unreadCount, Int
unreadMentions) <- Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> ExceptT StoreError IO (Int, Int)
getGroupUnreadCount_ Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo_ Maybe MsgContentTag
forall a. Maybe a
Nothing
  Int
reportsCount <- IO Int -> ExceptT StoreError IO Int
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> ExceptT StoreError IO Int)
-> IO Int -> ExceptT StoreError IO Int
forall a b. (a -> b) -> a -> b
$ Connection -> User -> GroupInfo -> Bool -> IO Int
getGroupReportsCount_ Connection
db User
user GroupInfo
g Bool
False
  ChatStats -> ExceptT StoreError IO ChatStats
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatStats {Int
unreadCount :: Int
unreadCount :: Int
unreadCount, Int
unreadMentions :: Int
unreadMentions :: Int
unreadMentions, Int
reportsCount :: Int
reportsCount :: Int
reportsCount, ChatItemId
minUnreadItemId :: ChatItemId
minUnreadItemId :: ChatItemId
minUnreadItemId, unreadChat :: Bool
unreadChat = Bool
False}

getGroupMinUnreadId_ :: DB.Connection -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> Maybe MsgContentTag -> ExceptT StoreError IO (Maybe ChatItemId)
getGroupMinUnreadId_ :: Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> ExceptT StoreError IO (Maybe ChatItemId)
getGroupMinUnreadId_ Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo_ Maybe MsgContentTag
contentFilter =
  (Maybe (Maybe ChatItemId) -> Maybe ChatItemId)
-> ExceptT StoreError IO (Maybe (Maybe ChatItemId))
-> ExceptT StoreError IO (Maybe ChatItemId)
forall a b.
(a -> b) -> ExceptT StoreError IO a -> ExceptT StoreError IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe ChatItemId) -> Maybe ChatItemId
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ExceptT StoreError IO (Maybe (Maybe ChatItemId))
 -> ExceptT StoreError IO (Maybe ChatItemId))
-> (ExceptT StoreError IO [Only (Maybe ChatItemId)]
    -> ExceptT StoreError IO (Maybe (Maybe ChatItemId)))
-> ExceptT StoreError IO [Only (Maybe ChatItemId)]
-> ExceptT StoreError IO (Maybe ChatItemId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only (Maybe ChatItemId) -> Maybe ChatItemId)
-> ExceptT StoreError IO [Only (Maybe ChatItemId)]
-> ExceptT StoreError IO (Maybe (Maybe ChatItemId))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only (Maybe ChatItemId) -> Maybe ChatItemId
forall a. Only a -> a
fromOnly (ExceptT StoreError IO [Only (Maybe ChatItemId)]
 -> ExceptT StoreError IO (Maybe ChatItemId))
-> ExceptT StoreError IO [Only (Maybe ChatItemId)]
-> ExceptT StoreError IO (Maybe ChatItemId)
forall a b. (a -> b) -> a -> b
$
    Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> Query
-> Query
-> ExceptT StoreError IO [Only (Maybe ChatItemId)]
forall r.
FromRow r =>
Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> Query
-> Query
-> ExceptT StoreError IO [r]
queryUnreadGroupItems Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo_ Maybe MsgContentTag
contentFilter Query
baseQuery Query
orderLimit
  where
    baseQuery :: Query
baseQuery = Query
"SELECT chat_item_id FROM chat_items WHERE user_id = ? AND group_id = ? "
    orderLimit :: Query
orderLimit = Query
" ORDER BY item_ts ASC, chat_item_id ASC LIMIT 1"

getGroupUnreadCount_ :: DB.Connection -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> Maybe MsgContentTag -> ExceptT StoreError IO (Int, Int)
getGroupUnreadCount_ :: Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> ExceptT StoreError IO (Int, Int)
getGroupUnreadCount_ Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo_ Maybe MsgContentTag
contentFilter =
  [(Int, Int)] -> (Int, Int)
forall a. HasCallStack => [a] -> a
head ([(Int, Int)] -> (Int, Int))
-> ExceptT StoreError IO [(Int, Int)]
-> ExceptT StoreError IO (Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> Query
-> Query
-> ExceptT StoreError IO [(Int, Int)]
forall r.
FromRow r =>
Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> Query
-> Query
-> ExceptT StoreError IO [r]
queryUnreadGroupItems Connection
db User
user GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo_ Maybe MsgContentTag
contentFilter Query
baseQuery Query
""
  where
    baseQuery :: Query
baseQuery = Query
"SELECT COUNT(1), COALESCE(SUM(user_mention), 0) FROM chat_items WHERE user_id = ? AND group_id = ? "

getGroupReportsCount_ :: DB.Connection -> User -> GroupInfo -> Bool -> IO Int
getGroupReportsCount_ :: Connection -> User -> GroupInfo -> Bool -> IO Int
getGroupReportsCount_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} Bool
archived =
  Only Int -> Int
forall a. Only a -> a
fromOnly (Only Int -> Int) -> ([Only Int] -> Only Int) -> [Only Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Only Int] -> Only Int
forall a. HasCallStack => [a] -> a
head
    ([Only Int] -> Int) -> IO [Only Int] -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (ChatItemId, ChatItemId, MsgContentTag, BoolInt)
-> IO [Only Int]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      Query
"SELECT COUNT(1) FROM chat_items WHERE user_id = ? AND group_id = ? AND msg_content_tag = ? AND item_deleted = ? AND item_sent = 0"
      (ChatItemId
userId, ChatItemId
groupId, MsgContentTag
MCReport_, Bool -> BoolInt
BI Bool
archived)

queryUnreadGroupItems :: FromRow r => DB.Connection -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> Maybe MsgContentTag -> Query -> Query -> ExceptT StoreError IO [r]
queryUnreadGroupItems :: forall r.
FromRow r =>
Connection
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Maybe MsgContentTag
-> Query
-> Query
-> ExceptT StoreError IO [r]
queryUnreadGroupItems Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} Maybe GroupChatScopeInfo
scopeInfo_ Maybe MsgContentTag
contentFilter Query
baseQuery Query
orderLimit =
  case (Maybe GroupChatScopeInfo
scopeInfo_, Maybe MsgContentTag
contentFilter) of
    (Maybe GroupChatScopeInfo
Nothing, Maybe MsgContentTag
Nothing) ->
      IO [r] -> ExceptT StoreError IO [r]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [r] -> ExceptT StoreError IO [r])
-> IO [r] -> ExceptT StoreError IO [r]
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query -> (ChatItemId, ChatItemId, CIStatus 'MDRcv) -> IO [r]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          (Query
baseQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND group_scope_tag IS NULL AND group_scope_group_member_id IS NULL AND item_status = ? " Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
orderLimit)
          (ChatItemId
userId, ChatItemId
groupId, CIStatus 'MDRcv
CISRcvNew)
    (Maybe GroupChatScopeInfo
Nothing, Just MsgContentTag
mcTag) ->
      IO [r] -> ExceptT StoreError IO [r]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [r] -> ExceptT StoreError IO [r])
-> IO [r] -> ExceptT StoreError IO [r]
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> (ChatItemId, ChatItemId, MsgContentTag, CIStatus 'MDRcv)
-> IO [r]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          (Query
baseQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND msg_content_tag = ? AND item_status = ? " Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
orderLimit)
          (ChatItemId
userId, ChatItemId
groupId, MsgContentTag
mcTag, CIStatus 'MDRcv
CISRcvNew)
    (Just GCSIMemberSupport {groupMember_ :: GroupChatScopeInfo -> Maybe GroupMember
groupMember_ = Just GroupMember
m}, Maybe MsgContentTag
Nothing) ->
      IO [r] -> ExceptT StoreError IO [r]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [r] -> ExceptT StoreError IO [r])
-> IO [r] -> ExceptT StoreError IO [r]
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> (ChatItemId, ChatItemId, GroupChatScopeTag, ChatItemId,
    CIStatus 'MDRcv)
-> IO [r]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          (Query
baseQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND group_scope_tag = ? AND group_scope_group_member_id = ? AND item_status = ? " Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
orderLimit)
          (ChatItemId
userId, ChatItemId
groupId, GroupChatScopeTag
GCSTMemberSupport_, GroupMember -> ChatItemId
groupMemberId' GroupMember
m, CIStatus 'MDRcv
CISRcvNew)
    (Just GCSIMemberSupport {groupMember_ :: GroupChatScopeInfo -> Maybe GroupMember
groupMember_ = Maybe GroupMember
Nothing}, Maybe MsgContentTag
Nothing) ->
      IO [r] -> ExceptT StoreError IO [r]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [r] -> ExceptT StoreError IO [r])
-> IO [r] -> ExceptT StoreError IO [r]
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> (ChatItemId, ChatItemId, GroupChatScopeTag, CIStatus 'MDRcv)
-> IO [r]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          (Query
baseQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND group_scope_tag = ? AND group_scope_group_member_id IS NULL AND item_status = ? " Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
orderLimit)
          (ChatItemId
userId, ChatItemId
groupId, GroupChatScopeTag
GCSTMemberSupport_, CIStatus 'MDRcv
CISRcvNew)
    (Just GroupChatScopeInfo
_scope, Just MsgContentTag
_mcTag) ->
      StoreError -> ExceptT StoreError IO [r]
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO [r])
-> StoreError -> ExceptT StoreError IO [r]
forall a b. (a -> b) -> a -> b
$ FilePath -> StoreError
SEInternalError FilePath
"group scope and content filter are not supported together"

getGroupNavInfo_ :: DB.Connection -> User -> GroupInfo -> CChatItem 'CTGroup -> IO NavigationInfo
getGroupNavInfo_ :: Connection
-> User -> GroupInfo -> CChatItem 'CTGroup -> IO NavigationInfo
getGroupNavInfo_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} CChatItem 'CTGroup
afterCI = do
  Int
afterUnread <- IO Int
getAfterUnreadCount
  Int
afterTotal <- IO Int
getAfterTotalCount
  NavigationInfo -> IO NavigationInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NavigationInfo {Int
afterUnread :: Int
afterUnread :: Int
afterUnread, Int
afterTotal :: Int
afterTotal :: Int
afterTotal}
  where
    getAfterUnreadCount :: IO Int
    getAfterUnreadCount :: IO Int
getAfterUnreadCount =
      Only Int -> Int
forall a. Only a -> a
fromOnly (Only Int -> Int) -> ([Only Int] -> Only Int) -> [Only Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Only Int] -> Only Int
forall a. HasCallStack => [a] -> a
head
        ([Only Int] -> Int) -> IO [Only Int] -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> ((ChatItemId, ChatItemId, CIStatus 'MDRcv, UTCTime)
    :. (ChatItemId, ChatItemId, CIStatus 'MDRcv, UTCTime, ChatItemId))
-> IO [Only Int]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT COUNT(1)
            FROM (
              SELECT 1
              FROM chat_items
              WHERE user_id = ? AND group_id = ? AND item_status = ?
                AND item_ts > ?
              UNION ALL
              SELECT 1
              FROM chat_items
              WHERE user_id = ? AND group_id = ? AND item_status = ?
                AND item_ts = ? AND chat_item_id > ?
            ) ci
          |]
          ( (ChatItemId
userId, ChatItemId
groupId, CIStatus 'MDRcv
CISRcvNew, CChatItem 'CTGroup -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
chatItemTs CChatItem 'CTGroup
afterCI)
              (ChatItemId, ChatItemId, CIStatus 'MDRcv, UTCTime)
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv, UTCTime, ChatItemId)
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv, UTCTime)
   :. (ChatItemId, ChatItemId, CIStatus 'MDRcv, UTCTime, ChatItemId)
forall h t. h -> t -> h :. t
:. (ChatItemId
userId, ChatItemId
groupId, CIStatus 'MDRcv
CISRcvNew, CChatItem 'CTGroup -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
chatItemTs CChatItem 'CTGroup
afterCI, CChatItem 'CTGroup -> ChatItemId
forall (c :: ChatType). CChatItem c -> ChatItemId
cChatItemId CChatItem 'CTGroup
afterCI)
          )
    getAfterTotalCount :: IO Int
    getAfterTotalCount :: IO Int
getAfterTotalCount =
      Only Int -> Int
forall a. Only a -> a
fromOnly (Only Int -> Int) -> ([Only Int] -> Only Int) -> [Only Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Only Int] -> Only Int
forall a. HasCallStack => [a] -> a
head
        ([Only Int] -> Int) -> IO [Only Int] -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> ((ChatItemId, ChatItemId, UTCTime)
    :. (ChatItemId, ChatItemId, UTCTime, ChatItemId))
-> IO [Only Int]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT COUNT(1)
            FROM (
              SELECT 1
              FROM chat_items
              WHERE user_id = ? AND group_id = ?
                AND item_ts > ?
              UNION ALL
              SELECT 1
              FROM chat_items
              WHERE user_id = ? AND group_id = ?
                AND item_ts = ? AND chat_item_id > ?
            ) ci
          |]
          ( (ChatItemId
userId, ChatItemId
groupId, CChatItem 'CTGroup -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
chatItemTs CChatItem 'CTGroup
afterCI)
              (ChatItemId, ChatItemId, UTCTime)
-> (ChatItemId, ChatItemId, UTCTime, ChatItemId)
-> (ChatItemId, ChatItemId, UTCTime)
   :. (ChatItemId, ChatItemId, UTCTime, ChatItemId)
forall h t. h -> t -> h :. t
:. (ChatItemId
userId, ChatItemId
groupId, CChatItem 'CTGroup -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
chatItemTs CChatItem 'CTGroup
afterCI, CChatItem 'CTGroup -> ChatItemId
forall (c :: ChatType). CChatItem c -> ChatItemId
cChatItemId CChatItem 'CTGroup
afterCI)
          )

getLocalChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe Text -> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChat :: Connection
-> User
-> ChatItemId
-> ChatPagination
-> Maybe MemberName
-> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChat Connection
db User
user ChatItemId
folderId ChatPagination
pagination Maybe MemberName
search_ = do
  let search :: MemberName
search = MemberName -> Maybe MemberName -> MemberName
forall a. a -> Maybe a -> a
fromMaybe MemberName
"" Maybe MemberName
search_
  NoteFolder
nf <- Connection
-> User -> ChatItemId -> ExceptT StoreError IO NoteFolder
getNoteFolder Connection
db User
user ChatItemId
folderId
  case ChatPagination
pagination of
    CPLast Int
count -> IO (Chat 'CTLocal, Maybe NavigationInfo)
-> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Chat 'CTLocal, Maybe NavigationInfo)
 -> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo))
-> IO (Chat 'CTLocal, Maybe NavigationInfo)
-> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
forall a b. (a -> b) -> a -> b
$ (,Maybe NavigationInfo
forall a. Maybe a
Nothing) (Chat 'CTLocal -> (Chat 'CTLocal, Maybe NavigationInfo))
-> IO (Chat 'CTLocal) -> IO (Chat 'CTLocal, Maybe NavigationInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> User -> NoteFolder -> Int -> MemberName -> IO (Chat 'CTLocal)
getLocalChatLast_ Connection
db User
user NoteFolder
nf Int
count MemberName
search
    CPAfter ChatItemId
afterId Int
count -> (,Maybe NavigationInfo
forall a. Maybe a
Nothing) (Chat 'CTLocal -> (Chat 'CTLocal, Maybe NavigationInfo))
-> ExceptT StoreError IO (Chat 'CTLocal)
-> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> User
-> NoteFolder
-> ChatItemId
-> Int
-> MemberName
-> ExceptT StoreError IO (Chat 'CTLocal)
getLocalChatAfter_ Connection
db User
user NoteFolder
nf ChatItemId
afterId Int
count MemberName
search
    CPBefore ChatItemId
beforeId Int
count -> (,Maybe NavigationInfo
forall a. Maybe a
Nothing) (Chat 'CTLocal -> (Chat 'CTLocal, Maybe NavigationInfo))
-> ExceptT StoreError IO (Chat 'CTLocal)
-> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> User
-> NoteFolder
-> ChatItemId
-> Int
-> MemberName
-> ExceptT StoreError IO (Chat 'CTLocal)
getLocalChatBefore_ Connection
db User
user NoteFolder
nf ChatItemId
beforeId Int
count MemberName
search
    CPAround ChatItemId
aroundId Int
count -> Connection
-> User
-> NoteFolder
-> ChatItemId
-> Int
-> MemberName
-> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChatAround_ Connection
db User
user NoteFolder
nf ChatItemId
aroundId Int
count MemberName
search
    CPInitial Int
count -> do
      Bool -> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (MemberName -> Bool
T.null MemberName
search) (ExceptT StoreError IO () -> ExceptT StoreError IO ())
-> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ StoreError -> ExceptT StoreError IO ()
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO ())
-> StoreError -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> StoreError
SEInternalError FilePath
"initial chat pagination doesn't support search"
      Connection
-> User
-> NoteFolder
-> Int
-> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChatInitial_ Connection
db User
user NoteFolder
nf Int
count

getLocalChatLast_ :: DB.Connection -> User -> NoteFolder -> Int -> Text -> IO (Chat 'CTLocal)
getLocalChatLast_ :: Connection
-> User -> NoteFolder -> Int -> MemberName -> IO (Chat 'CTLocal)
getLocalChatLast_ Connection
db User
user NoteFolder
nf Int
count MemberName
search = do
  [ChatItemId]
ciIds <- Connection
-> User -> NoteFolder -> Int -> MemberName -> IO [ChatItemId]
getLocalChatItemIdsLast_ Connection
db User
user NoteFolder
nf Int
count MemberName
search
  UTCTime
ts <- IO UTCTime
getCurrentTime
  [CChatItem 'CTLocal]
cis <- (ChatItemId -> IO (CChatItem 'CTLocal))
-> [ChatItemId] -> IO [CChatItem 'CTLocal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Connection
-> User
-> NoteFolder
-> UTCTime
-> ChatItemId
-> IO (CChatItem 'CTLocal)
safeGetLocalItem Connection
db User
user NoteFolder
nf UTCTime
ts) [ChatItemId]
ciIds
  Chat 'CTLocal -> IO (Chat 'CTLocal)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chat 'CTLocal -> IO (Chat 'CTLocal))
-> Chat 'CTLocal -> IO (Chat 'CTLocal)
forall a b. (a -> b) -> a -> b
$ ChatInfo 'CTLocal
-> [CChatItem 'CTLocal] -> ChatStats -> Chat 'CTLocal
forall (c :: ChatType).
ChatInfo c -> [CChatItem c] -> ChatStats -> Chat c
Chat (NoteFolder -> ChatInfo 'CTLocal
LocalChat NoteFolder
nf) ([CChatItem 'CTLocal] -> [CChatItem 'CTLocal]
forall a. [a] -> [a]
reverse [CChatItem 'CTLocal]
cis) ChatStats
emptyChatStats

getLocalChatItemIdsLast_ :: DB.Connection -> User -> NoteFolder -> Int -> Text -> IO [ChatItemId]
getLocalChatItemIdsLast_ :: Connection
-> User -> NoteFolder -> Int -> MemberName -> IO [ChatItemId]
getLocalChatItemIdsLast_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} NoteFolder {ChatItemId
noteFolderId :: NoteFolder -> ChatItemId
noteFolderId :: ChatItemId
noteFolderId} Int
count MemberName
search =
  (Only ChatItemId -> ChatItemId)
-> [Only ChatItemId] -> [ChatItemId]
forall a b. (a -> b) -> [a] -> [b]
map Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly
    ([Only ChatItemId] -> [ChatItemId])
-> IO [Only ChatItemId] -> IO [ChatItemId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (ChatItemId, ChatItemId, MemberName, Int)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT chat_item_id
        FROM chat_items
        WHERE user_id = ? AND note_folder_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
        ORDER BY created_at DESC, chat_item_id DESC
        LIMIT ?
      |]
      (ChatItemId
userId, ChatItemId
noteFolderId, MemberName
search, Int
count)

safeGetLocalItem :: DB.Connection -> User -> NoteFolder -> UTCTime -> ChatItemId -> IO (CChatItem 'CTLocal)
safeGetLocalItem :: Connection
-> User
-> NoteFolder
-> UTCTime
-> ChatItemId
-> IO (CChatItem 'CTLocal)
safeGetLocalItem Connection
db User
user NoteFolder {ChatItemId
noteFolderId :: NoteFolder -> ChatItemId
noteFolderId :: ChatItemId
noteFolderId} UTCTime
currentTs ChatItemId
itemId =
  ExceptT StoreError IO (CChatItem 'CTLocal)
-> IO (Either StoreError (CChatItem 'CTLocal))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (Connection
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTLocal)
getLocalChatItem Connection
db User
user ChatItemId
noteFolderId ChatItemId
itemId)
    IO (Either StoreError (CChatItem 'CTLocal))
-> (Either StoreError (CChatItem 'CTLocal)
    -> IO (CChatItem 'CTLocal))
-> IO (CChatItem 'CTLocal)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CChatItem 'CTLocal -> IO (CChatItem 'CTLocal)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CChatItem 'CTLocal -> IO (CChatItem 'CTLocal))
-> (Either StoreError (CChatItem 'CTLocal) -> CChatItem 'CTLocal)
-> Either StoreError (CChatItem 'CTLocal)
-> IO (CChatItem 'CTLocal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTCTime
-> ChatItemId
-> Either StoreError (CChatItem 'CTLocal)
-> CChatItem 'CTLocal
safeToLocalItem UTCTime
currentTs ChatItemId
itemId

safeToLocalItem :: UTCTime -> ChatItemId -> Either StoreError (CChatItem 'CTLocal) -> CChatItem 'CTLocal
safeToLocalItem :: UTCTime
-> ChatItemId
-> Either StoreError (CChatItem 'CTLocal)
-> CChatItem 'CTLocal
safeToLocalItem UTCTime
currentTs ChatItemId
itemId = \case
  Right CChatItem 'CTLocal
ci -> CChatItem 'CTLocal
ci
  Left e :: StoreError
e@(SEBadChatItem ChatItemId
_ (Just UTCTime
itemTs)) -> UTCTime -> StoreError -> CChatItem 'CTLocal
badLocalItem UTCTime
itemTs StoreError
e
  Left StoreError
e -> UTCTime -> StoreError -> CChatItem 'CTLocal
badLocalItem UTCTime
currentTs StoreError
e
  where
    badLocalItem :: UTCTime -> StoreError -> CChatItem 'CTLocal
    badLocalItem :: UTCTime -> StoreError -> CChatItem 'CTLocal
badLocalItem UTCTime
ts StoreError
e =
      let errorText :: MemberName
errorText = FilePath -> MemberName
T.pack (FilePath -> MemberName) -> FilePath -> MemberName
forall a b. (a -> b) -> a -> b
$ StoreError -> FilePath
forall a. Show a => a -> FilePath
show StoreError
e
       in SMsgDirection 'MDSnd
-> ChatItem 'CTLocal 'MDSnd -> CChatItem 'CTLocal
forall (c :: ChatType) (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> ChatItem c d -> CChatItem c
CChatItem
            SMsgDirection 'MDSnd
SMDSnd
            ChatItem
              { chatDir :: CIDirection 'CTLocal 'MDSnd
chatDir = CIDirection 'CTLocal 'MDSnd
CILocalSnd,
                meta :: CIMeta 'CTLocal 'MDSnd
meta = ChatItemId -> UTCTime -> MemberName -> CIMeta 'CTLocal 'MDSnd
forall (c :: ChatType).
ChatItemId -> UTCTime -> MemberName -> CIMeta c 'MDSnd
dummyMeta ChatItemId
itemId UTCTime
ts MemberName
errorText,
                content :: CIContent 'MDSnd
content = MemberName -> CIContent 'MDSnd
forall (d :: MsgDirection). MemberName -> CIContent d
CIInvalidJSON MemberName
errorText,
                mentions :: Map MemberName CIMention
mentions = Map MemberName CIMention
forall k a. Map k a
M.empty,
                formattedText :: Maybe MarkdownList
formattedText = Maybe MarkdownList
forall a. Maybe a
Nothing,
                quotedItem :: Maybe (CIQuote 'CTLocal)
quotedItem = Maybe (CIQuote 'CTLocal)
forall a. Maybe a
Nothing,
                reactions :: [CIReactionCount]
reactions = [],
                file :: Maybe (CIFile 'MDSnd)
file = Maybe (CIFile 'MDSnd)
forall a. Maybe a
Nothing
              }

getLocalChatAfter_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTLocal)
getLocalChatAfter_ :: Connection
-> User
-> NoteFolder
-> ChatItemId
-> Int
-> MemberName
-> ExceptT StoreError IO (Chat 'CTLocal)
getLocalChatAfter_ Connection
db User
user nf :: NoteFolder
nf@NoteFolder {ChatItemId
noteFolderId :: NoteFolder -> ChatItemId
noteFolderId :: ChatItemId
noteFolderId} ChatItemId
afterId Int
count MemberName
search = do
  CChatItem 'CTLocal
afterCI <- Connection
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTLocal)
getLocalChatItem Connection
db User
user ChatItemId
noteFolderId ChatItemId
afterId
  [ChatItemId]
ciIds <- IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId])
-> IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a b. (a -> b) -> a -> b
$ Connection
-> User
-> NoteFolder
-> CChatItem 'CTLocal
-> Int
-> MemberName
-> IO [ChatItemId]
getLocalCIsAfter_ Connection
db User
user NoteFolder
nf CChatItem 'CTLocal
afterCI Int
count MemberName
search
  UTCTime
ts <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  [CChatItem 'CTLocal]
cis <- IO [CChatItem 'CTLocal]
-> ExceptT StoreError IO [CChatItem 'CTLocal]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [CChatItem 'CTLocal]
 -> ExceptT StoreError IO [CChatItem 'CTLocal])
-> IO [CChatItem 'CTLocal]
-> ExceptT StoreError IO [CChatItem 'CTLocal]
forall a b. (a -> b) -> a -> b
$ (ChatItemId -> IO (CChatItem 'CTLocal))
-> [ChatItemId] -> IO [CChatItem 'CTLocal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Connection
-> User
-> NoteFolder
-> UTCTime
-> ChatItemId
-> IO (CChatItem 'CTLocal)
safeGetLocalItem Connection
db User
user NoteFolder
nf UTCTime
ts) [ChatItemId]
ciIds
  Chat 'CTLocal -> ExceptT StoreError IO (Chat 'CTLocal)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chat 'CTLocal -> ExceptT StoreError IO (Chat 'CTLocal))
-> Chat 'CTLocal -> ExceptT StoreError IO (Chat 'CTLocal)
forall a b. (a -> b) -> a -> b
$ ChatInfo 'CTLocal
-> [CChatItem 'CTLocal] -> ChatStats -> Chat 'CTLocal
forall (c :: ChatType).
ChatInfo c -> [CChatItem c] -> ChatStats -> Chat c
Chat (NoteFolder -> ChatInfo 'CTLocal
LocalChat NoteFolder
nf) [CChatItem 'CTLocal]
cis ChatStats
emptyChatStats

getLocalCIsAfter_ :: DB.Connection -> User -> NoteFolder -> CChatItem 'CTLocal -> Int -> Text -> IO [ChatItemId]
getLocalCIsAfter_ :: Connection
-> User
-> NoteFolder
-> CChatItem 'CTLocal
-> Int
-> MemberName
-> IO [ChatItemId]
getLocalCIsAfter_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} NoteFolder {ChatItemId
noteFolderId :: NoteFolder -> ChatItemId
noteFolderId :: ChatItemId
noteFolderId} CChatItem 'CTLocal
afterCI Int
count MemberName
search =
  (Only ChatItemId -> ChatItemId)
-> [Only ChatItemId] -> [ChatItemId]
forall a b. (a -> b) -> [a] -> [b]
map Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly
    ([Only ChatItemId] -> [ChatItemId])
-> IO [Only ChatItemId] -> IO [ChatItemId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (ChatItemId, ChatItemId, MemberName, UTCTime, UTCTime,
    ChatItemId, Int)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT chat_item_id
        FROM chat_items
        WHERE user_id = ? AND note_folder_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
          AND (created_at > ? OR (created_at = ? AND chat_item_id > ?))
        ORDER BY created_at ASC, chat_item_id ASC
        LIMIT ?
      |]
      (ChatItemId
userId, ChatItemId
noteFolderId, MemberName
search, CChatItem 'CTLocal -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
ciCreatedAt CChatItem 'CTLocal
afterCI, CChatItem 'CTLocal -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
ciCreatedAt CChatItem 'CTLocal
afterCI, CChatItem 'CTLocal -> ChatItemId
forall (c :: ChatType). CChatItem c -> ChatItemId
cChatItemId CChatItem 'CTLocal
afterCI, Int
count)

getLocalChatBefore_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTLocal)
getLocalChatBefore_ :: Connection
-> User
-> NoteFolder
-> ChatItemId
-> Int
-> MemberName
-> ExceptT StoreError IO (Chat 'CTLocal)
getLocalChatBefore_ Connection
db User
user nf :: NoteFolder
nf@NoteFolder {ChatItemId
noteFolderId :: NoteFolder -> ChatItemId
noteFolderId :: ChatItemId
noteFolderId} ChatItemId
beforeId Int
count MemberName
search = do
  CChatItem 'CTLocal
beforeCI <- Connection
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTLocal)
getLocalChatItem Connection
db User
user ChatItemId
noteFolderId ChatItemId
beforeId
  [ChatItemId]
ciIds <- IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId])
-> IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a b. (a -> b) -> a -> b
$ Connection
-> User
-> NoteFolder
-> CChatItem 'CTLocal
-> Int
-> MemberName
-> IO [ChatItemId]
getLocalCIsBefore_ Connection
db User
user NoteFolder
nf CChatItem 'CTLocal
beforeCI Int
count MemberName
search
  UTCTime
ts <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  [CChatItem 'CTLocal]
cis <- IO [CChatItem 'CTLocal]
-> ExceptT StoreError IO [CChatItem 'CTLocal]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [CChatItem 'CTLocal]
 -> ExceptT StoreError IO [CChatItem 'CTLocal])
-> IO [CChatItem 'CTLocal]
-> ExceptT StoreError IO [CChatItem 'CTLocal]
forall a b. (a -> b) -> a -> b
$ (ChatItemId -> IO (CChatItem 'CTLocal))
-> [ChatItemId] -> IO [CChatItem 'CTLocal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Connection
-> User
-> NoteFolder
-> UTCTime
-> ChatItemId
-> IO (CChatItem 'CTLocal)
safeGetLocalItem Connection
db User
user NoteFolder
nf UTCTime
ts) [ChatItemId]
ciIds
  Chat 'CTLocal -> ExceptT StoreError IO (Chat 'CTLocal)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chat 'CTLocal -> ExceptT StoreError IO (Chat 'CTLocal))
-> Chat 'CTLocal -> ExceptT StoreError IO (Chat 'CTLocal)
forall a b. (a -> b) -> a -> b
$ ChatInfo 'CTLocal
-> [CChatItem 'CTLocal] -> ChatStats -> Chat 'CTLocal
forall (c :: ChatType).
ChatInfo c -> [CChatItem c] -> ChatStats -> Chat c
Chat (NoteFolder -> ChatInfo 'CTLocal
LocalChat NoteFolder
nf) ([CChatItem 'CTLocal] -> [CChatItem 'CTLocal]
forall a. [a] -> [a]
reverse [CChatItem 'CTLocal]
cis) ChatStats
emptyChatStats

getLocalCIsBefore_ :: DB.Connection -> User -> NoteFolder -> CChatItem 'CTLocal -> Int -> Text -> IO [ChatItemId]
getLocalCIsBefore_ :: Connection
-> User
-> NoteFolder
-> CChatItem 'CTLocal
-> Int
-> MemberName
-> IO [ChatItemId]
getLocalCIsBefore_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} NoteFolder {ChatItemId
noteFolderId :: NoteFolder -> ChatItemId
noteFolderId :: ChatItemId
noteFolderId} CChatItem 'CTLocal
beforeCI Int
count MemberName
search =
  (Only ChatItemId -> ChatItemId)
-> [Only ChatItemId] -> [ChatItemId]
forall a b. (a -> b) -> [a] -> [b]
map Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly
    ([Only ChatItemId] -> [ChatItemId])
-> IO [Only ChatItemId] -> IO [ChatItemId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (ChatItemId, ChatItemId, MemberName, UTCTime, UTCTime,
    ChatItemId, Int)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT chat_item_id
        FROM chat_items
        WHERE user_id = ? AND note_folder_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
          AND (created_at < ? OR (created_at = ? AND chat_item_id < ?))
        ORDER BY created_at DESC, chat_item_id DESC
        LIMIT ?
      |]
      (ChatItemId
userId, ChatItemId
noteFolderId, MemberName
search, CChatItem 'CTLocal -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
ciCreatedAt CChatItem 'CTLocal
beforeCI, CChatItem 'CTLocal -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
ciCreatedAt CChatItem 'CTLocal
beforeCI, CChatItem 'CTLocal -> ChatItemId
forall (c :: ChatType). CChatItem c -> ChatItemId
cChatItemId CChatItem 'CTLocal
beforeCI, Int
count)

getLocalChatAround_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChatAround_ :: Connection
-> User
-> NoteFolder
-> ChatItemId
-> Int
-> MemberName
-> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChatAround_ Connection
db User
user NoteFolder
nf ChatItemId
aroundId Int
count MemberName
search = do
  ChatStats
stats <- IO ChatStats -> ExceptT StoreError IO ChatStats
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ChatStats -> ExceptT StoreError IO ChatStats)
-> IO ChatStats -> ExceptT StoreError IO ChatStats
forall a b. (a -> b) -> a -> b
$ Connection -> User -> NoteFolder -> IO ChatStats
getLocalStats_ Connection
db User
user NoteFolder
nf
  Connection
-> User
-> NoteFolder
-> ChatItemId
-> Int
-> MemberName
-> ChatStats
-> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChatAround' Connection
db User
user NoteFolder
nf ChatItemId
aroundId Int
count MemberName
search ChatStats
stats

getLocalChatAround' :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> Text -> ChatStats -> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChatAround' :: Connection
-> User
-> NoteFolder
-> ChatItemId
-> Int
-> MemberName
-> ChatStats
-> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChatAround' Connection
db User
user nf :: NoteFolder
nf@NoteFolder {ChatItemId
noteFolderId :: NoteFolder -> ChatItemId
noteFolderId :: ChatItemId
noteFolderId} ChatItemId
aroundId Int
count MemberName
search ChatStats
stats = do
  CChatItem 'CTLocal
aroundCI <- Connection
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTLocal)
getLocalChatItem Connection
db User
user ChatItemId
noteFolderId ChatItemId
aroundId
  [ChatItemId]
beforeIds <- IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId])
-> IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a b. (a -> b) -> a -> b
$ Connection
-> User
-> NoteFolder
-> CChatItem 'CTLocal
-> Int
-> MemberName
-> IO [ChatItemId]
getLocalCIsBefore_ Connection
db User
user NoteFolder
nf CChatItem 'CTLocal
aroundCI Int
count MemberName
search
  [ChatItemId]
afterIds <- IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId])
-> IO [ChatItemId] -> ExceptT StoreError IO [ChatItemId]
forall a b. (a -> b) -> a -> b
$ Connection
-> User
-> NoteFolder
-> CChatItem 'CTLocal
-> Int
-> MemberName
-> IO [ChatItemId]
getLocalCIsAfter_ Connection
db User
user NoteFolder
nf CChatItem 'CTLocal
aroundCI Int
count MemberName
search
  UTCTime
ts <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  [CChatItem 'CTLocal]
beforeCIs <- IO [CChatItem 'CTLocal]
-> ExceptT StoreError IO [CChatItem 'CTLocal]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [CChatItem 'CTLocal]
 -> ExceptT StoreError IO [CChatItem 'CTLocal])
-> IO [CChatItem 'CTLocal]
-> ExceptT StoreError IO [CChatItem 'CTLocal]
forall a b. (a -> b) -> a -> b
$ (ChatItemId -> IO (CChatItem 'CTLocal))
-> [ChatItemId] -> IO [CChatItem 'CTLocal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Connection
-> User
-> NoteFolder
-> UTCTime
-> ChatItemId
-> IO (CChatItem 'CTLocal)
safeGetLocalItem Connection
db User
user NoteFolder
nf UTCTime
ts) [ChatItemId]
beforeIds
  [CChatItem 'CTLocal]
afterCIs <- IO [CChatItem 'CTLocal]
-> ExceptT StoreError IO [CChatItem 'CTLocal]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [CChatItem 'CTLocal]
 -> ExceptT StoreError IO [CChatItem 'CTLocal])
-> IO [CChatItem 'CTLocal]
-> ExceptT StoreError IO [CChatItem 'CTLocal]
forall a b. (a -> b) -> a -> b
$ (ChatItemId -> IO (CChatItem 'CTLocal))
-> [ChatItemId] -> IO [CChatItem 'CTLocal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Connection
-> User
-> NoteFolder
-> UTCTime
-> ChatItemId
-> IO (CChatItem 'CTLocal)
safeGetLocalItem Connection
db User
user NoteFolder
nf UTCTime
ts) [ChatItemId]
afterIds
  let cis :: [CChatItem 'CTLocal]
cis = [CChatItem 'CTLocal] -> [CChatItem 'CTLocal]
forall a. [a] -> [a]
reverse [CChatItem 'CTLocal]
beforeCIs [CChatItem 'CTLocal]
-> [CChatItem 'CTLocal] -> [CChatItem 'CTLocal]
forall a. Semigroup a => a -> a -> a
<> [CChatItem 'CTLocal
aroundCI] [CChatItem 'CTLocal]
-> [CChatItem 'CTLocal] -> [CChatItem 'CTLocal]
forall a. Semigroup a => a -> a -> a
<> [CChatItem 'CTLocal]
afterCIs
  NavigationInfo
navInfo <- IO NavigationInfo -> ExceptT StoreError IO NavigationInfo
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NavigationInfo -> ExceptT StoreError IO NavigationInfo)
-> IO NavigationInfo -> ExceptT StoreError IO NavigationInfo
forall a b. (a -> b) -> a -> b
$ [CChatItem 'CTLocal] -> IO NavigationInfo
getNavInfo [CChatItem 'CTLocal]
cis
  (Chat 'CTLocal, Maybe NavigationInfo)
-> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatInfo 'CTLocal
-> [CChatItem 'CTLocal] -> ChatStats -> Chat 'CTLocal
forall (c :: ChatType).
ChatInfo c -> [CChatItem c] -> ChatStats -> Chat c
Chat (NoteFolder -> ChatInfo 'CTLocal
LocalChat NoteFolder
nf) [CChatItem 'CTLocal]
cis ChatStats
stats, NavigationInfo -> Maybe NavigationInfo
forall a. a -> Maybe a
Just NavigationInfo
navInfo)
  where
    getNavInfo :: [CChatItem 'CTLocal] -> IO NavigationInfo
getNavInfo [CChatItem 'CTLocal]
cis_ = case [CChatItem 'CTLocal]
cis_ of
      [] -> NavigationInfo -> IO NavigationInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NavigationInfo -> IO NavigationInfo)
-> NavigationInfo -> IO NavigationInfo
forall a b. (a -> b) -> a -> b
$ Int -> Int -> NavigationInfo
NavigationInfo Int
0 Int
0
      [CChatItem 'CTLocal]
cis -> Connection
-> User -> NoteFolder -> CChatItem 'CTLocal -> IO NavigationInfo
getLocalNavInfo_ Connection
db User
user NoteFolder
nf ([CChatItem 'CTLocal] -> CChatItem 'CTLocal
forall a. HasCallStack => [a] -> a
last [CChatItem 'CTLocal]
cis)

getLocalChatInitial_ :: DB.Connection -> User -> NoteFolder -> Int -> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChatInitial_ :: Connection
-> User
-> NoteFolder
-> Int
-> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChatInitial_ Connection
db User
user NoteFolder
nf Int
count = do
  IO (Maybe ChatItemId) -> ExceptT StoreError IO (Maybe ChatItemId)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Connection -> User -> NoteFolder -> IO (Maybe ChatItemId)
getLocalMinUnreadId_ Connection
db User
user NoteFolder
nf) ExceptT StoreError IO (Maybe ChatItemId)
-> (Maybe ChatItemId
    -> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo))
-> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
forall a b.
ExceptT StoreError IO a
-> (a -> ExceptT StoreError IO b) -> ExceptT StoreError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just ChatItemId
minUnreadItemId -> do
      Int
unreadCount <- IO Int -> ExceptT StoreError IO Int
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> ExceptT StoreError IO Int)
-> IO Int -> ExceptT StoreError IO Int
forall a b. (a -> b) -> a -> b
$ Connection -> User -> NoteFolder -> IO Int
getLocalUnreadCount_ Connection
db User
user NoteFolder
nf
      let stats :: ChatStats
stats = ChatStats
emptyChatStats {unreadCount, minUnreadItemId}
      Connection
-> User
-> NoteFolder
-> ChatItemId
-> Int
-> MemberName
-> ChatStats
-> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChatAround' Connection
db User
user NoteFolder
nf ChatItemId
minUnreadItemId Int
count MemberName
"" ChatStats
stats
    Maybe ChatItemId
Nothing -> IO (Chat 'CTLocal, Maybe NavigationInfo)
-> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Chat 'CTLocal, Maybe NavigationInfo)
 -> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo))
-> IO (Chat 'CTLocal, Maybe NavigationInfo)
-> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
forall a b. (a -> b) -> a -> b
$ (,NavigationInfo -> Maybe NavigationInfo
forall a. a -> Maybe a
Just (NavigationInfo -> Maybe NavigationInfo)
-> NavigationInfo -> Maybe NavigationInfo
forall a b. (a -> b) -> a -> b
$ Int -> Int -> NavigationInfo
NavigationInfo Int
0 Int
0) (Chat 'CTLocal -> (Chat 'CTLocal, Maybe NavigationInfo))
-> IO (Chat 'CTLocal) -> IO (Chat 'CTLocal, Maybe NavigationInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> User -> NoteFolder -> Int -> MemberName -> IO (Chat 'CTLocal)
getLocalChatLast_ Connection
db User
user NoteFolder
nf Int
count MemberName
""

getLocalStats_ :: DB.Connection -> User -> NoteFolder -> IO ChatStats
getLocalStats_ :: Connection -> User -> NoteFolder -> IO ChatStats
getLocalStats_ Connection
db User
user NoteFolder
nf = do
  ChatItemId
minUnreadItemId <- ChatItemId -> Maybe ChatItemId -> ChatItemId
forall a. a -> Maybe a -> a
fromMaybe ChatItemId
0 (Maybe ChatItemId -> ChatItemId)
-> IO (Maybe ChatItemId) -> IO ChatItemId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> User -> NoteFolder -> IO (Maybe ChatItemId)
getLocalMinUnreadId_ Connection
db User
user NoteFolder
nf
  Int
unreadCount <- Connection -> User -> NoteFolder -> IO Int
getLocalUnreadCount_ Connection
db User
user NoteFolder
nf
  ChatStats -> IO ChatStats
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatStats
emptyChatStats {unreadCount, minUnreadItemId}

getLocalMinUnreadId_ :: DB.Connection -> User -> NoteFolder -> IO (Maybe ChatItemId)
getLocalMinUnreadId_ :: Connection -> User -> NoteFolder -> IO (Maybe ChatItemId)
getLocalMinUnreadId_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} NoteFolder {ChatItemId
noteFolderId :: NoteFolder -> ChatItemId
noteFolderId :: ChatItemId
noteFolderId} =
  (Maybe (Maybe ChatItemId) -> Maybe ChatItemId)
-> IO (Maybe (Maybe ChatItemId)) -> IO (Maybe ChatItemId)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe ChatItemId) -> Maybe ChatItemId
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (Maybe (Maybe ChatItemId)) -> IO (Maybe ChatItemId))
-> (IO [Only (Maybe ChatItemId)] -> IO (Maybe (Maybe ChatItemId)))
-> IO [Only (Maybe ChatItemId)]
-> IO (Maybe ChatItemId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only (Maybe ChatItemId) -> Maybe ChatItemId)
-> IO [Only (Maybe ChatItemId)] -> IO (Maybe (Maybe ChatItemId))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only (Maybe ChatItemId) -> Maybe ChatItemId
forall a. Only a -> a
fromOnly (IO [Only (Maybe ChatItemId)] -> IO (Maybe ChatItemId))
-> IO [Only (Maybe ChatItemId)] -> IO (Maybe ChatItemId)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv)
-> IO [Only (Maybe ChatItemId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT chat_item_id
        FROM chat_items
        WHERE user_id = ? AND note_folder_id = ? AND item_status = ?
        ORDER BY created_at ASC, chat_item_id ASC
        LIMIT 1
      |]
      (ChatItemId
userId, ChatItemId
noteFolderId, CIStatus 'MDRcv
CISRcvNew)

getLocalUnreadCount_ :: DB.Connection -> User -> NoteFolder -> IO Int
getLocalUnreadCount_ :: Connection -> User -> NoteFolder -> IO Int
getLocalUnreadCount_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} NoteFolder {ChatItemId
noteFolderId :: NoteFolder -> ChatItemId
noteFolderId :: ChatItemId
noteFolderId} =
  Only Int -> Int
forall a. Only a -> a
fromOnly (Only Int -> Int) -> ([Only Int] -> Only Int) -> [Only Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Only Int] -> Only Int
forall a. HasCallStack => [a] -> a
head
    ([Only Int] -> Int) -> IO [Only Int] -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv)
-> IO [Only Int]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT COUNT(1)
        FROM chat_items
        WHERE user_id = ? AND note_folder_id = ? AND item_status = ?
      |]
      (ChatItemId
userId, ChatItemId
noteFolderId, CIStatus 'MDRcv
CISRcvNew)

getLocalNavInfo_ :: DB.Connection -> User -> NoteFolder -> CChatItem 'CTLocal -> IO NavigationInfo
getLocalNavInfo_ :: Connection
-> User -> NoteFolder -> CChatItem 'CTLocal -> IO NavigationInfo
getLocalNavInfo_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} NoteFolder {ChatItemId
noteFolderId :: NoteFolder -> ChatItemId
noteFolderId :: ChatItemId
noteFolderId} CChatItem 'CTLocal
afterCI = do
  Int
afterUnread <- IO Int
getAfterUnreadCount
  Int
afterTotal <- IO Int
getAfterTotalCount
  NavigationInfo -> IO NavigationInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NavigationInfo {Int
afterUnread :: Int
afterUnread :: Int
afterUnread, Int
afterTotal :: Int
afterTotal :: Int
afterTotal}
  where
    getAfterUnreadCount :: IO Int
    getAfterUnreadCount :: IO Int
getAfterUnreadCount =
      Only Int -> Int
forall a. Only a -> a
fromOnly (Only Int -> Int) -> ([Only Int] -> Only Int) -> [Only Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Only Int] -> Only Int
forall a. HasCallStack => [a] -> a
head
        ([Only Int] -> Int) -> IO [Only Int] -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> ((ChatItemId, ChatItemId, CIStatus 'MDRcv, UTCTime)
    :. (ChatItemId, ChatItemId, CIStatus 'MDRcv, UTCTime, ChatItemId))
-> IO [Only Int]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT COUNT(1)
            FROM (
              SELECT 1
              FROM chat_items
              WHERE user_id = ? AND note_folder_id = ? AND item_status = ?
                AND created_at > ?
              UNION ALL
              SELECT 1
              FROM chat_items
              WHERE user_id = ? AND note_folder_id = ? AND item_status = ?
                AND created_at = ? AND chat_item_id > ?
            ) ci
          |]
          ( (ChatItemId
userId, ChatItemId
noteFolderId, CIStatus 'MDRcv
CISRcvNew, CChatItem 'CTLocal -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
ciCreatedAt CChatItem 'CTLocal
afterCI)
              (ChatItemId, ChatItemId, CIStatus 'MDRcv, UTCTime)
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv, UTCTime, ChatItemId)
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv, UTCTime)
   :. (ChatItemId, ChatItemId, CIStatus 'MDRcv, UTCTime, ChatItemId)
forall h t. h -> t -> h :. t
:. (ChatItemId
userId, ChatItemId
noteFolderId, CIStatus 'MDRcv
CISRcvNew, CChatItem 'CTLocal -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
ciCreatedAt CChatItem 'CTLocal
afterCI, CChatItem 'CTLocal -> ChatItemId
forall (c :: ChatType). CChatItem c -> ChatItemId
cChatItemId CChatItem 'CTLocal
afterCI)
          )
    getAfterTotalCount :: IO Int
    getAfterTotalCount :: IO Int
getAfterTotalCount =
      Only Int -> Int
forall a. Only a -> a
fromOnly (Only Int -> Int) -> ([Only Int] -> Only Int) -> [Only Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Only Int] -> Only Int
forall a. HasCallStack => [a] -> a
head
        ([Only Int] -> Int) -> IO [Only Int] -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> ((ChatItemId, ChatItemId, UTCTime)
    :. (ChatItemId, ChatItemId, UTCTime, ChatItemId))
-> IO [Only Int]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT COUNT(1)
            FROM (
              SELECT 1
              FROM chat_items
              WHERE user_id = ? AND note_folder_id = ?
                AND created_at > ?
              UNION ALL
              SELECT 1
              FROM chat_items
              WHERE user_id = ? AND note_folder_id = ?
                AND created_at = ? AND chat_item_id > ?
            ) ci
          |]
          ( (ChatItemId
userId, ChatItemId
noteFolderId, CChatItem 'CTLocal -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
ciCreatedAt CChatItem 'CTLocal
afterCI)
              (ChatItemId, ChatItemId, UTCTime)
-> (ChatItemId, ChatItemId, UTCTime, ChatItemId)
-> (ChatItemId, ChatItemId, UTCTime)
   :. (ChatItemId, ChatItemId, UTCTime, ChatItemId)
forall h t. h -> t -> h :. t
:. (ChatItemId
userId, ChatItemId
noteFolderId, CChatItem 'CTLocal -> UTCTime
forall (c :: ChatType). CChatItem c -> UTCTime
ciCreatedAt CChatItem 'CTLocal
afterCI, CChatItem 'CTLocal -> ChatItemId
forall (c :: ChatType). CChatItem c -> ChatItemId
cChatItemId CChatItem 'CTLocal
afterCI)
          )

toChatItemRef ::
  (ChatItemId, Maybe ContactId, Maybe GroupId, Maybe GroupChatScopeTag, Maybe GroupMemberId, Maybe NoteFolderId) ->
  Either StoreError (ChatRef, ChatItemId)
toChatItemRef :: (ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
 Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)
-> Either StoreError (ChatRef, ChatItemId)
toChatItemRef = \case
  (ChatItemId
itemId, Just ChatItemId
contactId, Maybe ChatItemId
Nothing, Maybe GroupChatScopeTag
Nothing, Maybe ChatItemId
Nothing, Maybe ChatItemId
Nothing) ->
    (ChatRef, ChatItemId) -> Either StoreError (ChatRef, ChatItemId)
forall a b. b -> Either a b
Right (ChatType -> ChatItemId -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTDirect ChatItemId
contactId Maybe GroupChatScope
forall a. Maybe a
Nothing, ChatItemId
itemId)
  (ChatItemId
itemId, Maybe ChatItemId
Nothing, Just ChatItemId
groupId, Maybe GroupChatScopeTag
Nothing, Maybe ChatItemId
Nothing, Maybe ChatItemId
Nothing) ->
    (ChatRef, ChatItemId) -> Either StoreError (ChatRef, ChatItemId)
forall a b. b -> Either a b
Right (ChatType -> ChatItemId -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTGroup ChatItemId
groupId Maybe GroupChatScope
forall a. Maybe a
Nothing, ChatItemId
itemId)
  (ChatItemId
itemId, Maybe ChatItemId
Nothing, Just ChatItemId
groupId, Just GroupChatScopeTag
GCSTMemberSupport_, Maybe ChatItemId
Nothing, Maybe ChatItemId
Nothing) ->
    (ChatRef, ChatItemId) -> Either StoreError (ChatRef, ChatItemId)
forall a b. b -> Either a b
Right (ChatType -> ChatItemId -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTGroup ChatItemId
groupId (GroupChatScope -> Maybe GroupChatScope
forall a. a -> Maybe a
Just (Maybe ChatItemId -> GroupChatScope
GCSMemberSupport Maybe ChatItemId
forall a. Maybe a
Nothing)), ChatItemId
itemId)
  (ChatItemId
itemId, Maybe ChatItemId
Nothing, Just ChatItemId
groupId, Just GroupChatScopeTag
GCSTMemberSupport_, Just ChatItemId
scopeGMId, Maybe ChatItemId
Nothing) ->
    (ChatRef, ChatItemId) -> Either StoreError (ChatRef, ChatItemId)
forall a b. b -> Either a b
Right (ChatType -> ChatItemId -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTGroup ChatItemId
groupId (GroupChatScope -> Maybe GroupChatScope
forall a. a -> Maybe a
Just (Maybe ChatItemId -> GroupChatScope
GCSMemberSupport (Maybe ChatItemId -> GroupChatScope)
-> Maybe ChatItemId -> GroupChatScope
forall a b. (a -> b) -> a -> b
$ ChatItemId -> Maybe ChatItemId
forall a. a -> Maybe a
Just ChatItemId
scopeGMId)), ChatItemId
itemId)
  (ChatItemId
itemId, Maybe ChatItemId
Nothing, Maybe ChatItemId
Nothing, Maybe GroupChatScopeTag
Nothing, Maybe ChatItemId
Nothing, Just ChatItemId
folderId) ->
    (ChatRef, ChatItemId) -> Either StoreError (ChatRef, ChatItemId)
forall a b. b -> Either a b
Right (ChatType -> ChatItemId -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTLocal ChatItemId
folderId Maybe GroupChatScope
forall a. Maybe a
Nothing, ChatItemId
itemId)
  (ChatItemId
itemId, Maybe ChatItemId
_, Maybe ChatItemId
_, Maybe GroupChatScopeTag
_, Maybe ChatItemId
_, Maybe ChatItemId
_) ->
    StoreError -> Either StoreError (ChatRef, ChatItemId)
forall a b. a -> Either a b
Left (StoreError -> Either StoreError (ChatRef, ChatItemId))
-> StoreError -> Either StoreError (ChatRef, ChatItemId)
forall a b. (a -> b) -> a -> b
$ ChatItemId -> Maybe UTCTime -> StoreError
SEBadChatItem ChatItemId
itemId Maybe UTCTime
forall a. Maybe a
Nothing

updateDirectChatItemsRead :: DB.Connection -> User -> ContactId -> IO ()
updateDirectChatItemsRead :: Connection -> User -> ChatItemId -> IO ()
updateDirectChatItemsRead Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
contactId = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection
-> Query
-> (CIStatus 'MDRcv, UTCTime, ChatItemId, ChatItemId,
    CIStatus 'MDRcv)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE chat_items SET item_status = ?, updated_at = ?
      WHERE user_id = ? AND contact_id = ? AND item_status = ?
    |]
    (CIStatus 'MDRcv
CISRcvRead, UTCTime
currentTs, ChatItemId
userId, ChatItemId
contactId, CIStatus 'MDRcv
CISRcvNew)

getDirectUnreadTimedItems :: DB.Connection -> User -> ContactId -> IO [(ChatItemId, Int)]
getDirectUnreadTimedItems :: Connection -> User -> ChatItemId -> IO [(ChatItemId, Int)]
getDirectUnreadTimedItems Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
contactId =
  Connection
-> Query
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv)
-> IO [(ChatItemId, Int)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
    Connection
db
    [sql|
      SELECT chat_item_id, timed_ttl
      FROM chat_items
      WHERE user_id = ? AND contact_id = ? AND item_status = ? AND timed_ttl IS NOT NULL AND timed_delete_at IS NULL
    |]
    (ChatItemId
userId, ChatItemId
contactId, CIStatus 'MDRcv
CISRcvNew)

updateDirectChatItemsReadList :: DB.Connection -> User -> ContactId -> NonEmpty ChatItemId -> IO [(ChatItemId, Int)]
updateDirectChatItemsReadList :: Connection
-> User
-> ChatItemId
-> NonEmpty ChatItemId
-> IO [(ChatItemId, Int)]
updateDirectChatItemsReadList Connection
db user :: User
user@User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
contactId NonEmpty ChatItemId
itemIds = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  [Maybe (ChatItemId, Int)] -> [(ChatItemId, Int)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (ChatItemId, Int)] -> [(ChatItemId, Int)])
-> (NonEmpty (Maybe (ChatItemId, Int))
    -> [Maybe (ChatItemId, Int)])
-> NonEmpty (Maybe (ChatItemId, Int))
-> [(ChatItemId, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Maybe (ChatItemId, Int)) -> [Maybe (ChatItemId, Int)]
forall a. NonEmpty a -> [a]
L.toList (NonEmpty (Maybe (ChatItemId, Int)) -> [(ChatItemId, Int)])
-> IO (NonEmpty (Maybe (ChatItemId, Int)))
-> IO [(ChatItemId, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ChatItemId -> IO (Maybe (ChatItemId, Int)))
-> NonEmpty ChatItemId -> IO (NonEmpty (Maybe (ChatItemId, Int)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM (UTCTime -> ChatItemId -> IO (Maybe (ChatItemId, Int))
getUpdateDirectItem UTCTime
currentTs) NonEmpty ChatItemId
itemIds
  where
    getUpdateDirectItem :: UTCTime -> ChatItemId -> IO (Maybe (ChatItemId, Int))
getUpdateDirectItem UTCTime
currentTs ChatItemId
itemId = do
      Maybe Int
ttl_ <- (Only Int -> Int) -> IO [Only Int] -> IO (Maybe Int)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only Int -> Int
forall a. Only a -> a
fromOnly IO [Only Int]
getUnreadTimedItem
      Connection -> User -> ChatItemId -> ChatItemId -> UTCTime -> IO ()
setDirectChatItemRead_ Connection
db User
user ChatItemId
contactId ChatItemId
itemId UTCTime
currentTs
      Maybe (ChatItemId, Int) -> IO (Maybe (ChatItemId, Int))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ChatItemId, Int) -> IO (Maybe (ChatItemId, Int)))
-> Maybe (ChatItemId, Int) -> IO (Maybe (ChatItemId, Int))
forall a b. (a -> b) -> a -> b
$ (ChatItemId
itemId,) (Int -> (ChatItemId, Int)) -> Maybe Int -> Maybe (ChatItemId, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
ttl_
      where
        getUnreadTimedItem :: IO [Only Int]
getUnreadTimedItem =
          Connection
-> Query
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv, ChatItemId)
-> IO [Only Int]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
            Connection
db
            [sql|
              SELECT timed_ttl
              FROM chat_items
              WHERE user_id = ? AND contact_id = ? AND item_status = ? AND chat_item_id = ? AND timed_ttl IS NOT NULL AND timed_delete_at IS NULL
            |]
            (ChatItemId
userId, ChatItemId
contactId, CIStatus 'MDRcv
CISRcvNew, ChatItemId
itemId)

setDirectChatItemRead :: DB.Connection -> User -> ContactId -> ChatItemId -> IO ()
setDirectChatItemRead :: Connection -> User -> ChatItemId -> ChatItemId -> IO ()
setDirectChatItemRead Connection
db User
user ChatItemId
contactId ChatItemId
itemId =
  Connection -> User -> ChatItemId -> ChatItemId -> UTCTime -> IO ()
setDirectChatItemRead_ Connection
db User
user ChatItemId
contactId ChatItemId
itemId (UTCTime -> IO ()) -> IO UTCTime -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime
getCurrentTime

setDirectChatItemRead_ :: DB.Connection -> User -> ContactId -> ChatItemId -> UTCTime -> IO ()
setDirectChatItemRead_ :: Connection -> User -> ChatItemId -> ChatItemId -> UTCTime -> IO ()
setDirectChatItemRead_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
contactId ChatItemId
itemId UTCTime
currentTs =
  Connection
-> Query
-> (CIStatus 'MDRcv, UTCTime, ChatItemId, ChatItemId,
    CIStatus 'MDRcv, ChatItemId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE chat_items SET item_status = ?, updated_at = ?
      WHERE user_id = ? AND contact_id = ? AND item_status = ? AND chat_item_id = ?
    |]
    (CIStatus 'MDRcv
CISRcvRead, UTCTime
currentTs, ChatItemId
userId, ChatItemId
contactId, CIStatus 'MDRcv
CISRcvNew, ChatItemId
itemId)

setDirectChatItemsDeleteAt :: DB.Connection -> User -> ContactId -> [(ChatItemId, Int)] -> UTCTime -> IO [(ChatItemId, UTCTime)]
setDirectChatItemsDeleteAt :: Connection
-> User
-> ChatItemId
-> [(ChatItemId, Int)]
-> UTCTime
-> IO [(ChatItemId, UTCTime)]
setDirectChatItemsDeleteAt Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
contactId [(ChatItemId, Int)]
itemIds UTCTime
currentTs = [(ChatItemId, Int)]
-> ((ChatItemId, Int) -> IO (ChatItemId, UTCTime))
-> IO [(ChatItemId, UTCTime)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(ChatItemId, Int)]
itemIds (((ChatItemId, Int) -> IO (ChatItemId, UTCTime))
 -> IO [(ChatItemId, UTCTime)])
-> ((ChatItemId, Int) -> IO (ChatItemId, UTCTime))
-> IO [(ChatItemId, UTCTime)]
forall a b. (a -> b) -> a -> b
$ \(ChatItemId
chatItemId, Int
ttl) -> do
  let deleteAt :: UTCTime
deleteAt = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (Int -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
ttl) UTCTime
currentTs
  Connection
-> Query -> (UTCTime, ChatItemId, ChatItemId, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"UPDATE chat_items SET timed_delete_at = ? WHERE user_id = ? AND contact_id = ? AND chat_item_id = ?"
    (UTCTime
deleteAt, ChatItemId
userId, ChatItemId
contactId, ChatItemId
chatItemId)
  (ChatItemId, UTCTime) -> IO (ChatItemId, UTCTime)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatItemId
chatItemId, UTCTime
deleteAt)

updateGroupChatItemsRead :: DB.Connection -> User -> GroupInfo -> IO ()
updateGroupChatItemsRead :: Connection -> User -> GroupInfo -> IO ()
updateGroupChatItemsRead Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection
-> Query
-> (CIStatus 'MDRcv, UTCTime, ChatItemId, ChatItemId,
    CIStatus 'MDRcv)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE chat_items SET item_status = ?, updated_at = ?
      WHERE user_id = ? AND group_id = ?
        AND item_status = ?
    |]
    (CIStatus 'MDRcv
CISRcvRead, UTCTime
currentTs, ChatItemId
userId, ChatItemId
groupId, CIStatus 'MDRcv
CISRcvNew)

updateSupportChatItemsRead :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupChatScopeInfo -> IO (GroupInfo, GroupMember)
updateSupportChatItemsRead :: Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> GroupChatScopeInfo
-> IO (GroupInfo, GroupMember)
updateSupportChatItemsRead Connection
db VersionRangeChat
vr user :: User
user@User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} g :: GroupInfo
g@GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId, GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} GroupChatScopeInfo
scopeInfo = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  case GroupChatScopeInfo
scopeInfo of
    GCSIMemberSupport {Maybe GroupMember
groupMember_ :: GroupChatScopeInfo -> Maybe GroupMember
groupMember_ :: Maybe GroupMember
groupMember_} -> do
      Connection
-> Query
-> (CIStatus 'MDRcv, UTCTime, ChatItemId, ChatItemId,
    GroupChatScopeTag, Maybe ChatItemId, CIStatus 'MDRcv)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        [sql|
          UPDATE chat_items SET item_status = ?, updated_at = ?
          WHERE user_id = ? AND group_id = ?
            AND group_scope_tag = ? AND group_scope_group_member_id IS NOT DISTINCT FROM ?
            AND item_status = ?
        |]
        (CIStatus 'MDRcv
CISRcvRead, UTCTime
currentTs, ChatItemId
userId, ChatItemId
groupId, GroupChatScopeTag
GCSTMemberSupport_, GroupMember -> ChatItemId
groupMemberId' (GroupMember -> ChatItemId)
-> Maybe GroupMember -> Maybe ChatItemId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GroupMember
groupMember_, CIStatus 'MDRcv
CISRcvNew)
      case Maybe GroupMember
groupMember_ of
        Maybe GroupMember
Nothing -> do
          GroupMember
membership' <- GroupMember -> IO GroupMember
updateGMStats GroupMember
membership
          (GroupInfo, GroupMember) -> IO (GroupInfo, GroupMember)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupInfo
g {membership = membership'}, GroupMember
membership')
        Just GroupMember
member -> do
          GroupMember
member' <- GroupMember -> IO GroupMember
updateGMStats GroupMember
member
          let didRequire :: Bool
didRequire = GroupMember -> Bool
gmRequiresAttention GroupMember
member
              nowRequires :: Bool
nowRequires = GroupMember -> Bool
gmRequiresAttention GroupMember
member'
          if (Bool -> Bool
not Bool
nowRequires Bool -> Bool -> Bool
&& Bool
didRequire)
            then (,GroupMember
member') (GroupInfo -> (GroupInfo, GroupMember))
-> IO GroupInfo -> IO (GroupInfo, GroupMember)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> User -> GroupInfo -> IO GroupInfo
decreaseGroupMembersRequireAttention Connection
db User
user GroupInfo
g
            else (GroupInfo, GroupMember) -> IO (GroupInfo, GroupMember)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupInfo
g, GroupMember
member')
  where
    updateGMStats :: GroupMember -> IO GroupMember
updateGMStats m :: GroupMember
m@GroupMember {ChatItemId
groupMemberId :: GroupMember -> ChatItemId
groupMemberId :: ChatItemId
groupMemberId} = do
      UTCTime
currentTs <- IO UTCTime
getCurrentTime
      Connection -> Query -> (UTCTime, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        [sql|
          UPDATE group_members
          SET support_chat_items_unread = 0,
              support_chat_items_member_attention = 0,
              support_chat_items_mentions = 0,
              updated_at = ?
          WHERE group_member_id = ?
        |]
        (UTCTime
currentTs, ChatItemId
groupMemberId)
      Either StoreError GroupMember
m_ <- ExceptT StoreError IO GroupMember
-> IO (Either StoreError GroupMember)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO GroupMember
 -> IO (Either StoreError GroupMember))
-> ExceptT StoreError IO GroupMember
-> IO (Either StoreError GroupMember)
forall a b. (a -> b) -> a -> b
$ Connection
-> VersionRangeChat
-> User
-> ChatItemId
-> ExceptT StoreError IO GroupMember
getGroupMemberById Connection
db VersionRangeChat
vr User
user ChatItemId
groupMemberId
      GroupMember -> IO GroupMember
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupMember -> IO GroupMember) -> GroupMember -> IO GroupMember
forall a b. (a -> b) -> a -> b
$ (StoreError -> GroupMember)
-> (GroupMember -> GroupMember)
-> Either StoreError GroupMember
-> GroupMember
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (GroupMember -> StoreError -> GroupMember
forall a b. a -> b -> a
const GroupMember
m) GroupMember -> GroupMember
forall a. a -> a
id Either StoreError GroupMember
m_ -- Left shouldn't happen, but types require it

getGroupUnreadTimedItems :: DB.Connection -> User -> GroupId -> Maybe GroupChatScope -> IO [(ChatItemId, Int)]
getGroupUnreadTimedItems :: Connection
-> User
-> ChatItemId
-> Maybe GroupChatScope
-> IO [(ChatItemId, Int)]
getGroupUnreadTimedItems Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
groupId Maybe GroupChatScope
scope =
  case Maybe GroupChatScope
scope of
    Maybe GroupChatScope
Nothing ->
      Connection
-> Query
-> (ChatItemId, ChatItemId, CIStatus 'MDRcv)
-> IO [(ChatItemId, Int)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT chat_item_id, timed_ttl
          FROM chat_items
          WHERE user_id = ? AND group_id = ?
            AND item_status = ? AND timed_ttl IS NOT NULL AND timed_delete_at IS NULL
        |]
        (ChatItemId
userId, ChatItemId
groupId, CIStatus 'MDRcv
CISRcvNew)
    Just GCSMemberSupport {Maybe ChatItemId
groupMemberId_ :: Maybe ChatItemId
groupMemberId_ :: GroupChatScope -> Maybe ChatItemId
groupMemberId_} ->
      Connection
-> Query
-> (ChatItemId, ChatItemId, GroupChatScopeTag, Maybe ChatItemId,
    CIStatus 'MDRcv)
-> IO [(ChatItemId, Int)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT chat_item_id, timed_ttl
          FROM chat_items
          WHERE user_id = ? AND group_id = ?
            AND group_scope_tag = ? AND group_scope_group_member_id IS NOT DISTINCT FROM ?
            AND item_status = ? AND timed_ttl IS NOT NULL AND timed_delete_at IS NULL
        |]
        (ChatItemId
userId, ChatItemId
groupId, GroupChatScopeTag
GCSTMemberSupport_, Maybe ChatItemId
groupMemberId_, CIStatus 'MDRcv
CISRcvNew)

updateGroupChatItemsReadList :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> NonEmpty ChatItemId -> ExceptT StoreError IO ([(ChatItemId, Int)], GroupInfo)
updateGroupChatItemsReadList :: Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> NonEmpty ChatItemId
-> ExceptT StoreError IO ([(ChatItemId, Int)], GroupInfo)
updateGroupChatItemsReadList Connection
db VersionRangeChat
vr user :: User
user@User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} g :: GroupInfo
g@GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} Maybe GroupChatScopeInfo
scopeInfo_ NonEmpty ChatItemId
itemIds = do
  UTCTime
currentTs <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  -- Possible improvement is to differentiate retrieval queries for each scope,
  -- but we rely on UI to not pass item IDs from incorrect scope.
  [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
  Maybe BoolInt)]
readItemsData <- IO
  [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
    Maybe BoolInt)]
-> ExceptT
     StoreError
     IO
     [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
       Maybe BoolInt)]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
     Maybe BoolInt)]
 -> ExceptT
      StoreError
      IO
      [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
        Maybe BoolInt)])
-> IO
     [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
       Maybe BoolInt)]
-> ExceptT
     StoreError
     IO
     [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
       Maybe BoolInt)]
forall a b. (a -> b) -> a -> b
$ [Maybe
   (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
    Maybe BoolInt)]
-> [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
     Maybe BoolInt)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe
    (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
     Maybe BoolInt)]
 -> [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
      Maybe BoolInt)])
-> (NonEmpty
      (Maybe
         (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
          Maybe BoolInt))
    -> [Maybe
          (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
           Maybe BoolInt)])
-> NonEmpty
     (Maybe
        (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
         Maybe BoolInt))
-> [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
     Maybe BoolInt)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty
  (Maybe
     (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
      Maybe BoolInt))
-> [Maybe
      (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
       Maybe BoolInt)]
forall a. NonEmpty a -> [a]
L.toList (NonEmpty
   (Maybe
      (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
       Maybe BoolInt))
 -> [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
      Maybe BoolInt)])
-> IO
     (NonEmpty
        (Maybe
           (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
            Maybe BoolInt)))
-> IO
     [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
       Maybe BoolInt)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ChatItemId
 -> IO
      (Maybe
         (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
          Maybe BoolInt)))
-> NonEmpty ChatItemId
-> IO
     (NonEmpty
        (Maybe
           (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
            Maybe BoolInt)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM (UTCTime
-> ChatItemId
-> IO
     (Maybe
        (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
         Maybe BoolInt))
getUpdateGroupItem UTCTime
currentTs) NonEmpty ChatItemId
itemIds
  GroupInfo
g' <- case Maybe GroupChatScopeInfo
scopeInfo_ of
    Maybe GroupChatScopeInfo
Nothing -> GroupInfo -> ExceptT StoreError IO GroupInfo
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupInfo
g
    Just scopeInfo :: GroupChatScopeInfo
scopeInfo@GCSIMemberSupport {Maybe GroupMember
groupMember_ :: GroupChatScopeInfo -> Maybe GroupMember
groupMember_ :: Maybe GroupMember
groupMember_} -> do
      let decStats :: (Int, Int, Int)
decStats = Maybe GroupMember
-> [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
     Maybe BoolInt)]
-> (Int, Int, Int)
countReadItems Maybe GroupMember
groupMember_ [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
  Maybe BoolInt)]
readItemsData
      IO GroupInfo -> ExceptT StoreError IO GroupInfo
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GroupInfo -> ExceptT StoreError IO GroupInfo)
-> IO GroupInfo -> ExceptT StoreError IO GroupInfo
forall a b. (a -> b) -> a -> b
$ Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> GroupChatScopeInfo
-> (Int, Int, Int)
-> IO GroupInfo
updateGroupScopeUnreadStats Connection
db VersionRangeChat
vr User
user GroupInfo
g GroupChatScopeInfo
scopeInfo (Int, Int, Int)
decStats
  ([(ChatItemId, Int)], GroupInfo)
-> ExceptT StoreError IO ([(ChatItemId, Int)], GroupInfo)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
  Maybe BoolInt)]
-> [(ChatItemId, Int)]
timedItems [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
  Maybe BoolInt)]
readItemsData, GroupInfo
g')
  where
    getUpdateGroupItem :: UTCTime -> ChatItemId -> IO (Maybe (ChatItemId, Maybe Int, Maybe UTCTime, Maybe GroupMemberId, Maybe BoolInt))
    getUpdateGroupItem :: UTCTime
-> ChatItemId
-> IO
     (Maybe
        (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
         Maybe BoolInt))
getUpdateGroupItem UTCTime
currentTs ChatItemId
itemId =
      ((ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
  Maybe BoolInt)
 -> (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
     Maybe BoolInt))
-> IO
     [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
       Maybe BoolInt)]
-> IO
     (Maybe
        (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
         Maybe BoolInt))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
 Maybe BoolInt)
-> (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
    Maybe BoolInt)
forall a. a -> a
id (IO
   [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
     Maybe BoolInt)]
 -> IO
      (Maybe
         (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
          Maybe BoolInt)))
-> IO
     [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
       Maybe BoolInt)]
-> IO
     (Maybe
        (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
         Maybe BoolInt))
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> (CIStatus 'MDRcv, UTCTime, ChatItemId, ChatItemId,
    CIStatus 'MDRcv, ChatItemId)
-> IO
     [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
       Maybe BoolInt)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            UPDATE chat_items SET item_status = ?, updated_at = ?
            WHERE user_id = ? AND group_id = ? AND item_status = ? AND chat_item_id = ?
            RETURNING chat_item_id, timed_ttl, timed_delete_at, group_member_id, user_mention
          |]
          (CIStatus 'MDRcv
CISRcvRead, UTCTime
currentTs, ChatItemId
userId, ChatItemId
groupId, CIStatus 'MDRcv
CISRcvNew, ChatItemId
itemId)
    countReadItems :: Maybe GroupMember -> [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe GroupMemberId, Maybe BoolInt)] -> (Int, Int, Int)
    countReadItems :: Maybe GroupMember
-> [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
     Maybe BoolInt)]
-> (Int, Int, Int)
countReadItems Maybe GroupMember
scopeMember_ [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
  Maybe BoolInt)]
readItemsData =
      let unread :: Int
unread = [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
  Maybe BoolInt)]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
  Maybe BoolInt)]
readItemsData
          (Int
unanswered, Int
mentions) = ((Int, Int)
 -> (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
     Maybe BoolInt)
 -> (Int, Int))
-> (Int, Int)
-> [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
     Maybe BoolInt)]
-> (Int, Int)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, Int)
-> (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
    Maybe BoolInt)
-> (Int, Int)
countItem (Int
0, Int
0) [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
  Maybe BoolInt)]
readItemsData
       in (Int
unread, Int
unanswered, Int
mentions)
      where
        countItem :: (Int, Int) -> (ChatItemId, Maybe Int, Maybe UTCTime, Maybe GroupMemberId, Maybe BoolInt) -> (Int, Int)
        countItem :: (Int, Int)
-> (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
    Maybe BoolInt)
-> (Int, Int)
countItem (!Int
unanswered, !Int
mentions) (ChatItemId
_, Maybe Int
_, Maybe UTCTime
_, Maybe ChatItemId
itemGMId_, Maybe BoolInt
userMention_) =
          let unanswered' :: Int
unanswered' = case (Maybe GroupMember
scopeMember_, Maybe ChatItemId
itemGMId_) of
                (Just GroupMember
scopeMember, Just ChatItemId
itemGMId) | ChatItemId
itemGMId ChatItemId -> ChatItemId -> Bool
forall a. Eq a => a -> a -> Bool
== GroupMember -> ChatItemId
groupMemberId' GroupMember
scopeMember -> Int
unanswered Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                (Maybe GroupMember, Maybe ChatItemId)
_ -> Int
unanswered
              mentions' :: Int
mentions' = case Maybe BoolInt
userMention_ of
                Just (BI Bool
True) -> Int
mentions Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                Maybe BoolInt
_ -> Int
mentions
          in (Int
unanswered', Int
mentions')
    timedItems :: [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe GroupMemberId, Maybe BoolInt)] -> [(ChatItemId, Int)]
    timedItems :: [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
  Maybe BoolInt)]
-> [(ChatItemId, Int)]
timedItems = ([(ChatItemId, Int)]
 -> (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
     Maybe BoolInt)
 -> [(ChatItemId, Int)])
-> [(ChatItemId, Int)]
-> [(ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
     Maybe BoolInt)]
-> [(ChatItemId, Int)]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [(ChatItemId, Int)]
-> (ChatItemId, Maybe Int, Maybe UTCTime, Maybe ChatItemId,
    Maybe BoolInt)
-> [(ChatItemId, Int)]
forall {a} {b} {a} {d} {e}.
[(a, b)] -> (a, Maybe b, Maybe a, d, e) -> [(a, b)]
addTimedItem []
      where
        addTimedItem :: [(a, b)] -> (a, Maybe b, Maybe a, d, e) -> [(a, b)]
addTimedItem [(a, b)]
acc (a
itemId, Just b
ttl, Maybe a
Nothing, d
_, e
_) = (a
itemId, b
ttl) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
acc
        addTimedItem [(a, b)]
acc (a, Maybe b, Maybe a, d, e)
_ = [(a, b)]
acc

updateGroupScopeUnreadStats :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupChatScopeInfo -> (Int, Int, Int) -> IO GroupInfo
updateGroupScopeUnreadStats :: Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> GroupChatScopeInfo
-> (Int, Int, Int)
-> IO GroupInfo
updateGroupScopeUnreadStats Connection
db VersionRangeChat
vr User
user g :: GroupInfo
g@GroupInfo {GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} GroupChatScopeInfo
scopeInfo (Int
unread, Int
unanswered, Int
mentions) =
  case GroupChatScopeInfo
scopeInfo of
    GCSIMemberSupport {Maybe GroupMember
groupMember_ :: GroupChatScopeInfo -> Maybe GroupMember
groupMember_ :: Maybe GroupMember
groupMember_} -> case Maybe GroupMember
groupMember_ of
      Maybe GroupMember
Nothing -> do
        GroupMember
membership' <- GroupMember -> IO GroupMember
updateGMStats GroupMember
membership
        GroupInfo -> IO GroupInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupInfo
g {membership = membership'}
      Just GroupMember
member -> do
        GroupMember
member' <- GroupMember -> IO GroupMember
updateGMStats GroupMember
member
        let didRequire :: Bool
didRequire = GroupMember -> Bool
gmRequiresAttention GroupMember
member
            nowRequires :: Bool
nowRequires = GroupMember -> Bool
gmRequiresAttention GroupMember
member'
        if (Bool -> Bool
not Bool
nowRequires Bool -> Bool -> Bool
&& Bool
didRequire)
          then Connection -> User -> GroupInfo -> IO GroupInfo
decreaseGroupMembersRequireAttention Connection
db User
user GroupInfo
g
          else GroupInfo -> IO GroupInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupInfo
g
  where
    updateGMStats :: GroupMember -> IO GroupMember
updateGMStats m :: GroupMember
m@GroupMember {ChatItemId
groupMemberId :: GroupMember -> ChatItemId
groupMemberId :: ChatItemId
groupMemberId} = do
      UTCTime
currentTs <- IO UTCTime
getCurrentTime
      Connection
-> Query -> (Int, Int, Int, UTCTime, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
#if defined(dbPostgres)
        [sql|
          UPDATE group_members
          SET support_chat_items_unread = GREATEST(0, support_chat_items_unread - ?),
              support_chat_items_member_attention = GREATEST(0, support_chat_items_member_attention - ?),
              support_chat_items_mentions = GREATEST(0, support_chat_items_mentions - ?),
              updated_at = ?
          WHERE group_member_id = ?
        |]
#else
        [sql|
          UPDATE group_members
          SET support_chat_items_unread = MAX(0, support_chat_items_unread - ?),
              support_chat_items_member_attention = MAX(0, support_chat_items_member_attention - ?),
              support_chat_items_mentions = MAX(0, support_chat_items_mentions - ?),
              updated_at = ?
          WHERE group_member_id = ?
        |]
#endif
        (Int
unread, Int
unanswered, Int
mentions, UTCTime
currentTs, ChatItemId
groupMemberId)
      Either StoreError GroupMember
m_ <- ExceptT StoreError IO GroupMember
-> IO (Either StoreError GroupMember)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO GroupMember
 -> IO (Either StoreError GroupMember))
-> ExceptT StoreError IO GroupMember
-> IO (Either StoreError GroupMember)
forall a b. (a -> b) -> a -> b
$ Connection
-> VersionRangeChat
-> User
-> ChatItemId
-> ExceptT StoreError IO GroupMember
getGroupMemberById Connection
db VersionRangeChat
vr User
user ChatItemId
groupMemberId
      GroupMember -> IO GroupMember
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupMember -> IO GroupMember) -> GroupMember -> IO GroupMember
forall a b. (a -> b) -> a -> b
$ (StoreError -> GroupMember)
-> (GroupMember -> GroupMember)
-> Either StoreError GroupMember
-> GroupMember
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (GroupMember -> StoreError -> GroupMember
forall a b. a -> b -> a
const GroupMember
m) GroupMember -> GroupMember
forall a. a -> a
id Either StoreError GroupMember
m_ -- Left shouldn't happen, but types require it

setGroupChatItemsDeleteAt :: DB.Connection -> User -> GroupId -> [(ChatItemId, Int)] -> UTCTime -> IO [(ChatItemId, UTCTime)]
setGroupChatItemsDeleteAt :: Connection
-> User
-> ChatItemId
-> [(ChatItemId, Int)]
-> UTCTime
-> IO [(ChatItemId, UTCTime)]
setGroupChatItemsDeleteAt Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
groupId [(ChatItemId, Int)]
itemIds UTCTime
currentTs = [(ChatItemId, Int)]
-> ((ChatItemId, Int) -> IO (ChatItemId, UTCTime))
-> IO [(ChatItemId, UTCTime)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(ChatItemId, Int)]
itemIds (((ChatItemId, Int) -> IO (ChatItemId, UTCTime))
 -> IO [(ChatItemId, UTCTime)])
-> ((ChatItemId, Int) -> IO (ChatItemId, UTCTime))
-> IO [(ChatItemId, UTCTime)]
forall a b. (a -> b) -> a -> b
$ \(ChatItemId
chatItemId, Int
ttl) -> do
  let deleteAt :: UTCTime
deleteAt = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (Int -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
ttl) UTCTime
currentTs
  Connection
-> Query -> (UTCTime, ChatItemId, ChatItemId, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"UPDATE chat_items SET timed_delete_at = ? WHERE user_id = ? AND group_id = ? AND chat_item_id = ?"
    (UTCTime
deleteAt, ChatItemId
userId, ChatItemId
groupId, ChatItemId
chatItemId)
  (ChatItemId, UTCTime) -> IO (ChatItemId, UTCTime)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatItemId
chatItemId, UTCTime
deleteAt)

updateLocalChatItemsRead :: DB.Connection -> User -> NoteFolderId -> IO ()
updateLocalChatItemsRead :: Connection -> User -> ChatItemId -> IO ()
updateLocalChatItemsRead Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
noteFolderId = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection
-> Query
-> (CIStatus 'MDRcv, UTCTime, ChatItemId, ChatItemId,
    CIStatus 'MDRcv)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE chat_items SET item_status = ?, updated_at = ?
      WHERE user_id = ? AND note_folder_id = ? AND item_status = ?
    |]
    (CIStatus 'MDRcv
CISRcvRead, UTCTime
currentTs, ChatItemId
userId, ChatItemId
noteFolderId, CIStatus 'MDRcv
CISRcvNew)

type MaybeCIFIleRow = (Maybe Int64, Maybe String, Maybe Integer, Maybe FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe ACIFileStatus, Maybe FileProtocol)

type ChatItemModeRow = (Maybe Int, Maybe UTCTime, Maybe BoolInt, BoolInt)

type ChatItemForwardedFromRow = (Maybe CIForwardedFromTag, Maybe Text, Maybe MsgDirection, Maybe Int64, Maybe Int64, Maybe Int64)

type ChatItemRow =
  (Int64, ChatItemTs, AMsgDirection, Text, Text, ACIStatus, Maybe BoolInt, Maybe SharedMsgId)
    :. (Int, Maybe UTCTime, Maybe BoolInt, UTCTime, UTCTime)
    :. ChatItemForwardedFromRow
    :. ChatItemModeRow
    :. MaybeCIFIleRow

type QuoteRow = (Maybe ChatItemId, Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe BoolInt)

toDirectQuote :: QuoteRow -> Maybe (CIQuote 'CTDirect)
toDirectQuote :: QuoteRow -> Maybe (CIQuote 'CTDirect)
toDirectQuote qr :: QuoteRow
qr@(Maybe ChatItemId
_, Maybe SharedMsgId
_, Maybe UTCTime
_, Maybe MsgContent
_, Maybe BoolInt
quotedSent) = QuoteRow
-> Maybe (CIQDirection 'CTDirect) -> Maybe (CIQuote 'CTDirect)
forall (c :: ChatType).
QuoteRow -> Maybe (CIQDirection c) -> Maybe (CIQuote c)
toQuote QuoteRow
qr (Maybe (CIQDirection 'CTDirect) -> Maybe (CIQuote 'CTDirect))
-> Maybe (CIQDirection 'CTDirect) -> Maybe (CIQuote 'CTDirect)
forall a b. (a -> b) -> a -> b
$ Bool -> CIQDirection 'CTDirect
direction (Bool -> CIQDirection 'CTDirect)
-> (BoolInt -> Bool) -> BoolInt -> CIQDirection 'CTDirect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoolInt -> Bool
unBI (BoolInt -> CIQDirection 'CTDirect)
-> Maybe BoolInt -> Maybe (CIQDirection 'CTDirect)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BoolInt
quotedSent
  where
    direction :: Bool -> CIQDirection 'CTDirect
direction Bool
sent = if Bool
sent then CIQDirection 'CTDirect
CIQDirectSnd else CIQDirection 'CTDirect
CIQDirectRcv

toQuote :: QuoteRow -> Maybe (CIQDirection c) -> Maybe (CIQuote c)
toQuote :: forall (c :: ChatType).
QuoteRow -> Maybe (CIQDirection c) -> Maybe (CIQuote c)
toQuote (Maybe ChatItemId
quotedItemId, Maybe SharedMsgId
quotedSharedMsgId, Maybe UTCTime
quotedSentAt, Maybe MsgContent
quotedMsgContent, Maybe BoolInt
_) Maybe (CIQDirection c)
dir =
  CIQDirection c
-> Maybe ChatItemId
-> Maybe SharedMsgId
-> UTCTime
-> MsgContent
-> Maybe MarkdownList
-> CIQuote c
forall (c :: ChatType).
CIQDirection c
-> Maybe ChatItemId
-> Maybe SharedMsgId
-> UTCTime
-> MsgContent
-> Maybe MarkdownList
-> CIQuote c
CIQuote (CIQDirection c
 -> Maybe ChatItemId
 -> Maybe SharedMsgId
 -> UTCTime
 -> MsgContent
 -> Maybe MarkdownList
 -> CIQuote c)
-> Maybe (CIQDirection c)
-> Maybe
     (Maybe ChatItemId
      -> Maybe SharedMsgId
      -> UTCTime
      -> MsgContent
      -> Maybe MarkdownList
      -> CIQuote c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (CIQDirection c)
dir Maybe
  (Maybe ChatItemId
   -> Maybe SharedMsgId
   -> UTCTime
   -> MsgContent
   -> Maybe MarkdownList
   -> CIQuote c)
-> Maybe (Maybe ChatItemId)
-> Maybe
     (Maybe SharedMsgId
      -> UTCTime -> MsgContent -> Maybe MarkdownList -> CIQuote c)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ChatItemId -> Maybe (Maybe ChatItemId)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ChatItemId
quotedItemId Maybe
  (Maybe SharedMsgId
   -> UTCTime -> MsgContent -> Maybe MarkdownList -> CIQuote c)
-> Maybe (Maybe SharedMsgId)
-> Maybe (UTCTime -> MsgContent -> Maybe MarkdownList -> CIQuote c)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe SharedMsgId -> Maybe (Maybe SharedMsgId)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SharedMsgId
quotedSharedMsgId Maybe (UTCTime -> MsgContent -> Maybe MarkdownList -> CIQuote c)
-> Maybe UTCTime
-> Maybe (MsgContent -> Maybe MarkdownList -> CIQuote c)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe UTCTime
quotedSentAt Maybe (MsgContent -> Maybe MarkdownList -> CIQuote c)
-> Maybe MsgContent -> Maybe (Maybe MarkdownList -> CIQuote c)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe MsgContent
quotedMsgContent Maybe (Maybe MarkdownList -> CIQuote c)
-> Maybe (Maybe MarkdownList) -> Maybe (CIQuote c)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MemberName -> Maybe MarkdownList
parseMaybeMarkdownList (MemberName -> Maybe MarkdownList)
-> (MsgContent -> MemberName) -> MsgContent -> Maybe MarkdownList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgContent -> MemberName
msgContentText (MsgContent -> Maybe MarkdownList)
-> Maybe MsgContent -> Maybe (Maybe MarkdownList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MsgContent
quotedMsgContent)

-- this function can be changed so it never fails, not only avoid failure on invalid json
toDirectChatItem :: UTCTime -> ChatItemRow :. QuoteRow -> Either StoreError (CChatItem 'CTDirect)
toDirectChatItem :: UTCTime
-> (ChatItemRow :. QuoteRow)
-> Either StoreError (CChatItem 'CTDirect)
toDirectChatItem UTCTime
currentTs (((ChatItemId
itemId, UTCTime
itemTs, AMsgDirection SMsgDirection d
msgDir, MemberName
itemContentText, MemberName
itemText, ACIStatus
itemStatus, Maybe BoolInt
sentViaProxy, Maybe SharedMsgId
sharedMsgId) :. (Int
itemDeleted, Maybe UTCTime
deletedTs, Maybe BoolInt
itemEdited, UTCTime
createdAt, UTCTime
updatedAt) :. ChatItemForwardedFromRow
forwardedFromRow :. (Maybe Int
timedTTL, Maybe UTCTime
timedDeleteAt, Maybe BoolInt
itemLive, BI Bool
userMention) :. (Maybe ChatItemId
fileId_, Maybe FilePath
fileName_, Maybe Integer
fileSize_, Maybe FilePath
filePath, Maybe SbKey
fileKey, Maybe CbNonce
fileNonce, Maybe ACIFileStatus
fileStatus_, Maybe FileProtocol
fileProtocol_)) :. QuoteRow
quoteRow) =
  ACIContent -> Either StoreError (CChatItem 'CTDirect)
chatItem (ACIContent -> Either StoreError (CChatItem 'CTDirect))
-> ACIContent -> Either StoreError (CChatItem 'CTDirect)
forall a b. (a -> b) -> a -> b
$ ACIContent -> Either FilePath ACIContent -> ACIContent
forall b a. b -> Either a b -> b
fromRight ACIContent
invalid (Either FilePath ACIContent -> ACIContent)
-> Either FilePath ACIContent -> ACIContent
forall a b. (a -> b) -> a -> b
$ MemberName -> Either FilePath ACIContent
dbParseACIContent MemberName
itemContentText
  where
    invalid :: ACIContent
invalid = SMsgDirection d -> CIContent d -> ACIContent
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIContent d -> ACIContent
ACIContent SMsgDirection d
msgDir (CIContent d -> ACIContent) -> CIContent d -> ACIContent
forall a b. (a -> b) -> a -> b
$ MemberName -> CIContent d
forall (d :: MsgDirection). MemberName -> CIContent d
CIInvalidJSON MemberName
itemContentText
    chatItem :: ACIContent -> Either StoreError (CChatItem 'CTDirect)
chatItem ACIContent
itemContent = case (ACIContent
itemContent, ACIStatus
itemStatus, Maybe ACIFileStatus
fileStatus_) of
      (ACIContent SMsgDirection d
SMDSnd CIContent d
ciContent, ACIStatus SMsgDirection d
SMDSnd CIStatus d
ciStatus, Just (AFS SMsgDirection d
SMDSnd CIFileStatus d
fileStatus)) ->
        CChatItem 'CTDirect -> Either StoreError (CChatItem 'CTDirect)
forall a b. b -> Either a b
Right (CChatItem 'CTDirect -> Either StoreError (CChatItem 'CTDirect))
-> CChatItem 'CTDirect -> Either StoreError (CChatItem 'CTDirect)
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDSnd
-> CIDirection 'CTDirect 'MDSnd
-> CIStatus 'MDSnd
-> CIContent 'MDSnd
-> Maybe (CIFile 'MDSnd)
-> CChatItem 'CTDirect
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d
-> CIDirection 'CTDirect d
-> CIStatus d
-> CIContent d
-> Maybe (CIFile d)
-> CChatItem 'CTDirect
cItem SMsgDirection 'MDSnd
SMDSnd CIDirection 'CTDirect 'MDSnd
CIDirectSnd CIStatus d
CIStatus 'MDSnd
ciStatus CIContent d
CIContent 'MDSnd
ciContent (CIFileStatus 'MDSnd -> Maybe (CIFile 'MDSnd)
forall (d :: MsgDirection). CIFileStatus d -> Maybe (CIFile d)
maybeCIFile CIFileStatus d
CIFileStatus 'MDSnd
fileStatus)
      (ACIContent SMsgDirection d
SMDSnd CIContent d
ciContent, ACIStatus SMsgDirection d
SMDSnd CIStatus d
ciStatus, Maybe ACIFileStatus
Nothing) ->
        CChatItem 'CTDirect -> Either StoreError (CChatItem 'CTDirect)
forall a b. b -> Either a b
Right (CChatItem 'CTDirect -> Either StoreError (CChatItem 'CTDirect))
-> CChatItem 'CTDirect -> Either StoreError (CChatItem 'CTDirect)
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDSnd
-> CIDirection 'CTDirect 'MDSnd
-> CIStatus 'MDSnd
-> CIContent 'MDSnd
-> Maybe (CIFile 'MDSnd)
-> CChatItem 'CTDirect
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d
-> CIDirection 'CTDirect d
-> CIStatus d
-> CIContent d
-> Maybe (CIFile d)
-> CChatItem 'CTDirect
cItem SMsgDirection 'MDSnd
SMDSnd CIDirection 'CTDirect 'MDSnd
CIDirectSnd CIStatus d
CIStatus 'MDSnd
ciStatus CIContent d
CIContent 'MDSnd
ciContent Maybe (CIFile 'MDSnd)
forall a. Maybe a
Nothing
      (ACIContent SMsgDirection d
SMDRcv CIContent d
ciContent, ACIStatus SMsgDirection d
SMDRcv CIStatus d
ciStatus, Just (AFS SMsgDirection d
SMDRcv CIFileStatus d
fileStatus)) ->
        CChatItem 'CTDirect -> Either StoreError (CChatItem 'CTDirect)
forall a b. b -> Either a b
Right (CChatItem 'CTDirect -> Either StoreError (CChatItem 'CTDirect))
-> CChatItem 'CTDirect -> Either StoreError (CChatItem 'CTDirect)
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDRcv
-> CIDirection 'CTDirect 'MDRcv
-> CIStatus 'MDRcv
-> CIContent 'MDRcv
-> Maybe (CIFile 'MDRcv)
-> CChatItem 'CTDirect
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d
-> CIDirection 'CTDirect d
-> CIStatus d
-> CIContent d
-> Maybe (CIFile d)
-> CChatItem 'CTDirect
cItem SMsgDirection 'MDRcv
SMDRcv CIDirection 'CTDirect 'MDRcv
CIDirectRcv CIStatus d
CIStatus 'MDRcv
ciStatus CIContent d
CIContent 'MDRcv
ciContent (CIFileStatus 'MDRcv -> Maybe (CIFile 'MDRcv)
forall (d :: MsgDirection). CIFileStatus d -> Maybe (CIFile d)
maybeCIFile CIFileStatus d
CIFileStatus 'MDRcv
fileStatus)
      (ACIContent SMsgDirection d
SMDRcv CIContent d
ciContent, ACIStatus SMsgDirection d
SMDRcv CIStatus d
ciStatus, Maybe ACIFileStatus
Nothing) ->
        CChatItem 'CTDirect -> Either StoreError (CChatItem 'CTDirect)
forall a b. b -> Either a b
Right (CChatItem 'CTDirect -> Either StoreError (CChatItem 'CTDirect))
-> CChatItem 'CTDirect -> Either StoreError (CChatItem 'CTDirect)
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDRcv
-> CIDirection 'CTDirect 'MDRcv
-> CIStatus 'MDRcv
-> CIContent 'MDRcv
-> Maybe (CIFile 'MDRcv)
-> CChatItem 'CTDirect
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d
-> CIDirection 'CTDirect d
-> CIStatus d
-> CIContent d
-> Maybe (CIFile d)
-> CChatItem 'CTDirect
cItem SMsgDirection 'MDRcv
SMDRcv CIDirection 'CTDirect 'MDRcv
CIDirectRcv CIStatus d
CIStatus 'MDRcv
ciStatus CIContent d
CIContent 'MDRcv
ciContent Maybe (CIFile 'MDRcv)
forall a. Maybe a
Nothing
      (ACIContent, ACIStatus, Maybe ACIFileStatus)
_ -> Either StoreError (CChatItem 'CTDirect)
badItem
    maybeCIFile :: CIFileStatus d -> Maybe (CIFile d)
    maybeCIFile :: forall (d :: MsgDirection). CIFileStatus d -> Maybe (CIFile d)
maybeCIFile CIFileStatus d
fileStatus =
      case (Maybe ChatItemId
fileId_, Maybe FilePath
fileName_, Maybe Integer
fileSize_, Maybe FileProtocol
fileProtocol_) of
        (Just ChatItemId
fileId, Just FilePath
fileName, Just Integer
fileSize, Just FileProtocol
fileProtocol) ->
          let cfArgs :: Maybe CryptoFileArgs
cfArgs = SbKey -> CbNonce -> CryptoFileArgs
CFArgs (SbKey -> CbNonce -> CryptoFileArgs)
-> Maybe SbKey -> Maybe (CbNonce -> CryptoFileArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SbKey
fileKey Maybe (CbNonce -> CryptoFileArgs)
-> Maybe CbNonce -> Maybe CryptoFileArgs
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe CbNonce
fileNonce
              fileSource :: Maybe CryptoFile
fileSource = (FilePath -> Maybe CryptoFileArgs -> CryptoFile
`CryptoFile` Maybe CryptoFileArgs
cfArgs) (FilePath -> CryptoFile) -> Maybe FilePath -> Maybe CryptoFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
filePath
           in CIFile d -> Maybe (CIFile d)
forall a. a -> Maybe a
Just CIFile {ChatItemId
fileId :: ChatItemId
fileId :: ChatItemId
fileId, FilePath
fileName :: FilePath
fileName :: FilePath
fileName, Integer
fileSize :: Integer
fileSize :: Integer
fileSize, Maybe CryptoFile
fileSource :: Maybe CryptoFile
fileSource :: Maybe CryptoFile
fileSource, CIFileStatus d
fileStatus :: CIFileStatus d
fileStatus :: CIFileStatus d
fileStatus, FileProtocol
fileProtocol :: FileProtocol
fileProtocol :: FileProtocol
fileProtocol}
        (Maybe ChatItemId, Maybe FilePath, Maybe Integer,
 Maybe FileProtocol)
_ -> Maybe (CIFile d)
forall a. Maybe a
Nothing
    cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTDirect d -> CIStatus d -> CIContent d -> Maybe (CIFile d) -> CChatItem 'CTDirect
    cItem :: forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d
-> CIDirection 'CTDirect d
-> CIStatus d
-> CIContent d
-> Maybe (CIFile d)
-> CChatItem 'CTDirect
cItem SMsgDirection d
d CIDirection 'CTDirect d
chatDir CIStatus d
ciStatus CIContent d
content Maybe (CIFile d)
file =
      SMsgDirection d -> ChatItem 'CTDirect d -> CChatItem 'CTDirect
forall (c :: ChatType) (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> ChatItem c d -> CChatItem c
CChatItem SMsgDirection d
d ChatItem {CIDirection 'CTDirect d
chatDir :: CIDirection 'CTDirect d
chatDir :: CIDirection 'CTDirect d
chatDir, meta :: CIMeta 'CTDirect d
meta = CIContent d -> CIStatus d -> CIMeta 'CTDirect d
forall (d :: MsgDirection).
CIContent d -> CIStatus d -> CIMeta 'CTDirect d
ciMeta CIContent d
content CIStatus d
ciStatus, CIContent d
content :: CIContent d
content :: CIContent d
content, mentions :: Map MemberName CIMention
mentions = Map MemberName CIMention
forall k a. Map k a
M.empty, formattedText :: Maybe MarkdownList
formattedText = MemberName -> Maybe MarkdownList
parseMaybeMarkdownList MemberName
itemText, quotedItem :: Maybe (CIQuote 'CTDirect)
quotedItem = QuoteRow -> Maybe (CIQuote 'CTDirect)
toDirectQuote QuoteRow
quoteRow, reactions :: [CIReactionCount]
reactions = [], Maybe (CIFile d)
file :: Maybe (CIFile d)
file :: Maybe (CIFile d)
file}
    badItem :: Either StoreError (CChatItem 'CTDirect)
badItem = StoreError -> Either StoreError (CChatItem 'CTDirect)
forall a b. a -> Either a b
Left (StoreError -> Either StoreError (CChatItem 'CTDirect))
-> StoreError -> Either StoreError (CChatItem 'CTDirect)
forall a b. (a -> b) -> a -> b
$ ChatItemId -> Maybe UTCTime -> StoreError
SEBadChatItem ChatItemId
itemId (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
itemTs)
    ciMeta :: CIContent d -> CIStatus d -> CIMeta 'CTDirect d
    ciMeta :: forall (d :: MsgDirection).
CIContent d -> CIStatus d -> CIMeta 'CTDirect d
ciMeta CIContent d
content CIStatus d
status =
      let itemDeleted' :: Maybe (CIDeleted 'CTDirect)
itemDeleted' = case Int
itemDeleted of
            Int
DBCINotDeleted -> Maybe (CIDeleted 'CTDirect)
forall a. Maybe a
Nothing
            Int
_ -> CIDeleted 'CTDirect -> Maybe (CIDeleted 'CTDirect)
forall a. a -> Maybe a
Just (forall (c :: ChatType). Maybe UTCTime -> CIDeleted c
CIDeleted @'CTDirect Maybe UTCTime
deletedTs)
          itemEdited' :: Bool
itemEdited' = Bool -> (BoolInt -> Bool) -> Maybe BoolInt -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False BoolInt -> Bool
unBI Maybe BoolInt
itemEdited
          itemForwarded :: Maybe CIForwardedFrom
itemForwarded = ChatItemForwardedFromRow -> Maybe CIForwardedFrom
toCIForwardedFrom ChatItemForwardedFromRow
forwardedFromRow
       in ChatItemId
-> CIContent d
-> MemberName
-> CIStatus d
-> Maybe Bool
-> Maybe SharedMsgId
-> Maybe CIForwardedFrom
-> Maybe (CIDeleted 'CTDirect)
-> Bool
-> Maybe CITimed
-> Maybe Bool
-> Bool
-> UTCTime
-> UTCTime
-> Maybe ChatItemId
-> Bool
-> UTCTime
-> UTCTime
-> CIMeta 'CTDirect d
forall (c :: ChatType) (d :: MsgDirection).
ChatTypeI c =>
ChatItemId
-> CIContent d
-> MemberName
-> CIStatus d
-> Maybe Bool
-> Maybe SharedMsgId
-> Maybe CIForwardedFrom
-> Maybe (CIDeleted c)
-> Bool
-> Maybe CITimed
-> Maybe Bool
-> Bool
-> UTCTime
-> UTCTime
-> Maybe ChatItemId
-> Bool
-> UTCTime
-> UTCTime
-> CIMeta c d
mkCIMeta ChatItemId
itemId CIContent d
content MemberName
itemText CIStatus d
status (BoolInt -> Bool
unBI (BoolInt -> Bool) -> Maybe BoolInt -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BoolInt
sentViaProxy) Maybe SharedMsgId
sharedMsgId Maybe CIForwardedFrom
itemForwarded Maybe (CIDeleted 'CTDirect)
itemDeleted' Bool
itemEdited' Maybe CITimed
ciTimed (BoolInt -> Bool
unBI (BoolInt -> Bool) -> Maybe BoolInt -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BoolInt
itemLive) Bool
userMention UTCTime
currentTs UTCTime
itemTs Maybe ChatItemId
forall a. Maybe a
Nothing Bool
False UTCTime
createdAt UTCTime
updatedAt
    ciTimed :: Maybe CITimed
    ciTimed :: Maybe CITimed
ciTimed = Maybe Int
timedTTL Maybe Int -> (Int -> Maybe CITimed) -> Maybe CITimed
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
ttl -> CITimed -> Maybe CITimed
forall a. a -> Maybe a
Just CITimed {Int
ttl :: Int
ttl :: Int
ttl, deleteAt :: Maybe UTCTime
deleteAt = Maybe UTCTime
timedDeleteAt}

toCIForwardedFrom :: ChatItemForwardedFromRow -> Maybe CIForwardedFrom
toCIForwardedFrom :: ChatItemForwardedFromRow -> Maybe CIForwardedFrom
toCIForwardedFrom (Maybe CIForwardedFromTag
fwdFromTag, Maybe MemberName
fwdFromChatName, Maybe MsgDirection
fwdFromMsgDir, Maybe ChatItemId
fwdFromContactId, Maybe ChatItemId
fwdFromGroupId, Maybe ChatItemId
fwdFromChatItemId) =
  case (Maybe CIForwardedFromTag
fwdFromTag, Maybe MemberName
fwdFromChatName, Maybe MsgDirection
fwdFromMsgDir, Maybe ChatItemId
fwdFromContactId, Maybe ChatItemId
fwdFromGroupId, Maybe ChatItemId
fwdFromChatItemId) of
    (Just CIForwardedFromTag
CIFFUnknown_, Maybe MemberName
Nothing, Maybe MsgDirection
Nothing, Maybe ChatItemId
Nothing, Maybe ChatItemId
Nothing, Maybe ChatItemId
Nothing) -> CIForwardedFrom -> Maybe CIForwardedFrom
forall a. a -> Maybe a
Just CIForwardedFrom
CIFFUnknown
    (Just CIForwardedFromTag
CIFFContact_, Just MemberName
chatName, Just MsgDirection
msgDir, Maybe ChatItemId
contactId, Maybe ChatItemId
Nothing, Maybe ChatItemId
ciId) -> CIForwardedFrom -> Maybe CIForwardedFrom
forall a. a -> Maybe a
Just (CIForwardedFrom -> Maybe CIForwardedFrom)
-> CIForwardedFrom -> Maybe CIForwardedFrom
forall a b. (a -> b) -> a -> b
$ MemberName
-> MsgDirection
-> Maybe ChatItemId
-> Maybe ChatItemId
-> CIForwardedFrom
CIFFContact MemberName
chatName MsgDirection
msgDir Maybe ChatItemId
contactId Maybe ChatItemId
ciId
    (Just CIForwardedFromTag
CIFFGroup_, Just MemberName
chatName, Just MsgDirection
msgDir, Maybe ChatItemId
Nothing, Maybe ChatItemId
groupId, Maybe ChatItemId
ciId) -> CIForwardedFrom -> Maybe CIForwardedFrom
forall a. a -> Maybe a
Just (CIForwardedFrom -> Maybe CIForwardedFrom)
-> CIForwardedFrom -> Maybe CIForwardedFrom
forall a b. (a -> b) -> a -> b
$ MemberName
-> MsgDirection
-> Maybe ChatItemId
-> Maybe ChatItemId
-> CIForwardedFrom
CIFFGroup MemberName
chatName MsgDirection
msgDir Maybe ChatItemId
groupId Maybe ChatItemId
ciId
    ChatItemForwardedFromRow
_ -> Maybe CIForwardedFrom
forall a. Maybe a
Nothing

type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow

toGroupQuote :: QuoteRow -> Maybe GroupMember -> Maybe (CIQuote 'CTGroup)
toGroupQuote :: QuoteRow -> Maybe GroupMember -> Maybe (CIQuote 'CTGroup)
toGroupQuote qr :: QuoteRow
qr@(Maybe ChatItemId
_, Maybe SharedMsgId
_, Maybe UTCTime
_, Maybe MsgContent
_, Maybe BoolInt
quotedSent) Maybe GroupMember
quotedMember_ = QuoteRow
-> Maybe (CIQDirection 'CTGroup) -> Maybe (CIQuote 'CTGroup)
forall (c :: ChatType).
QuoteRow -> Maybe (CIQDirection c) -> Maybe (CIQuote c)
toQuote QuoteRow
qr (Maybe (CIQDirection 'CTGroup) -> Maybe (CIQuote 'CTGroup))
-> Maybe (CIQDirection 'CTGroup) -> Maybe (CIQuote 'CTGroup)
forall a b. (a -> b) -> a -> b
$ Maybe BoolInt -> Maybe GroupMember -> Maybe (CIQDirection 'CTGroup)
direction Maybe BoolInt
quotedSent Maybe GroupMember
quotedMember_
  where
    direction :: Maybe BoolInt -> Maybe GroupMember -> Maybe (CIQDirection 'CTGroup)
direction (Just (BI Bool
True)) Maybe GroupMember
_ = CIQDirection 'CTGroup -> Maybe (CIQDirection 'CTGroup)
forall a. a -> Maybe a
Just CIQDirection 'CTGroup
CIQGroupSnd
    direction (Just (BI Bool
False)) (Just GroupMember
member) = CIQDirection 'CTGroup -> Maybe (CIQDirection 'CTGroup)
forall a. a -> Maybe a
Just (CIQDirection 'CTGroup -> Maybe (CIQDirection 'CTGroup))
-> (Maybe GroupMember -> CIQDirection 'CTGroup)
-> Maybe GroupMember
-> Maybe (CIQDirection 'CTGroup)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe GroupMember -> CIQDirection 'CTGroup
CIQGroupRcv (Maybe GroupMember -> Maybe (CIQDirection 'CTGroup))
-> Maybe GroupMember -> Maybe (CIQDirection 'CTGroup)
forall a b. (a -> b) -> a -> b
$ GroupMember -> Maybe GroupMember
forall a. a -> Maybe a
Just GroupMember
member
    direction (Just (BI Bool
False)) Maybe GroupMember
Nothing = CIQDirection 'CTGroup -> Maybe (CIQDirection 'CTGroup)
forall a. a -> Maybe a
Just (CIQDirection 'CTGroup -> Maybe (CIQDirection 'CTGroup))
-> CIQDirection 'CTGroup -> Maybe (CIQDirection 'CTGroup)
forall a b. (a -> b) -> a -> b
$ Maybe GroupMember -> CIQDirection 'CTGroup
CIQGroupRcv Maybe GroupMember
forall a. Maybe a
Nothing
    direction Maybe BoolInt
_ Maybe GroupMember
_ = Maybe (CIQDirection 'CTGroup)
forall a. Maybe a
Nothing

-- this function can be changed so it never fails, not only avoid failure on invalid json
toGroupChatItem ::
  UTCTime ->
  Int64 ->
  ChatItemRow
    :. (Maybe GroupMemberId, BoolInt)
    :. MaybeGroupMemberRow
    :. GroupQuoteRow
    :. MaybeGroupMemberRow ->
  Either StoreError (CChatItem 'CTGroup)
toGroupChatItem :: UTCTime
-> ChatItemId
-> (ChatItemRow
    :. ((Maybe ChatItemId, BoolInt)
        :. (MaybeGroupMemberRow
            :. (GroupQuoteRow :. MaybeGroupMemberRow))))
-> Either StoreError (CChatItem 'CTGroup)
toGroupChatItem
  UTCTime
currentTs
  ChatItemId
userContactId
  ( ( (ChatItemId
itemId, UTCTime
itemTs, AMsgDirection SMsgDirection d
msgDir, MemberName
itemContentText, MemberName
itemText, ACIStatus
itemStatus, Maybe BoolInt
sentViaProxy, Maybe SharedMsgId
sharedMsgId)
        :. (Int
itemDeleted, Maybe UTCTime
deletedTs, Maybe BoolInt
itemEdited, UTCTime
createdAt, UTCTime
updatedAt)
        :. ChatItemForwardedFromRow
forwardedFromRow
        :. (Maybe Int
timedTTL, Maybe UTCTime
timedDeleteAt, Maybe BoolInt
itemLive, BI Bool
userMention)
        :. (Maybe ChatItemId
fileId_, Maybe FilePath
fileName_, Maybe Integer
fileSize_, Maybe FilePath
filePath, Maybe SbKey
fileKey, Maybe CbNonce
fileNonce, Maybe ACIFileStatus
fileStatus_, Maybe FileProtocol
fileProtocol_)
      )
      :. (Maybe ChatItemId
forwardedByMember, BI Bool
showGroupAsSender)
      :. MaybeGroupMemberRow
memberRow_
      :. (QuoteRow
quoteRow :. MaybeGroupMemberRow
quotedMemberRow_)
      :. MaybeGroupMemberRow
deletedByGroupMemberRow_
    ) = do
    ACIContent -> Either StoreError (CChatItem 'CTGroup)
chatItem (ACIContent -> Either StoreError (CChatItem 'CTGroup))
-> ACIContent -> Either StoreError (CChatItem 'CTGroup)
forall a b. (a -> b) -> a -> b
$ ACIContent -> Either FilePath ACIContent -> ACIContent
forall b a. b -> Either a b -> b
fromRight ACIContent
invalid (Either FilePath ACIContent -> ACIContent)
-> Either FilePath ACIContent -> ACIContent
forall a b. (a -> b) -> a -> b
$ MemberName -> Either FilePath ACIContent
dbParseACIContent MemberName
itemContentText
    where
      member_ :: Maybe GroupMember
member_ = ChatItemId -> MaybeGroupMemberRow -> Maybe GroupMember
toMaybeGroupMember ChatItemId
userContactId MaybeGroupMemberRow
memberRow_
      quotedMember_ :: Maybe GroupMember
quotedMember_ = ChatItemId -> MaybeGroupMemberRow -> Maybe GroupMember
toMaybeGroupMember ChatItemId
userContactId MaybeGroupMemberRow
quotedMemberRow_
      deletedByGroupMember_ :: Maybe GroupMember
deletedByGroupMember_ = ChatItemId -> MaybeGroupMemberRow -> Maybe GroupMember
toMaybeGroupMember ChatItemId
userContactId MaybeGroupMemberRow
deletedByGroupMemberRow_
      invalid :: ACIContent
invalid = SMsgDirection d -> CIContent d -> ACIContent
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIContent d -> ACIContent
ACIContent SMsgDirection d
msgDir (CIContent d -> ACIContent) -> CIContent d -> ACIContent
forall a b. (a -> b) -> a -> b
$ MemberName -> CIContent d
forall (d :: MsgDirection). MemberName -> CIContent d
CIInvalidJSON MemberName
itemContentText
      chatItem :: ACIContent -> Either StoreError (CChatItem 'CTGroup)
chatItem ACIContent
itemContent = case (ACIContent
itemContent, ACIStatus
itemStatus, Maybe GroupMember
member_, Maybe ACIFileStatus
fileStatus_) of
        (ACIContent SMsgDirection d
SMDSnd CIContent d
ciContent, ACIStatus SMsgDirection d
SMDSnd CIStatus d
ciStatus, Maybe GroupMember
_, Just (AFS SMsgDirection d
SMDSnd CIFileStatus d
fileStatus)) ->
          CChatItem 'CTGroup -> Either StoreError (CChatItem 'CTGroup)
forall a b. b -> Either a b
Right (CChatItem 'CTGroup -> Either StoreError (CChatItem 'CTGroup))
-> CChatItem 'CTGroup -> Either StoreError (CChatItem 'CTGroup)
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDSnd
-> CIDirection 'CTGroup 'MDSnd
-> CIStatus 'MDSnd
-> CIContent 'MDSnd
-> Maybe (CIFile 'MDSnd)
-> CChatItem 'CTGroup
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d
-> CIDirection 'CTGroup d
-> CIStatus d
-> CIContent d
-> Maybe (CIFile d)
-> CChatItem 'CTGroup
cItem SMsgDirection 'MDSnd
SMDSnd CIDirection 'CTGroup 'MDSnd
CIGroupSnd CIStatus d
CIStatus 'MDSnd
ciStatus CIContent d
CIContent 'MDSnd
ciContent (CIFileStatus 'MDSnd -> Maybe (CIFile 'MDSnd)
forall (d :: MsgDirection). CIFileStatus d -> Maybe (CIFile d)
maybeCIFile CIFileStatus d
CIFileStatus 'MDSnd
fileStatus)
        (ACIContent SMsgDirection d
SMDSnd CIContent d
ciContent, ACIStatus SMsgDirection d
SMDSnd CIStatus d
ciStatus, Maybe GroupMember
_, Maybe ACIFileStatus
Nothing) ->
          CChatItem 'CTGroup -> Either StoreError (CChatItem 'CTGroup)
forall a b. b -> Either a b
Right (CChatItem 'CTGroup -> Either StoreError (CChatItem 'CTGroup))
-> CChatItem 'CTGroup -> Either StoreError (CChatItem 'CTGroup)
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDSnd
-> CIDirection 'CTGroup 'MDSnd
-> CIStatus 'MDSnd
-> CIContent 'MDSnd
-> Maybe (CIFile 'MDSnd)
-> CChatItem 'CTGroup
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d
-> CIDirection 'CTGroup d
-> CIStatus d
-> CIContent d
-> Maybe (CIFile d)
-> CChatItem 'CTGroup
cItem SMsgDirection 'MDSnd
SMDSnd CIDirection 'CTGroup 'MDSnd
CIGroupSnd CIStatus d
CIStatus 'MDSnd
ciStatus CIContent d
CIContent 'MDSnd
ciContent Maybe (CIFile 'MDSnd)
forall a. Maybe a
Nothing
        (ACIContent SMsgDirection d
SMDRcv CIContent d
ciContent, ACIStatus SMsgDirection d
SMDRcv CIStatus d
ciStatus, Just GroupMember
member, Just (AFS SMsgDirection d
SMDRcv CIFileStatus d
fileStatus)) ->
          CChatItem 'CTGroup -> Either StoreError (CChatItem 'CTGroup)
forall a b. b -> Either a b
Right (CChatItem 'CTGroup -> Either StoreError (CChatItem 'CTGroup))
-> CChatItem 'CTGroup -> Either StoreError (CChatItem 'CTGroup)
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDRcv
-> CIDirection 'CTGroup 'MDRcv
-> CIStatus 'MDRcv
-> CIContent 'MDRcv
-> Maybe (CIFile 'MDRcv)
-> CChatItem 'CTGroup
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d
-> CIDirection 'CTGroup d
-> CIStatus d
-> CIContent d
-> Maybe (CIFile d)
-> CChatItem 'CTGroup
cItem SMsgDirection 'MDRcv
SMDRcv (GroupMember -> CIDirection 'CTGroup 'MDRcv
CIGroupRcv GroupMember
member) CIStatus d
CIStatus 'MDRcv
ciStatus CIContent d
CIContent 'MDRcv
ciContent (CIFileStatus 'MDRcv -> Maybe (CIFile 'MDRcv)
forall (d :: MsgDirection). CIFileStatus d -> Maybe (CIFile d)
maybeCIFile CIFileStatus d
CIFileStatus 'MDRcv
fileStatus)
        (ACIContent SMsgDirection d
SMDRcv CIContent d
ciContent, ACIStatus SMsgDirection d
SMDRcv CIStatus d
ciStatus, Just GroupMember
member, Maybe ACIFileStatus
Nothing) ->
          CChatItem 'CTGroup -> Either StoreError (CChatItem 'CTGroup)
forall a b. b -> Either a b
Right (CChatItem 'CTGroup -> Either StoreError (CChatItem 'CTGroup))
-> CChatItem 'CTGroup -> Either StoreError (CChatItem 'CTGroup)
forall a b. (a -> b) -> a -> b
$ SMsgDirection 'MDRcv
-> CIDirection 'CTGroup 'MDRcv
-> CIStatus 'MDRcv
-> CIContent 'MDRcv
-> Maybe (CIFile 'MDRcv)
-> CChatItem 'CTGroup
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d
-> CIDirection 'CTGroup d
-> CIStatus d
-> CIContent d
-> Maybe (CIFile d)
-> CChatItem 'CTGroup
cItem SMsgDirection 'MDRcv
SMDRcv (GroupMember -> CIDirection 'CTGroup 'MDRcv
CIGroupRcv GroupMember
member) CIStatus d
CIStatus 'MDRcv
ciStatus CIContent d
CIContent 'MDRcv
ciContent Maybe (CIFile 'MDRcv)
forall a. Maybe a
Nothing
        (ACIContent, ACIStatus, Maybe GroupMember, Maybe ACIFileStatus)
_ -> Either StoreError (CChatItem 'CTGroup)
badItem
      maybeCIFile :: CIFileStatus d -> Maybe (CIFile d)
      maybeCIFile :: forall (d :: MsgDirection). CIFileStatus d -> Maybe (CIFile d)
maybeCIFile CIFileStatus d
fileStatus =
        case (Maybe ChatItemId
fileId_, Maybe FilePath
fileName_, Maybe Integer
fileSize_, Maybe FileProtocol
fileProtocol_) of
          (Just ChatItemId
fileId, Just FilePath
fileName, Just Integer
fileSize, Just FileProtocol
fileProtocol) ->
            let cfArgs :: Maybe CryptoFileArgs
cfArgs = SbKey -> CbNonce -> CryptoFileArgs
CFArgs (SbKey -> CbNonce -> CryptoFileArgs)
-> Maybe SbKey -> Maybe (CbNonce -> CryptoFileArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SbKey
fileKey Maybe (CbNonce -> CryptoFileArgs)
-> Maybe CbNonce -> Maybe CryptoFileArgs
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe CbNonce
fileNonce
                fileSource :: Maybe CryptoFile
fileSource = (FilePath -> Maybe CryptoFileArgs -> CryptoFile
`CryptoFile` Maybe CryptoFileArgs
cfArgs) (FilePath -> CryptoFile) -> Maybe FilePath -> Maybe CryptoFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
filePath
             in CIFile d -> Maybe (CIFile d)
forall a. a -> Maybe a
Just CIFile {ChatItemId
fileId :: ChatItemId
fileId :: ChatItemId
fileId, FilePath
fileName :: FilePath
fileName :: FilePath
fileName, Integer
fileSize :: Integer
fileSize :: Integer
fileSize, Maybe CryptoFile
fileSource :: Maybe CryptoFile
fileSource :: Maybe CryptoFile
fileSource, CIFileStatus d
fileStatus :: CIFileStatus d
fileStatus :: CIFileStatus d
fileStatus, FileProtocol
fileProtocol :: FileProtocol
fileProtocol :: FileProtocol
fileProtocol}
          (Maybe ChatItemId, Maybe FilePath, Maybe Integer,
 Maybe FileProtocol)
_ -> Maybe (CIFile d)
forall a. Maybe a
Nothing
      cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTGroup d -> CIStatus d -> CIContent d -> Maybe (CIFile d) -> CChatItem 'CTGroup
      cItem :: forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d
-> CIDirection 'CTGroup d
-> CIStatus d
-> CIContent d
-> Maybe (CIFile d)
-> CChatItem 'CTGroup
cItem SMsgDirection d
d CIDirection 'CTGroup d
chatDir CIStatus d
ciStatus CIContent d
content Maybe (CIFile d)
file =
        SMsgDirection d -> ChatItem 'CTGroup d -> CChatItem 'CTGroup
forall (c :: ChatType) (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> ChatItem c d -> CChatItem c
CChatItem SMsgDirection d
d ChatItem {CIDirection 'CTGroup d
chatDir :: CIDirection 'CTGroup d
chatDir :: CIDirection 'CTGroup d
chatDir, meta :: CIMeta 'CTGroup d
meta = CIContent d -> CIStatus d -> CIMeta 'CTGroup d
forall (d :: MsgDirection).
CIContent d -> CIStatus d -> CIMeta 'CTGroup d
ciMeta CIContent d
content CIStatus d
ciStatus, CIContent d
content :: CIContent d
content :: CIContent d
content, mentions :: Map MemberName CIMention
mentions = Map MemberName CIMention
forall k a. Map k a
M.empty, formattedText :: Maybe MarkdownList
formattedText = MemberName -> Maybe MarkdownList
parseMaybeMarkdownList MemberName
itemText, quotedItem :: Maybe (CIQuote 'CTGroup)
quotedItem = QuoteRow -> Maybe GroupMember -> Maybe (CIQuote 'CTGroup)
toGroupQuote QuoteRow
quoteRow Maybe GroupMember
quotedMember_, reactions :: [CIReactionCount]
reactions = [], Maybe (CIFile d)
file :: Maybe (CIFile d)
file :: Maybe (CIFile d)
file}
      badItem :: Either StoreError (CChatItem 'CTGroup)
badItem = StoreError -> Either StoreError (CChatItem 'CTGroup)
forall a b. a -> Either a b
Left (StoreError -> Either StoreError (CChatItem 'CTGroup))
-> StoreError -> Either StoreError (CChatItem 'CTGroup)
forall a b. (a -> b) -> a -> b
$ ChatItemId -> Maybe UTCTime -> StoreError
SEBadChatItem ChatItemId
itemId (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
itemTs)
      ciMeta :: CIContent d -> CIStatus d -> CIMeta 'CTGroup d
      ciMeta :: forall (d :: MsgDirection).
CIContent d -> CIStatus d -> CIMeta 'CTGroup d
ciMeta CIContent d
content CIStatus d
status =
        let itemDeleted' :: Maybe (CIDeleted 'CTGroup)
itemDeleted' = case Int
itemDeleted of
              Int
DBCINotDeleted -> Maybe (CIDeleted 'CTGroup)
forall a. Maybe a
Nothing
              Int
DBCIBlocked -> CIDeleted 'CTGroup -> Maybe (CIDeleted 'CTGroup)
forall a. a -> Maybe a
Just (Maybe UTCTime -> CIDeleted 'CTGroup
CIBlocked Maybe UTCTime
deletedTs)
              Int
DBCIBlockedByAdmin -> CIDeleted 'CTGroup -> Maybe (CIDeleted 'CTGroup)
forall a. a -> Maybe a
Just (Maybe UTCTime -> CIDeleted 'CTGroup
CIBlockedByAdmin Maybe UTCTime
deletedTs)
              Int
_ -> CIDeleted 'CTGroup -> Maybe (CIDeleted 'CTGroup)
forall a. a -> Maybe a
Just (CIDeleted 'CTGroup
-> (GroupMember -> CIDeleted 'CTGroup)
-> Maybe GroupMember
-> CIDeleted 'CTGroup
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (c :: ChatType). Maybe UTCTime -> CIDeleted c
CIDeleted @'CTGroup Maybe UTCTime
deletedTs) (Maybe UTCTime -> GroupMember -> CIDeleted 'CTGroup
CIModerated Maybe UTCTime
deletedTs) Maybe GroupMember
deletedByGroupMember_)
            itemEdited' :: Bool
itemEdited' = Bool -> (BoolInt -> Bool) -> Maybe BoolInt -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False BoolInt -> Bool
unBI Maybe BoolInt
itemEdited
            itemForwarded :: Maybe CIForwardedFrom
itemForwarded = ChatItemForwardedFromRow -> Maybe CIForwardedFrom
toCIForwardedFrom ChatItemForwardedFromRow
forwardedFromRow
         in ChatItemId
-> CIContent d
-> MemberName
-> CIStatus d
-> Maybe Bool
-> Maybe SharedMsgId
-> Maybe CIForwardedFrom
-> Maybe (CIDeleted 'CTGroup)
-> Bool
-> Maybe CITimed
-> Maybe Bool
-> Bool
-> UTCTime
-> UTCTime
-> Maybe ChatItemId
-> Bool
-> UTCTime
-> UTCTime
-> CIMeta 'CTGroup d
forall (c :: ChatType) (d :: MsgDirection).
ChatTypeI c =>
ChatItemId
-> CIContent d
-> MemberName
-> CIStatus d
-> Maybe Bool
-> Maybe SharedMsgId
-> Maybe CIForwardedFrom
-> Maybe (CIDeleted c)
-> Bool
-> Maybe CITimed
-> Maybe Bool
-> Bool
-> UTCTime
-> UTCTime
-> Maybe ChatItemId
-> Bool
-> UTCTime
-> UTCTime
-> CIMeta c d
mkCIMeta ChatItemId
itemId CIContent d
content MemberName
itemText CIStatus d
status (BoolInt -> Bool
unBI (BoolInt -> Bool) -> Maybe BoolInt -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BoolInt
sentViaProxy) Maybe SharedMsgId
sharedMsgId Maybe CIForwardedFrom
itemForwarded Maybe (CIDeleted 'CTGroup)
itemDeleted' Bool
itemEdited' Maybe CITimed
ciTimed (BoolInt -> Bool
unBI (BoolInt -> Bool) -> Maybe BoolInt -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BoolInt
itemLive) Bool
userMention UTCTime
currentTs UTCTime
itemTs Maybe ChatItemId
forwardedByMember Bool
showGroupAsSender UTCTime
createdAt UTCTime
updatedAt
      ciTimed :: Maybe CITimed
      ciTimed :: Maybe CITimed
ciTimed = Maybe Int
timedTTL Maybe Int -> (Int -> Maybe CITimed) -> Maybe CITimed
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
ttl -> CITimed -> Maybe CITimed
forall a. a -> Maybe a
Just CITimed {Int
ttl :: Int
ttl :: Int
ttl, deleteAt :: Maybe UTCTime
deleteAt = Maybe UTCTime
timedDeleteAt}

getAllChatItems :: DB.Connection -> VersionRangeChat -> User -> ChatPagination -> Maybe Text -> ExceptT StoreError IO [AChatItem]
getAllChatItems :: Connection
-> VersionRangeChat
-> User
-> ChatPagination
-> Maybe MemberName
-> ExceptT StoreError IO [AChatItem]
getAllChatItems Connection
db VersionRangeChat
vr user :: User
user@User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatPagination
pagination Maybe MemberName
search_ = do
  [(ChatRef, ChatItemId)]
itemRefs <-
    [Either StoreError (ChatRef, ChatItemId)]
-> [(ChatRef, ChatItemId)]
forall a b. [Either a b] -> [b]
rights ([Either StoreError (ChatRef, ChatItemId)]
 -> [(ChatRef, ChatItemId)])
-> ([(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
      Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
    -> [Either StoreError (ChatRef, ChatItemId)])
-> [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
     Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> [(ChatRef, ChatItemId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
  Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)
 -> Either StoreError (ChatRef, ChatItemId))
-> [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
     Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> [Either StoreError (ChatRef, ChatItemId)]
forall a b. (a -> b) -> [a] -> [b]
map (ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
 Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)
-> Either StoreError (ChatRef, ChatItemId)
toChatItemRef ([(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
   Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
 -> [(ChatRef, ChatItemId)])
-> ExceptT
     StoreError
     IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> ExceptT StoreError IO [(ChatRef, ChatItemId)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case ChatPagination
pagination of
      CPLast Int
count -> IO
  [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
    Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> ExceptT
     StoreError
     IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
     Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
 -> ExceptT
      StoreError
      IO
      [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
        Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)])
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> ExceptT
     StoreError
     IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall a b. (a -> b) -> a -> b
$ Int
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
getAllChatItemsLast_ Int
count
      CPAfter ChatItemId
afterId Int
count -> IO
  [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
    Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> ExceptT
     StoreError
     IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
     Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
 -> ExceptT
      StoreError
      IO
      [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
        Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)])
-> (AChatItem
    -> IO
         [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
           Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)])
-> AChatItem
-> ExceptT
     StoreError
     IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatItemId
-> Int
-> UTCTime
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
getAllChatItemsAfter_ ChatItemId
afterId Int
count (UTCTime
 -> IO
      [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
        Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)])
-> (AChatItem -> UTCTime)
-> AChatItem
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AChatItem -> UTCTime
aChatItemTs (AChatItem
 -> ExceptT
      StoreError
      IO
      [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
        Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)])
-> ExceptT StoreError IO AChatItem
-> ExceptT
     StoreError
     IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ChatItemId -> ExceptT StoreError IO AChatItem
getAChatItem_ ChatItemId
afterId
      CPBefore ChatItemId
beforeId Int
count -> IO
  [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
    Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> ExceptT
     StoreError
     IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
     Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
 -> ExceptT
      StoreError
      IO
      [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
        Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)])
-> (AChatItem
    -> IO
         [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
           Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)])
-> AChatItem
-> ExceptT
     StoreError
     IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatItemId
-> Int
-> UTCTime
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
getAllChatItemsBefore_ ChatItemId
beforeId Int
count (UTCTime
 -> IO
      [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
        Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)])
-> (AChatItem -> UTCTime)
-> AChatItem
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AChatItem -> UTCTime
aChatItemTs (AChatItem
 -> ExceptT
      StoreError
      IO
      [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
        Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)])
-> ExceptT StoreError IO AChatItem
-> ExceptT
     StoreError
     IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ChatItemId -> ExceptT StoreError IO AChatItem
getAChatItem_ ChatItemId
beforeId
      CPAround ChatItemId
aroundId Int
count -> IO
  [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
    Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> ExceptT
     StoreError
     IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
     Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
 -> ExceptT
      StoreError
      IO
      [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
        Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)])
-> (AChatItem
    -> IO
         [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
           Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)])
-> AChatItem
-> ExceptT
     StoreError
     IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatItemId
-> Int
-> UTCTime
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
getAllChatItemsAround_ ChatItemId
aroundId Int
count (UTCTime
 -> IO
      [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
        Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)])
-> (AChatItem -> UTCTime)
-> AChatItem
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AChatItem -> UTCTime
aChatItemTs (AChatItem
 -> ExceptT
      StoreError
      IO
      [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
        Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)])
-> ExceptT StoreError IO AChatItem
-> ExceptT
     StoreError
     IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ChatItemId -> ExceptT StoreError IO AChatItem
getAChatItem_ ChatItemId
aroundId
      CPInitial Int
count -> do
        Bool -> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (MemberName -> Bool
T.null MemberName
search) (ExceptT StoreError IO () -> ExceptT StoreError IO ())
-> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ StoreError -> ExceptT StoreError IO ()
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO ())
-> StoreError -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> StoreError
SEInternalError FilePath
"initial chat pagination doesn't support search"
        IO (Maybe ChatItemId) -> ExceptT StoreError IO (Maybe ChatItemId)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Maybe ChatItemId)
getFirstUnreadItemId_ ExceptT StoreError IO (Maybe ChatItemId)
-> (Maybe ChatItemId
    -> ExceptT
         StoreError
         IO
         [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
           Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)])
-> ExceptT
     StoreError
     IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall a b.
ExceptT StoreError IO a
-> (a -> ExceptT StoreError IO b) -> ExceptT StoreError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Just ChatItemId
itemId -> IO
  [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
    Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> ExceptT
     StoreError
     IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
     Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
 -> ExceptT
      StoreError
      IO
      [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
        Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)])
-> (AChatItem
    -> IO
         [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
           Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)])
-> AChatItem
-> ExceptT
     StoreError
     IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatItemId
-> Int
-> UTCTime
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
getAllChatItemsAround_ ChatItemId
itemId Int
count (UTCTime
 -> IO
      [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
        Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)])
-> (AChatItem -> UTCTime)
-> AChatItem
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AChatItem -> UTCTime
aChatItemTs (AChatItem
 -> ExceptT
      StoreError
      IO
      [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
        Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)])
-> ExceptT StoreError IO AChatItem
-> ExceptT
     StoreError
     IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ChatItemId -> ExceptT StoreError IO AChatItem
getAChatItem_ ChatItemId
itemId
          Maybe ChatItemId
Nothing -> IO
  [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
    Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> ExceptT
     StoreError
     IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
     Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
 -> ExceptT
      StoreError
      IO
      [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
        Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)])
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> ExceptT
     StoreError
     IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall a b. (a -> b) -> a -> b
$ Int
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
getAllChatItemsLast_ Int
count
  ((ChatRef, ChatItemId) -> ExceptT StoreError IO AChatItem)
-> [(ChatRef, ChatItemId)] -> ExceptT StoreError IO [AChatItem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ChatRef -> ChatItemId -> ExceptT StoreError IO AChatItem)
-> (ChatRef, ChatItemId) -> ExceptT StoreError IO AChatItem
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Connection
-> VersionRangeChat
-> User
-> ChatRef
-> ChatItemId
-> ExceptT StoreError IO AChatItem
getAChatItem Connection
db VersionRangeChat
vr User
user)) [(ChatRef, ChatItemId)]
itemRefs
  where
    search :: MemberName
search = MemberName -> Maybe MemberName -> MemberName
forall a. a -> Maybe a -> a
fromMaybe MemberName
"" Maybe MemberName
search_
    getAChatItem_ :: ChatItemId -> ExceptT StoreError IO AChatItem
getAChatItem_ ChatItemId
itemId = do
      ChatRef
chatRef <- Connection -> User -> ChatItemId -> ExceptT StoreError IO ChatRef
getChatRefViaItemId Connection
db User
user ChatItemId
itemId
      Connection
-> VersionRangeChat
-> User
-> ChatRef
-> ChatItemId
-> ExceptT StoreError IO AChatItem
getAChatItem Connection
db VersionRangeChat
vr User
user ChatRef
chatRef ChatItemId
itemId
    getAllChatItemsLast_ :: Int
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
getAllChatItemsLast_ Int
count =
      [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
  Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
     Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall a. [a] -> [a]
reverse
        ([(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
   Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
 -> [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
      Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)])
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (ChatItemId, MemberName, Int)
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT chat_item_id, contact_id, group_id, group_scope_tag, group_scope_group_member_id, note_folder_id
            FROM chat_items
            WHERE user_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
            ORDER BY item_ts DESC, chat_item_id DESC
            LIMIT ?
          |]
          (ChatItemId
userId, MemberName
search, Int
count)
    getAllChatItemsAfter_ :: ChatItemId
-> Int
-> UTCTime
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
getAllChatItemsAfter_ ChatItemId
afterId Int
count UTCTime
afterTs =
      Connection
-> Query
-> (ChatItemId, MemberName, UTCTime, UTCTime, ChatItemId, Int)
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT chat_item_id, contact_id, group_id, group_scope_tag, group_scope_group_member_id, note_folder_id
          FROM chat_items
          WHERE user_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
            AND (item_ts > ? OR (item_ts = ? AND chat_item_id > ?))
          ORDER BY item_ts ASC, chat_item_id ASC
          LIMIT ?
        |]
        (ChatItemId
userId, MemberName
search, UTCTime
afterTs, UTCTime
afterTs, ChatItemId
afterId, Int
count)
    getAllChatItemsBefore_ :: ChatItemId
-> Int
-> UTCTime
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
getAllChatItemsBefore_ ChatItemId
beforeId Int
count UTCTime
beforeTs =
      [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
  Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
     Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall a. [a] -> [a]
reverse
        ([(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
   Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
 -> [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
      Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)])
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (ChatItemId, MemberName, UTCTime, UTCTime, ChatItemId, Int)
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT chat_item_id, contact_id, group_id, group_scope_tag, group_scope_group_member_id, note_folder_id
            FROM chat_items
            WHERE user_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
              AND (item_ts < ? OR (item_ts = ? AND chat_item_id < ?))
            ORDER BY item_ts DESC, chat_item_id DESC
            LIMIT ?
          |]
          (ChatItemId
userId, MemberName
search, UTCTime
beforeTs, UTCTime
beforeTs, ChatItemId
beforeId, Int
count)
    getChatItem :: ChatItemId
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
getChatItem ChatItemId
chatId =
      Connection
-> Query
-> Only ChatItemId
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT chat_item_id, contact_id, group_id, group_scope_tag, group_scope_group_member_id, note_folder_id
          FROM chat_items
          WHERE chat_item_id = ?
        |]
        (ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
chatId)
    getAllChatItemsAround_ :: ChatItemId
-> Int
-> UTCTime
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
getAllChatItemsAround_ ChatItemId
aroundId Int
count UTCTime
aroundTs = do
      [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
  Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
itemsBefore <- ChatItemId
-> Int
-> UTCTime
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
getAllChatItemsBefore_ ChatItemId
aroundId Int
count UTCTime
aroundTs
      [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
  Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
item <- ChatItemId
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
getChatItem ChatItemId
aroundId
      [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
  Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
itemsAfter <- ChatItemId
-> Int
-> UTCTime
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
getAllChatItemsAfter_ ChatItemId
aroundId Int
count UTCTime
aroundTs
      [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
  Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
   Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
 -> IO
      [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
        Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)])
-> [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
     Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall a b. (a -> b) -> a -> b
$ [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
  Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
itemsBefore [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
  Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
     Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
     Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall a. Semigroup a => a -> a -> a
<> [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
  Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
item [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
  Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
     Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
     Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall a. Semigroup a => a -> a -> a
<> [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
  Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
itemsAfter
    getFirstUnreadItemId_ :: IO (Maybe ChatItemId)
getFirstUnreadItemId_ =
      (Maybe (Maybe ChatItemId) -> Maybe ChatItemId)
-> IO (Maybe (Maybe ChatItemId)) -> IO (Maybe ChatItemId)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe ChatItemId) -> Maybe ChatItemId
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (Maybe (Maybe ChatItemId)) -> IO (Maybe ChatItemId))
-> (IO [Only (Maybe ChatItemId)] -> IO (Maybe (Maybe ChatItemId)))
-> IO [Only (Maybe ChatItemId)]
-> IO (Maybe ChatItemId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only (Maybe ChatItemId) -> Maybe ChatItemId)
-> IO [Only (Maybe ChatItemId)] -> IO (Maybe (Maybe ChatItemId))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only (Maybe ChatItemId) -> Maybe ChatItemId
forall a. Only a -> a
fromOnly (IO [Only (Maybe ChatItemId)] -> IO (Maybe ChatItemId))
-> IO [Only (Maybe ChatItemId)] -> IO (Maybe ChatItemId)
forall a b. (a -> b) -> a -> b
$
        Connection
-> Query
-> (ChatItemId, CIStatus 'MDRcv)
-> IO [Only (Maybe ChatItemId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT MIN(chat_item_id)
            FROM chat_items
            WHERE user_id = ? AND item_status = ?
          |]
          (ChatItemId
userId, CIStatus 'MDRcv
CISRcvNew)

getChatItemIdsByAgentMsgId :: DB.Connection -> Int64 -> AgentMsgId -> IO [ChatItemId]
getChatItemIdsByAgentMsgId :: Connection -> ChatItemId -> ChatItemId -> IO [ChatItemId]
getChatItemIdsByAgentMsgId Connection
db ChatItemId
connId ChatItemId
msgId =
  (Only ChatItemId -> ChatItemId)
-> [Only ChatItemId] -> [ChatItemId]
forall a b. (a -> b) -> [a] -> [b]
map Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly
    ([Only ChatItemId] -> [ChatItemId])
-> IO [Only ChatItemId] -> IO [ChatItemId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query -> (ChatItemId, ChatItemId) -> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT chat_item_id
        FROM chat_item_messages
        WHERE message_id IN (
          SELECT message_id
          FROM msg_deliveries
          WHERE connection_id = ? AND agent_msg_id = ?
        )
      |]
      (ChatItemId
connId, ChatItemId
msgId)

updateDirectChatItemStatus :: forall d. MsgDirectionI d => DB.Connection -> User -> Contact -> ChatItemId -> CIStatus d -> ExceptT StoreError IO (ChatItem 'CTDirect d)
updateDirectChatItemStatus :: forall (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> User
-> Contact
-> ChatItemId
-> CIStatus d
-> ExceptT StoreError IO (ChatItem 'CTDirect d)
updateDirectChatItemStatus Connection
db user :: User
user@User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ct :: Contact
ct@Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} ChatItemId
itemId CIStatus d
itemStatus = do
  ChatItem 'CTDirect d
ci <- Either StoreError (ChatItem 'CTDirect d)
-> ExceptT StoreError IO (ChatItem 'CTDirect d)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either StoreError (ChatItem 'CTDirect d)
 -> ExceptT StoreError IO (ChatItem 'CTDirect d))
-> (CChatItem 'CTDirect
    -> Either StoreError (ChatItem 'CTDirect d))
-> CChatItem 'CTDirect
-> ExceptT StoreError IO (ChatItem 'CTDirect d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChatItem 'CTDirect -> Either StoreError (ChatItem 'CTDirect d)
forall (d :: MsgDirection) (c :: ChatType).
MsgDirectionI d =>
CChatItem c -> Either StoreError (ChatItem c d)
correctDir (CChatItem 'CTDirect
 -> ExceptT StoreError IO (ChatItem 'CTDirect d))
-> ExceptT StoreError IO (CChatItem 'CTDirect)
-> ExceptT StoreError IO (ChatItem 'CTDirect d)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Connection
-> User
-> Contact
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectCIWithReactions Connection
db User
user Contact
ct ChatItemId
itemId
  UTCTime
currentTs <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> Query
-> (CIStatus d, UTCTime, ChatItemId, ChatItemId, ChatItemId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE chat_items SET item_status = ?, updated_at = ? WHERE user_id = ? AND contact_id = ? AND chat_item_id = ?" (CIStatus d
itemStatus, UTCTime
currentTs, ChatItemId
userId, ChatItemId
contactId, ChatItemId
itemId)
  ChatItem 'CTDirect d
-> ExceptT StoreError IO (ChatItem 'CTDirect d)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatItem 'CTDirect d
ci {meta = (meta ci) {itemStatus}}

setDirectSndChatItemViaProxy :: DB.Connection -> User -> Contact -> ChatItem 'CTDirect 'MDSnd -> Bool -> IO (ChatItem 'CTDirect 'MDSnd)
setDirectSndChatItemViaProxy :: Connection
-> User
-> Contact
-> ChatItem 'CTDirect 'MDSnd
-> Bool
-> IO (ChatItem 'CTDirect 'MDSnd)
setDirectSndChatItemViaProxy Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} ChatItem 'CTDirect 'MDSnd
ci Bool
viaProxy = do
  Connection
-> Query -> (BoolInt, ChatItemId, ChatItemId, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE chat_items SET via_proxy = ? WHERE user_id = ? AND contact_id = ? AND chat_item_id = ?" (Bool -> BoolInt
BI Bool
viaProxy, ChatItemId
userId, ChatItemId
contactId, ChatItem 'CTDirect 'MDSnd -> ChatItemId
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> ChatItemId
chatItemId' ChatItem 'CTDirect 'MDSnd
ci)
  ChatItem 'CTDirect 'MDSnd -> IO (ChatItem 'CTDirect 'MDSnd)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatItem 'CTDirect 'MDSnd
ci {meta = (meta ci) {sentViaProxy = Just viaProxy}}

updateDirectChatItem :: MsgDirectionI d => DB.Connection -> User -> Contact -> ChatItemId -> CIContent d -> Bool -> Bool -> Maybe CITimed -> Maybe MessageId -> ExceptT StoreError IO (ChatItem 'CTDirect d)
updateDirectChatItem :: forall (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> User
-> Contact
-> ChatItemId
-> CIContent d
-> Bool
-> Bool
-> Maybe CITimed
-> Maybe ChatItemId
-> ExceptT StoreError IO (ChatItem 'CTDirect d)
updateDirectChatItem Connection
db User
user ct :: Contact
ct@Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} ChatItemId
itemId CIContent d
newContent Bool
edited Bool
live Maybe CITimed
timed_ Maybe ChatItemId
msgId_ = do
  ChatItem 'CTDirect d
ci <- Either StoreError (ChatItem 'CTDirect d)
-> ExceptT StoreError IO (ChatItem 'CTDirect d)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either StoreError (ChatItem 'CTDirect d)
 -> ExceptT StoreError IO (ChatItem 'CTDirect d))
-> (CChatItem 'CTDirect
    -> Either StoreError (ChatItem 'CTDirect d))
-> CChatItem 'CTDirect
-> ExceptT StoreError IO (ChatItem 'CTDirect d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChatItem 'CTDirect -> Either StoreError (ChatItem 'CTDirect d)
forall (d :: MsgDirection) (c :: ChatType).
MsgDirectionI d =>
CChatItem c -> Either StoreError (ChatItem c d)
correctDir (CChatItem 'CTDirect
 -> ExceptT StoreError IO (ChatItem 'CTDirect d))
-> ExceptT StoreError IO (CChatItem 'CTDirect)
-> ExceptT StoreError IO (ChatItem 'CTDirect d)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Connection
-> User
-> Contact
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectCIWithReactions Connection
db User
user Contact
ct ChatItemId
itemId
  IO (ChatItem 'CTDirect d)
-> ExceptT StoreError IO (ChatItem 'CTDirect d)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ChatItem 'CTDirect d)
 -> ExceptT StoreError IO (ChatItem 'CTDirect d))
-> IO (ChatItem 'CTDirect d)
-> ExceptT StoreError IO (ChatItem 'CTDirect d)
forall a b. (a -> b) -> a -> b
$ Connection
-> User
-> ChatItemId
-> ChatItem 'CTDirect d
-> CIContent d
-> Bool
-> Bool
-> Maybe CITimed
-> Maybe ChatItemId
-> IO (ChatItem 'CTDirect d)
forall (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> User
-> ChatItemId
-> ChatItem 'CTDirect d
-> CIContent d
-> Bool
-> Bool
-> Maybe CITimed
-> Maybe ChatItemId
-> IO (ChatItem 'CTDirect d)
updateDirectChatItem' Connection
db User
user ChatItemId
contactId ChatItem 'CTDirect d
ci CIContent d
newContent Bool
edited Bool
live Maybe CITimed
timed_ Maybe ChatItemId
msgId_

getDirectCIWithReactions :: DB.Connection -> User -> Contact -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectCIWithReactions :: Connection
-> User
-> Contact
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectCIWithReactions Connection
db User
user ct :: Contact
ct@Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} ChatItemId
itemId =
  IO (CChatItem 'CTDirect)
-> ExceptT StoreError IO (CChatItem 'CTDirect)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (CChatItem 'CTDirect)
 -> ExceptT StoreError IO (CChatItem 'CTDirect))
-> (CChatItem 'CTDirect -> IO (CChatItem 'CTDirect))
-> CChatItem 'CTDirect
-> ExceptT StoreError IO (CChatItem 'CTDirect)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> Contact -> CChatItem 'CTDirect -> IO (CChatItem 'CTDirect)
directCIWithReactions Connection
db Contact
ct (CChatItem 'CTDirect
 -> ExceptT StoreError IO (CChatItem 'CTDirect))
-> ExceptT StoreError IO (CChatItem 'CTDirect)
-> ExceptT StoreError IO (CChatItem 'CTDirect)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Connection
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectChatItem Connection
db User
user ChatItemId
contactId ChatItemId
itemId

correctDir :: MsgDirectionI d => CChatItem c -> Either StoreError (ChatItem c d)
correctDir :: forall (d :: MsgDirection) (c :: ChatType).
MsgDirectionI d =>
CChatItem c -> Either StoreError (ChatItem c d)
correctDir (CChatItem SMsgDirection d
_ ChatItem c d
ci) = (FilePath -> StoreError)
-> Either FilePath (ChatItem c d)
-> Either StoreError (ChatItem c d)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first FilePath -> StoreError
SEInternalError (Either FilePath (ChatItem c d)
 -> Either StoreError (ChatItem c d))
-> Either FilePath (ChatItem c d)
-> Either StoreError (ChatItem c d)
forall a b. (a -> b) -> a -> b
$ ChatItem c d -> Either FilePath (ChatItem c d)
forall (t :: MsgDirection -> *) (d :: MsgDirection)
       (d' :: MsgDirection).
(MsgDirectionI d, MsgDirectionI d') =>
t d' -> Either FilePath (t d)
checkDirection ChatItem c d
ci

updateDirectChatItem' :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItem 'CTDirect d -> CIContent d -> Bool -> Bool -> Maybe CITimed -> Maybe MessageId -> IO (ChatItem 'CTDirect d)
updateDirectChatItem' :: forall (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> User
-> ChatItemId
-> ChatItem 'CTDirect d
-> CIContent d
-> Bool
-> Bool
-> Maybe CITimed
-> Maybe ChatItemId
-> IO (ChatItem 'CTDirect d)
updateDirectChatItem' Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
contactId ChatItem 'CTDirect d
ci CIContent d
newContent Bool
edited Bool
live Maybe CITimed
timed_ Maybe ChatItemId
msgId_ = do
  UTCTime
currentTs <- IO UTCTime -> IO UTCTime
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  let ci' :: ChatItem 'CTDirect d
ci' = ChatItem 'CTDirect d
-> CIContent d
-> Bool
-> Bool
-> Maybe CITimed
-> UTCTime
-> ChatItem 'CTDirect d
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d
-> CIContent d
-> Bool
-> Bool
-> Maybe CITimed
-> UTCTime
-> ChatItem c d
updatedChatItem ChatItem 'CTDirect d
ci CIContent d
newContent Bool
edited Bool
live Maybe CITimed
timed_ UTCTime
currentTs
  IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> ChatItemId
-> ChatItemId
-> ChatItem 'CTDirect d
-> Maybe ChatItemId
-> IO ()
forall (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> ChatItemId
-> ChatItemId
-> ChatItem 'CTDirect d
-> Maybe ChatItemId
-> IO ()
updateDirectChatItem_ Connection
db ChatItemId
userId ChatItemId
contactId ChatItem 'CTDirect d
ci' Maybe ChatItemId
msgId_
  ChatItem 'CTDirect d -> IO (ChatItem 'CTDirect d)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatItem 'CTDirect d
ci'

updatedChatItem :: ChatItem c d -> CIContent d -> Bool -> Bool -> Maybe CITimed -> UTCTime -> ChatItem c d
updatedChatItem :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d
-> CIContent d
-> Bool
-> Bool
-> Maybe CITimed
-> UTCTime
-> ChatItem c d
updatedChatItem ci :: ChatItem c d
ci@ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = meta :: CIMeta c d
meta@CIMeta {CIStatus d
itemStatus :: CIStatus d
itemStatus :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> CIStatus d
itemStatus, Bool
itemEdited :: Bool
itemEdited :: forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> Bool
itemEdited, Maybe CITimed
itemTimed :: Maybe CITimed
itemTimed :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe CITimed
itemTimed, Maybe Bool
itemLive :: Maybe Bool
itemLive :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe Bool
itemLive}} CIContent d
newContent Bool
edited Bool
live Maybe CITimed
timed_ UTCTime
currentTs =
  let newText :: MemberName
newText = CIContent d -> MemberName
forall (e :: MsgDirection). CIContent e -> MemberName
ciContentToText CIContent d
newContent
      edited' :: Bool
edited' = Bool
itemEdited Bool -> Bool -> Bool
|| Bool
edited
      live' :: Maybe Bool
live' = (Bool
live Bool -> Bool -> Bool
&&) (Bool -> Bool) -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
itemLive
      timed' :: Maybe CITimed
timed' = case Maybe CITimed
timed_ of
        Just CITimed
timed -> CITimed -> Maybe CITimed
forall a. a -> Maybe a
Just CITimed
timed
        Maybe CITimed
Nothing -> case (CIStatus d
itemStatus, Maybe CITimed
itemTimed, Maybe Bool
itemLive, Bool
live) of
          (CIStatus d
CISRcvNew, Maybe CITimed
_, Maybe Bool
_, Bool
_) -> Maybe CITimed
itemTimed
          (CIStatus d
_, Just CITimed {Int
ttl :: CITimed -> Int
ttl :: Int
ttl, deleteAt :: CITimed -> Maybe UTCTime
deleteAt = Maybe UTCTime
Nothing}, Just Bool
True, Bool
False) ->
            -- timed item, sent or read, not set for deletion, was live, now not live
            let deleteAt' :: UTCTime
deleteAt' = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (Int -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
ttl) UTCTime
currentTs
             in CITimed -> Maybe CITimed
forall a. a -> Maybe a
Just CITimed {Int
ttl :: Int
ttl :: Int
ttl, deleteAt :: Maybe UTCTime
deleteAt = UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
deleteAt'}
          (CIStatus d, Maybe CITimed, Maybe Bool, Bool)
_ -> Maybe CITimed
itemTimed
   in ChatItem c d
ci {content = newContent, meta = meta {itemText = newText, itemEdited = edited', itemTimed = timed', itemLive = live'}, formattedText = parseMaybeMarkdownList newText}

-- this function assumes that direct item with correct chat direction already exists,
-- it should be checked before calling it
updateDirectChatItem_ :: forall d. MsgDirectionI d => DB.Connection -> UserId -> Int64 -> ChatItem 'CTDirect d -> Maybe MessageId -> IO ()
updateDirectChatItem_ :: forall (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> ChatItemId
-> ChatItemId
-> ChatItem 'CTDirect d
-> Maybe ChatItemId
-> IO ()
updateDirectChatItem_ Connection
db ChatItemId
userId ChatItemId
contactId ChatItem {CIMeta 'CTDirect d
meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta :: CIMeta 'CTDirect d
meta, CIContent d
content :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIContent d
content :: CIContent d
content} Maybe ChatItemId
msgId_ = do
  let CIMeta {ChatItemId
itemId :: ChatItemId
itemId :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> ChatItemId
itemId, MemberName
itemText :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> MemberName
itemText :: MemberName
itemText, CIStatus d
itemStatus :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> CIStatus d
itemStatus :: CIStatus d
itemStatus, Maybe (CIDeleted 'CTDirect)
itemDeleted :: Maybe (CIDeleted 'CTDirect)
itemDeleted :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe (CIDeleted c)
itemDeleted, Bool
itemEdited :: forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> Bool
itemEdited :: Bool
itemEdited, Maybe CITimed
itemTimed :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe CITimed
itemTimed :: Maybe CITimed
itemTimed, Maybe Bool
itemLive :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe Bool
itemLive :: Maybe Bool
itemLive, UTCTime
updatedAt :: UTCTime
updatedAt :: forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> UTCTime
updatedAt} = CIMeta 'CTDirect d
meta
      itemDeleted' :: Bool
itemDeleted' = Maybe (CIDeleted 'CTDirect) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (CIDeleted 'CTDirect)
itemDeleted
      itemDeletedTs' :: Maybe UTCTime
itemDeletedTs' = CIDeleted 'CTDirect -> Maybe UTCTime
forall (d :: ChatType). CIDeleted d -> Maybe UTCTime
itemDeletedTs (CIDeleted 'CTDirect -> Maybe UTCTime)
-> Maybe (CIDeleted 'CTDirect) -> Maybe UTCTime
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (CIDeleted 'CTDirect)
itemDeleted
  Connection
-> Query
-> ((CIContent d, MemberName, CIStatus d, BoolInt, Maybe UTCTime,
     BoolInt, Maybe BoolInt, UTCTime)
    :. ((Maybe Int, Maybe UTCTime)
        :. (ChatItemId, ChatItemId, ChatItemId)))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE chat_items
      SET item_content = ?, item_text = ?, item_status = ?, item_deleted = ?, item_deleted_ts = ?, item_edited = ?, item_live = ?, updated_at = ?, timed_ttl = ?, timed_delete_at = ?
      WHERE user_id = ? AND contact_id = ? AND chat_item_id = ?
    |]
    ((CIContent d
content, MemberName
itemText, CIStatus d
itemStatus, Bool -> BoolInt
BI Bool
itemDeleted', Maybe UTCTime
itemDeletedTs', Bool -> BoolInt
BI Bool
itemEdited, Bool -> BoolInt
BI (Bool -> BoolInt) -> Maybe Bool -> Maybe BoolInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
itemLive, UTCTime
updatedAt) (CIContent d, MemberName, CIStatus d, BoolInt, Maybe UTCTime,
 BoolInt, Maybe BoolInt, UTCTime)
-> ((Maybe Int, Maybe UTCTime)
    :. (ChatItemId, ChatItemId, ChatItemId))
-> (CIContent d, MemberName, CIStatus d, BoolInt, Maybe UTCTime,
    BoolInt, Maybe BoolInt, UTCTime)
   :. ((Maybe Int, Maybe UTCTime)
       :. (ChatItemId, ChatItemId, ChatItemId))
forall h t. h -> t -> h :. t
:. Maybe CITimed -> (Maybe Int, Maybe UTCTime)
ciTimedRow Maybe CITimed
itemTimed (Maybe Int, Maybe UTCTime)
-> (ChatItemId, ChatItemId, ChatItemId)
-> (Maybe Int, Maybe UTCTime)
   :. (ChatItemId, ChatItemId, ChatItemId)
forall h t. h -> t -> h :. t
:. (ChatItemId
userId, ChatItemId
contactId, ChatItemId
itemId))
  Maybe ChatItemId -> (ChatItemId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe ChatItemId
msgId_ ((ChatItemId -> IO ()) -> IO ()) -> (ChatItemId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ChatItemId
msgId -> IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> ChatItemId -> ChatItemId -> UTCTime -> IO ()
insertChatItemMessage_ Connection
db ChatItemId
itemId ChatItemId
msgId UTCTime
updatedAt

addInitialAndNewCIVersions :: DB.Connection -> ChatItemId -> (UTCTime, MsgContent) -> (UTCTime, MsgContent) -> IO ()
addInitialAndNewCIVersions :: Connection
-> ChatItemId
-> (UTCTime, MsgContent)
-> (UTCTime, MsgContent)
-> IO ()
addInitialAndNewCIVersions Connection
db ChatItemId
itemId (UTCTime
initialTs, MsgContent
initialMC) (UTCTime
newTs, MsgContent
newMC) = do
  Int
versionsCount <- Connection -> ChatItemId -> IO Int
getChatItemVersionsCount Connection
db ChatItemId
itemId
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
versionsCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Connection -> ChatItemId -> UTCTime -> MsgContent -> IO ()
createChatItemVersion Connection
db ChatItemId
itemId UTCTime
initialTs MsgContent
initialMC
  Connection -> ChatItemId -> UTCTime -> MsgContent -> IO ()
createChatItemVersion Connection
db ChatItemId
itemId UTCTime
newTs MsgContent
newMC

getChatItemVersionsCount :: DB.Connection -> ChatItemId -> IO Int
getChatItemVersionsCount :: Connection -> ChatItemId -> IO Int
getChatItemVersionsCount Connection
db ChatItemId
itemId = do
  Maybe Int
count <-
    (Only Int -> Int) -> IO [Only Int] -> IO (Maybe Int)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only Int -> Int
forall a. Only a -> a
fromOnly (IO [Only Int] -> IO (Maybe Int))
-> IO [Only Int] -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$
      Connection -> Query -> Only ChatItemId -> IO [Only Int]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT COUNT(1) FROM chat_item_versions WHERE chat_item_id = ?" (ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
itemId)
  Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
count

createChatItemVersion :: DB.Connection -> ChatItemId -> UTCTime -> MsgContent -> IO ()
createChatItemVersion :: Connection -> ChatItemId -> UTCTime -> MsgContent -> IO ()
createChatItemVersion Connection
db ChatItemId
itemId UTCTime
itemVersionTs MsgContent
msgContent =
  Connection -> Query -> (ChatItemId, MsgContent, UTCTime) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      INSERT INTO chat_item_versions (chat_item_id, msg_content, item_version_ts)
      VALUES (?,?,?)
    |]
    (ChatItemId
itemId, MemberName -> MsgContent
MCText (MemberName -> MsgContent) -> MemberName -> MsgContent
forall a b. (a -> b) -> a -> b
$ MsgContent -> MemberName
msgContentText MsgContent
msgContent, UTCTime
itemVersionTs)

deleteDirectChatItem :: DB.Connection -> User -> Contact -> ChatItem 'CTDirect d -> IO ()
deleteDirectChatItem :: forall (d :: MsgDirection).
Connection -> User -> Contact -> ChatItem 'CTDirect d -> IO ()
deleteDirectChatItem Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} ChatItem 'CTDirect d
ci = do
  let itemId :: ChatItemId
itemId = ChatItem 'CTDirect d -> ChatItemId
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> ChatItemId
chatItemId' ChatItem 'CTDirect d
ci
  Connection -> ChatItemId -> IO ()
deleteChatItemMessages_ Connection
db ChatItemId
itemId
  Connection -> ChatItemId -> IO ()
deleteChatItemVersions_ Connection
db ChatItemId
itemId
  Connection -> ChatItemId -> ChatItem 'CTDirect d -> IO ()
forall (d :: MsgDirection).
Connection -> ChatItemId -> ChatItem 'CTDirect d -> IO ()
deleteDirectCIReactions_ Connection
db ChatItemId
contactId ChatItem 'CTDirect d
ci
  Connection
-> Query -> (ChatItemId, ChatItemId, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      DELETE FROM chat_items
      WHERE user_id = ? AND contact_id = ? AND chat_item_id = ?
    |]
    (ChatItemId
userId, ChatItemId
contactId, ChatItemId
itemId)

deleteChatItemMessages_ :: DB.Connection -> ChatItemId -> IO ()
deleteChatItemMessages_ :: Connection -> ChatItemId -> IO ()
deleteChatItemMessages_ Connection
db ChatItemId
itemId = Connection -> Query -> Only ChatItemId -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
deleteChatItemMessagesQuery (ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
itemId)

deleteChatItemMessagesQuery :: Query
deleteChatItemMessagesQuery :: Query
deleteChatItemMessagesQuery =
  [sql|
    DELETE FROM messages
    WHERE message_id IN (
      SELECT message_id
      FROM chat_item_messages
      WHERE chat_item_id = ?
    )
  |]

deleteChatItemVersions_ :: DB.Connection -> ChatItemId -> IO ()
deleteChatItemVersions_ :: Connection -> ChatItemId -> IO ()
deleteChatItemVersions_ Connection
db ChatItemId
itemId =
  Connection -> Query -> Only ChatItemId -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM chat_item_versions WHERE chat_item_id = ?" (ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
itemId)

markDirectChatItemDeleted :: DB.Connection -> User -> Contact -> ChatItem 'CTDirect d -> UTCTime -> IO (ChatItem 'CTDirect d)
markDirectChatItemDeleted :: forall (d :: MsgDirection).
Connection
-> User
-> Contact
-> ChatItem 'CTDirect d
-> UTCTime
-> IO (ChatItem 'CTDirect d)
markDirectChatItemDeleted Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} ci :: ChatItem 'CTDirect d
ci@ChatItem {CIMeta 'CTDirect d
meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta :: CIMeta 'CTDirect d
meta} UTCTime
deletedTs = do
  UTCTime
currentTs <- IO UTCTime -> IO UTCTime
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  let itemId :: ChatItemId
itemId = ChatItem 'CTDirect d -> ChatItemId
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> ChatItemId
chatItemId' ChatItem 'CTDirect d
ci
  Connection
-> Query
-> (Int, UTCTime, UTCTime, ChatItemId, ChatItemId, ChatItemId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE chat_items
      SET item_deleted = ?, item_deleted_ts = ?, updated_at = ?
      WHERE user_id = ? AND contact_id = ? AND chat_item_id = ?
    |]
    (Int
DBCIDeleted, UTCTime
deletedTs, UTCTime
currentTs, ChatItemId
userId, ChatItemId
contactId, ChatItemId
itemId)
  ChatItem 'CTDirect d -> IO (ChatItem 'CTDirect d)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatItem 'CTDirect d
ci {meta = meta {itemDeleted = Just $ CIDeleted $ Just deletedTs, editable = False, deletable = False}}

getDirectChatItemBySharedMsgId :: DB.Connection -> User -> ContactId -> SharedMsgId -> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectChatItemBySharedMsgId :: Connection
-> User
-> ChatItemId
-> SharedMsgId
-> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectChatItemBySharedMsgId Connection
db user :: User
user@User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
contactId SharedMsgId
sharedMsgId = do
  ChatItemId
itemId <- Connection
-> ChatItemId
-> ChatItemId
-> SharedMsgId
-> ExceptT StoreError IO ChatItemId
getDirectChatItemIdBySharedMsgId_ Connection
db ChatItemId
userId ChatItemId
contactId SharedMsgId
sharedMsgId
  Connection
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectChatItem Connection
db User
user ChatItemId
contactId ChatItemId
itemId

getDirectChatItemsByAgentMsgId :: DB.Connection -> User -> ContactId -> Int64 -> AgentMsgId -> IO [CChatItem 'CTDirect]
getDirectChatItemsByAgentMsgId :: Connection
-> User
-> ChatItemId
-> ChatItemId
-> ChatItemId
-> IO [CChatItem 'CTDirect]
getDirectChatItemsByAgentMsgId Connection
db User
user ChatItemId
contactId ChatItemId
connId ChatItemId
msgId = do
  [ChatItemId]
itemIds <- Connection -> ChatItemId -> ChatItemId -> IO [ChatItemId]
getChatItemIdsByAgentMsgId Connection
db ChatItemId
connId ChatItemId
msgId
  [Maybe (CChatItem 'CTDirect)] -> [CChatItem 'CTDirect]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (CChatItem 'CTDirect)] -> [CChatItem 'CTDirect])
-> IO [Maybe (CChatItem 'CTDirect)] -> IO [CChatItem 'CTDirect]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ChatItemId -> IO (Maybe (CChatItem 'CTDirect)))
-> [ChatItemId] -> IO [Maybe (CChatItem 'CTDirect)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Either StoreError (CChatItem 'CTDirect)
 -> Maybe (CChatItem 'CTDirect))
-> IO (Either StoreError (CChatItem 'CTDirect))
-> IO (Maybe (CChatItem 'CTDirect))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either StoreError (CChatItem 'CTDirect)
-> Maybe (CChatItem 'CTDirect)
forall a b. Either a b -> Maybe b
eitherToMaybe (IO (Either StoreError (CChatItem 'CTDirect))
 -> IO (Maybe (CChatItem 'CTDirect)))
-> (ChatItemId -> IO (Either StoreError (CChatItem 'CTDirect)))
-> ChatItemId
-> IO (Maybe (CChatItem 'CTDirect))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT StoreError IO (CChatItem 'CTDirect)
-> IO (Either StoreError (CChatItem 'CTDirect))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO (CChatItem 'CTDirect)
 -> IO (Either StoreError (CChatItem 'CTDirect)))
-> (ChatItemId -> ExceptT StoreError IO (CChatItem 'CTDirect))
-> ChatItemId
-> IO (Either StoreError (CChatItem 'CTDirect))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectChatItem Connection
db User
user ChatItemId
contactId) [ChatItemId]
itemIds

getDirectChatItemIdBySharedMsgId_ :: DB.Connection -> UserId -> Int64 -> SharedMsgId -> ExceptT StoreError IO Int64
getDirectChatItemIdBySharedMsgId_ :: Connection
-> ChatItemId
-> ChatItemId
-> SharedMsgId
-> ExceptT StoreError IO ChatItemId
getDirectChatItemIdBySharedMsgId_ Connection
db ChatItemId
userId ChatItemId
contactId SharedMsgId
sharedMsgId =
  IO (Either StoreError ChatItemId)
-> ExceptT StoreError IO ChatItemId
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError ChatItemId)
 -> ExceptT StoreError IO ChatItemId)
-> (IO [Only ChatItemId] -> IO (Either StoreError ChatItemId))
-> IO [Only ChatItemId]
-> ExceptT StoreError IO ChatItemId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only ChatItemId -> ChatItemId)
-> StoreError
-> IO [Only ChatItemId]
-> IO (Either StoreError ChatItemId)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly (SharedMsgId -> StoreError
SEChatItemSharedMsgIdNotFound SharedMsgId
sharedMsgId) (IO [Only ChatItemId] -> ExceptT StoreError IO ChatItemId)
-> IO [Only ChatItemId] -> ExceptT StoreError IO ChatItemId
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (ChatItemId, ChatItemId, SharedMsgId)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT chat_item_id
        FROM chat_items
        WHERE user_id = ? AND contact_id = ? AND shared_msg_id = ?
        ORDER BY chat_item_id DESC
        LIMIT 1
      |]
      (ChatItemId
userId, ChatItemId
contactId, SharedMsgId
sharedMsgId)

getDirectChatItem :: DB.Connection -> User -> Int64 -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectChatItem :: Connection
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectChatItem Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
contactId ChatItemId
itemId = IO (Either StoreError (CChatItem 'CTDirect))
-> ExceptT StoreError IO (CChatItem 'CTDirect)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (CChatItem 'CTDirect))
 -> ExceptT StoreError IO (CChatItem 'CTDirect))
-> IO (Either StoreError (CChatItem 'CTDirect))
-> ExceptT StoreError IO (CChatItem 'CTDirect)
forall a b. (a -> b) -> a -> b
$ do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  ((ChatItemRow :. QuoteRow)
 -> Either StoreError (CChatItem 'CTDirect))
-> StoreError
-> IO [ChatItemRow :. QuoteRow]
-> IO (Either StoreError (CChatItem 'CTDirect))
forall a e b. (a -> Either e b) -> e -> IO [a] -> IO (Either e b)
firstRow' (UTCTime
-> (ChatItemRow :. QuoteRow)
-> Either StoreError (CChatItem 'CTDirect)
toDirectChatItem UTCTime
currentTs) (ChatItemId -> StoreError
SEChatItemNotFound ChatItemId
itemId) IO [ChatItemRow :. QuoteRow]
getItem
  where
    getItem :: IO [ChatItemRow :. QuoteRow]
getItem =
      Connection
-> Query
-> (ChatItemId, ChatItemId, ChatItemId)
-> IO [ChatItemRow :. QuoteRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT
            -- ChatItem
            i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.via_proxy, i.shared_msg_id,
            i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at,
            i.fwd_from_tag, i.fwd_from_chat_name, i.fwd_from_msg_dir, i.fwd_from_contact_id, i.fwd_from_group_id, i.fwd_from_chat_item_id,
            i.timed_ttl, i.timed_delete_at, i.item_live, i.user_mention,
            -- CIFile
            f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
            -- DirectQuote
            ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent
          FROM chat_items i
          LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
          LEFT JOIN chat_items ri ON ri.user_id = i.user_id AND ri.contact_id = i.contact_id AND ri.shared_msg_id = i.quoted_shared_msg_id
          WHERE i.user_id = ? AND i.contact_id = ? AND i.chat_item_id = ?
        |]
        (ChatItemId
userId, ChatItemId
contactId, ChatItemId
itemId)

getDirectChatItemIdByText :: DB.Connection -> UserId -> Int64 -> SMsgDirection d -> Text -> ExceptT StoreError IO ChatItemId
getDirectChatItemIdByText :: forall (d :: MsgDirection).
Connection
-> ChatItemId
-> ChatItemId
-> SMsgDirection d
-> MemberName
-> ExceptT StoreError IO ChatItemId
getDirectChatItemIdByText Connection
db ChatItemId
userId ChatItemId
contactId SMsgDirection d
msgDir MemberName
quotedMsg =
  IO (Either StoreError ChatItemId)
-> ExceptT StoreError IO ChatItemId
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError ChatItemId)
 -> ExceptT StoreError IO ChatItemId)
-> (IO [Only ChatItemId] -> IO (Either StoreError ChatItemId))
-> IO [Only ChatItemId]
-> ExceptT StoreError IO ChatItemId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only ChatItemId -> ChatItemId)
-> StoreError
-> IO [Only ChatItemId]
-> IO (Either StoreError ChatItemId)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly (MemberName -> StoreError
SEChatItemNotFoundByText MemberName
quotedMsg) (IO [Only ChatItemId] -> ExceptT StoreError IO ChatItemId)
-> IO [Only ChatItemId] -> ExceptT StoreError IO ChatItemId
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (ChatItemId, ChatItemId, SMsgDirection d, MemberName)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT chat_item_id
        FROM chat_items
        WHERE user_id = ? AND contact_id = ? AND item_sent = ? AND item_text LIKE ?
        ORDER BY chat_item_id DESC
        LIMIT 1
      |]
      (ChatItemId
userId, ChatItemId
contactId, SMsgDirection d
msgDir, MemberName
quotedMsg MemberName -> MemberName -> MemberName
forall a. Semigroup a => a -> a -> a
<> MemberName
"%")

getDirectChatItemIdByText' :: DB.Connection -> User -> ContactId -> Text -> ExceptT StoreError IO ChatItemId
getDirectChatItemIdByText' :: Connection
-> User
-> ChatItemId
-> MemberName
-> ExceptT StoreError IO ChatItemId
getDirectChatItemIdByText' Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
contactId MemberName
msg =
  IO (Either StoreError ChatItemId)
-> ExceptT StoreError IO ChatItemId
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError ChatItemId)
 -> ExceptT StoreError IO ChatItemId)
-> (IO [Only ChatItemId] -> IO (Either StoreError ChatItemId))
-> IO [Only ChatItemId]
-> ExceptT StoreError IO ChatItemId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only ChatItemId -> ChatItemId)
-> StoreError
-> IO [Only ChatItemId]
-> IO (Either StoreError ChatItemId)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly (MemberName -> StoreError
SEChatItemNotFoundByText MemberName
msg) (IO [Only ChatItemId] -> ExceptT StoreError IO ChatItemId)
-> IO [Only ChatItemId] -> ExceptT StoreError IO ChatItemId
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (ChatItemId, ChatItemId, MemberName)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT chat_item_id
        FROM chat_items
        WHERE user_id = ? AND contact_id = ? AND item_text LIKE ?
        ORDER BY chat_item_id DESC
        LIMIT 1
      |]
      (ChatItemId
userId, ChatItemId
contactId, MemberName
msg MemberName -> MemberName -> MemberName
forall a. Semigroup a => a -> a -> a
<> MemberName
"%")

updateGroupChatItemStatus :: MsgDirectionI d => DB.Connection -> User -> GroupInfo -> ChatItemId -> CIStatus d -> ExceptT StoreError IO (ChatItem 'CTGroup d)
updateGroupChatItemStatus :: forall (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> User
-> GroupInfo
-> ChatItemId
-> CIStatus d
-> ExceptT StoreError IO (ChatItem 'CTGroup d)
updateGroupChatItemStatus Connection
db user :: User
user@User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} g :: GroupInfo
g@GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} ChatItemId
itemId CIStatus d
itemStatus = do
  ChatItem 'CTGroup d
ci <- Either StoreError (ChatItem 'CTGroup d)
-> ExceptT StoreError IO (ChatItem 'CTGroup d)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either StoreError (ChatItem 'CTGroup d)
 -> ExceptT StoreError IO (ChatItem 'CTGroup d))
-> (CChatItem 'CTGroup -> Either StoreError (ChatItem 'CTGroup d))
-> CChatItem 'CTGroup
-> ExceptT StoreError IO (ChatItem 'CTGroup d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChatItem 'CTGroup -> Either StoreError (ChatItem 'CTGroup d)
forall (d :: MsgDirection) (c :: ChatType).
MsgDirectionI d =>
CChatItem c -> Either StoreError (ChatItem c d)
correctDir (CChatItem 'CTGroup -> ExceptT StoreError IO (ChatItem 'CTGroup d))
-> ExceptT StoreError IO (CChatItem 'CTGroup)
-> ExceptT StoreError IO (ChatItem 'CTGroup d)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Connection
-> User
-> GroupInfo
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupCIWithReactions Connection
db User
user GroupInfo
g ChatItemId
itemId
  UTCTime
currentTs <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> Query
-> (CIStatus d, UTCTime, ChatItemId, ChatItemId, ChatItemId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE chat_items SET item_status = ?, updated_at = ? WHERE user_id = ? AND group_id = ? AND chat_item_id = ?" (CIStatus d
itemStatus, UTCTime
currentTs, ChatItemId
userId, ChatItemId
groupId, ChatItemId
itemId)
  ChatItem 'CTGroup d -> ExceptT StoreError IO (ChatItem 'CTGroup d)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatItem 'CTGroup d
ci {meta = (meta ci) {itemStatus}}

getGroupCIWithReactions :: DB.Connection -> User -> GroupInfo -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupCIWithReactions :: Connection
-> User
-> GroupInfo
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupCIWithReactions Connection
db User
user g :: GroupInfo
g@GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} ChatItemId
itemId = do
  IO (CChatItem 'CTGroup)
-> ExceptT StoreError IO (CChatItem 'CTGroup)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (CChatItem 'CTGroup)
 -> ExceptT StoreError IO (CChatItem 'CTGroup))
-> (CChatItem 'CTGroup -> IO (CChatItem 'CTGroup))
-> CChatItem 'CTGroup
-> ExceptT StoreError IO (CChatItem 'CTGroup)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> GroupInfo -> CChatItem 'CTGroup -> IO (CChatItem 'CTGroup)
groupCIWithReactions Connection
db GroupInfo
g (CChatItem 'CTGroup -> ExceptT StoreError IO (CChatItem 'CTGroup))
-> ExceptT StoreError IO (CChatItem 'CTGroup)
-> ExceptT StoreError IO (CChatItem 'CTGroup)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Connection
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupChatItem Connection
db User
user ChatItemId
groupId ChatItemId
itemId

groupCIWithReactions :: DB.Connection -> GroupInfo -> CChatItem 'CTGroup -> IO (CChatItem 'CTGroup)
groupCIWithReactions :: Connection
-> GroupInfo -> CChatItem 'CTGroup -> IO (CChatItem 'CTGroup)
groupCIWithReactions Connection
db GroupInfo
g cci :: CChatItem 'CTGroup
cci@(CChatItem SMsgDirection d
md ci :: ChatItem 'CTGroup d
ci@ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {ChatItemId
itemId :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> ChatItemId
itemId :: ChatItemId
itemId, Maybe SharedMsgId
itemSharedMsgId :: Maybe SharedMsgId
itemSharedMsgId :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe SharedMsgId
itemSharedMsgId}}) = do
  Map MemberName CIMention
mentions <- Connection -> ChatItemId -> IO (Map MemberName CIMention)
getGroupCIMentions Connection
db ChatItemId
itemId
  case Maybe SharedMsgId
itemSharedMsgId of
    Just SharedMsgId
sharedMsgId -> do
      let GroupMember {MemberId
memberId :: GroupMember -> MemberId
memberId :: MemberId
memberId} = GroupInfo -> ChatItem 'CTGroup d -> GroupMember
forall (d :: MsgDirection).
GroupInfo -> ChatItem 'CTGroup d -> GroupMember
chatItemMember GroupInfo
g ChatItem 'CTGroup d
ci
      [CIReactionCount]
reactions <- Connection
-> GroupInfo -> MemberId -> SharedMsgId -> IO [CIReactionCount]
getGroupCIReactions Connection
db GroupInfo
g MemberId
memberId SharedMsgId
sharedMsgId
      CChatItem 'CTGroup -> IO (CChatItem 'CTGroup)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CChatItem 'CTGroup -> IO (CChatItem 'CTGroup))
-> CChatItem 'CTGroup -> IO (CChatItem 'CTGroup)
forall a b. (a -> b) -> a -> b
$ SMsgDirection d -> ChatItem 'CTGroup d -> CChatItem 'CTGroup
forall (c :: ChatType) (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> ChatItem c d -> CChatItem c
CChatItem SMsgDirection d
md ChatItem 'CTGroup d
ci {reactions, mentions}
    Maybe SharedMsgId
Nothing -> CChatItem 'CTGroup -> IO (CChatItem 'CTGroup)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CChatItem 'CTGroup -> IO (CChatItem 'CTGroup))
-> CChatItem 'CTGroup -> IO (CChatItem 'CTGroup)
forall a b. (a -> b) -> a -> b
$ if Map MemberName CIMention -> Bool
forall a. Map MemberName a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map MemberName CIMention
mentions then CChatItem 'CTGroup
cci else SMsgDirection d -> ChatItem 'CTGroup d -> CChatItem 'CTGroup
forall (c :: ChatType) (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> ChatItem c d -> CChatItem c
CChatItem SMsgDirection d
md ChatItem 'CTGroup d
ci {mentions}

updateGroupChatItem :: MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItem 'CTGroup d -> CIContent d -> Bool -> Bool -> Maybe MessageId -> IO (ChatItem 'CTGroup d)
updateGroupChatItem :: forall (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> User
-> ChatItemId
-> ChatItem 'CTGroup d
-> CIContent d
-> Bool
-> Bool
-> Maybe ChatItemId
-> IO (ChatItem 'CTGroup d)
updateGroupChatItem Connection
db User
user ChatItemId
groupId ChatItem 'CTGroup d
ci CIContent d
newContent Bool
edited Bool
live Maybe ChatItemId
msgId_ = do
  UTCTime
currentTs <- IO UTCTime -> IO UTCTime
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  let ci' :: ChatItem 'CTGroup d
ci' = ChatItem 'CTGroup d
-> CIContent d
-> Bool
-> Bool
-> Maybe CITimed
-> UTCTime
-> ChatItem 'CTGroup d
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d
-> CIContent d
-> Bool
-> Bool
-> Maybe CITimed
-> UTCTime
-> ChatItem c d
updatedChatItem ChatItem 'CTGroup d
ci CIContent d
newContent Bool
edited Bool
live Maybe CITimed
forall a. Maybe a
Nothing UTCTime
currentTs
  IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> User
-> ChatItemId
-> ChatItem 'CTGroup d
-> Maybe ChatItemId
-> IO ()
forall (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> User
-> ChatItemId
-> ChatItem 'CTGroup d
-> Maybe ChatItemId
-> IO ()
updateGroupChatItem_ Connection
db User
user ChatItemId
groupId ChatItem 'CTGroup d
ci' Maybe ChatItemId
msgId_
  ChatItem 'CTGroup d -> IO (ChatItem 'CTGroup d)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatItem 'CTGroup d
ci'

-- this function assumes that the group item with correct chat direction already exists,
-- it should be checked before calling it
updateGroupChatItem_ :: MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItem 'CTGroup d -> Maybe MessageId -> IO ()
updateGroupChatItem_ :: forall (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> User
-> ChatItemId
-> ChatItem 'CTGroup d
-> Maybe ChatItemId
-> IO ()
updateGroupChatItem_ Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
groupId ChatItem {CIContent d
content :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIContent d
content :: CIContent d
content, CIMeta 'CTGroup d
meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta :: CIMeta 'CTGroup d
meta} Maybe ChatItemId
msgId_ = do
  let CIMeta {ChatItemId
itemId :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> ChatItemId
itemId :: ChatItemId
itemId, MemberName
itemText :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> MemberName
itemText :: MemberName
itemText, CIStatus d
itemStatus :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> CIStatus d
itemStatus :: CIStatus d
itemStatus, Maybe (CIDeleted 'CTGroup)
itemDeleted :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe (CIDeleted c)
itemDeleted :: Maybe (CIDeleted 'CTGroup)
itemDeleted, Bool
itemEdited :: forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> Bool
itemEdited :: Bool
itemEdited, Maybe CITimed
itemTimed :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe CITimed
itemTimed :: Maybe CITimed
itemTimed, Maybe Bool
itemLive :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe Bool
itemLive :: Maybe Bool
itemLive, UTCTime
updatedAt :: forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> UTCTime
updatedAt :: UTCTime
updatedAt} = CIMeta 'CTGroup d
meta
      itemDeleted' :: Bool
itemDeleted' = Maybe (CIDeleted 'CTGroup) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (CIDeleted 'CTGroup)
itemDeleted
      itemDeletedTs' :: Maybe UTCTime
itemDeletedTs' = CIDeleted 'CTGroup -> Maybe UTCTime
forall (d :: ChatType). CIDeleted d -> Maybe UTCTime
itemDeletedTs (CIDeleted 'CTGroup -> Maybe UTCTime)
-> Maybe (CIDeleted 'CTGroup) -> Maybe UTCTime
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (CIDeleted 'CTGroup)
itemDeleted
  Connection
-> Query
-> ((CIContent d, MemberName, CIStatus d, BoolInt, Maybe UTCTime,
     BoolInt, Maybe BoolInt, UTCTime)
    :. ((Maybe Int, Maybe UTCTime)
        :. (ChatItemId, ChatItemId, ChatItemId)))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE chat_items
      SET item_content = ?, item_text = ?, item_status = ?, item_deleted = ?, item_deleted_ts = ?, item_edited = ?, item_live = ?, updated_at = ?, timed_ttl = ?, timed_delete_at = ?
      WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
    |]
    ((CIContent d
content, MemberName
itemText, CIStatus d
itemStatus, Bool -> BoolInt
BI Bool
itemDeleted', Maybe UTCTime
itemDeletedTs', Bool -> BoolInt
BI Bool
itemEdited, Bool -> BoolInt
BI (Bool -> BoolInt) -> Maybe Bool -> Maybe BoolInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
itemLive, UTCTime
updatedAt) (CIContent d, MemberName, CIStatus d, BoolInt, Maybe UTCTime,
 BoolInt, Maybe BoolInt, UTCTime)
-> ((Maybe Int, Maybe UTCTime)
    :. (ChatItemId, ChatItemId, ChatItemId))
-> (CIContent d, MemberName, CIStatus d, BoolInt, Maybe UTCTime,
    BoolInt, Maybe BoolInt, UTCTime)
   :. ((Maybe Int, Maybe UTCTime)
       :. (ChatItemId, ChatItemId, ChatItemId))
forall h t. h -> t -> h :. t
:. Maybe CITimed -> (Maybe Int, Maybe UTCTime)
ciTimedRow Maybe CITimed
itemTimed (Maybe Int, Maybe UTCTime)
-> (ChatItemId, ChatItemId, ChatItemId)
-> (Maybe Int, Maybe UTCTime)
   :. (ChatItemId, ChatItemId, ChatItemId)
forall h t. h -> t -> h :. t
:. (ChatItemId
userId, ChatItemId
groupId, ChatItemId
itemId))
  Maybe ChatItemId -> (ChatItemId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe ChatItemId
msgId_ ((ChatItemId -> IO ()) -> IO ()) -> (ChatItemId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ChatItemId
msgId -> Connection -> ChatItemId -> ChatItemId -> UTCTime -> IO ()
insertChatItemMessage_ Connection
db ChatItemId
itemId ChatItemId
msgId UTCTime
updatedAt

createGroupCIMentions :: forall d. DB.Connection -> GroupInfo -> ChatItem 'CTGroup d -> Map MemberName CIMention -> IO (ChatItem 'CTGroup d)
createGroupCIMentions :: forall (d :: MsgDirection).
Connection
-> GroupInfo
-> ChatItem 'CTGroup d
-> Map MemberName CIMention
-> IO (ChatItem 'CTGroup d)
createGroupCIMentions Connection
db GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} ChatItem 'CTGroup d
ci Map MemberName CIMention
mentions = do
  Connection
-> Query
-> [(ChatItemId, ChatItemId, MemberId, MemberName)]
-> IO ()
forall q. ToRow q => Connection -> Query -> [q] -> IO ()
DB.executeMany Connection
db Query
"INSERT INTO chat_item_mentions (chat_item_id, group_id, member_id, display_name) VALUES (?, ?, ?, ?)" [(ChatItemId, ChatItemId, MemberId, MemberName)]
rows
  ChatItem 'CTGroup d -> IO (ChatItem 'CTGroup d)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatItem 'CTGroup d
ci :: ChatItem 'CTGroup d) {mentions}
  where
    rows :: [(ChatItemId, ChatItemId, MemberId, MemberName)]
rows = ((MemberName, CIMention)
 -> (ChatItemId, ChatItemId, MemberId, MemberName))
-> [(MemberName, CIMention)]
-> [(ChatItemId, ChatItemId, MemberId, MemberName)]
forall a b. (a -> b) -> [a] -> [b]
map (\(MemberName
name, CIMention {MemberId
memberId :: MemberId
memberId :: CIMention -> MemberId
memberId}) -> (ChatItemId
ciId, ChatItemId
groupId, MemberId
memberId, MemberName
name)) ([(MemberName, CIMention)]
 -> [(ChatItemId, ChatItemId, MemberId, MemberName)])
-> [(MemberName, CIMention)]
-> [(ChatItemId, ChatItemId, MemberId, MemberName)]
forall a b. (a -> b) -> a -> b
$ Map MemberName CIMention -> [(MemberName, CIMention)]
forall k a. Map k a -> [(k, a)]
M.assocs Map MemberName CIMention
mentions
    ciId :: ChatItemId
ciId = ChatItem 'CTGroup d -> ChatItemId
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> ChatItemId
chatItemId' ChatItem 'CTGroup d
ci

updateGroupCIMentions :: DB.Connection -> GroupInfo -> ChatItem 'CTGroup d -> Map MemberName CIMention -> IO (ChatItem 'CTGroup d)
updateGroupCIMentions :: forall (d :: MsgDirection).
Connection
-> GroupInfo
-> ChatItem 'CTGroup d
-> Map MemberName CIMention
-> IO (ChatItem 'CTGroup d)
updateGroupCIMentions Connection
db GroupInfo
g ci :: ChatItem 'CTGroup d
ci@ChatItem {Map MemberName CIMention
mentions :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> Map MemberName CIMention
mentions :: Map MemberName CIMention
mentions} Map MemberName CIMention
mentions'
  | Map MemberName CIMention
mentions' Map MemberName CIMention -> Map MemberName CIMention -> Bool
forall a. Eq a => a -> a -> Bool
== Map MemberName CIMention
mentions = ChatItem 'CTGroup d -> IO (ChatItem 'CTGroup d)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatItem 'CTGroup d
ci
  | Bool
otherwise = do
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Map MemberName CIMention -> Bool
forall a. Map MemberName a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map MemberName CIMention
mentions) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO ()
deleteMentions
      if Map MemberName CIMention -> Bool
forall a. Map MemberName a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map MemberName CIMention
mentions'
        then ChatItem 'CTGroup d -> IO (ChatItem 'CTGroup d)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatItem 'CTGroup d
ci
        else -- This is a fallback for the error that should not happen in practice.
        -- In theory, it may happen in item mentions in database are different from item record.
          IO (ChatItem 'CTGroup d)
createMentions IO (ChatItem 'CTGroup d)
-> (SQLError -> IO (ChatItem 'CTGroup d))
-> IO (ChatItem 'CTGroup d)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \SQLError
e -> if SQLError -> Bool
constraintError SQLError
e then IO ()
deleteMentions IO () -> IO (ChatItem 'CTGroup d) -> IO (ChatItem 'CTGroup d)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (ChatItem 'CTGroup d)
createMentions else SQLError -> IO (ChatItem 'CTGroup d)
forall e a. Exception e => e -> IO a
E.throwIO SQLError
e
  where
    deleteMentions :: IO ()
deleteMentions = Connection -> Query -> Only ChatItemId -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM chat_item_mentions WHERE chat_item_id = ?" (ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only (ChatItemId -> Only ChatItemId) -> ChatItemId -> Only ChatItemId
forall a b. (a -> b) -> a -> b
$ ChatItem 'CTGroup d -> ChatItemId
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> ChatItemId
chatItemId' ChatItem 'CTGroup d
ci)
    createMentions :: IO (ChatItem 'CTGroup d)
createMentions = Connection
-> GroupInfo
-> ChatItem 'CTGroup d
-> Map MemberName CIMention
-> IO (ChatItem 'CTGroup d)
forall (d :: MsgDirection).
Connection
-> GroupInfo
-> ChatItem 'CTGroup d
-> Map MemberName CIMention
-> IO (ChatItem 'CTGroup d)
createGroupCIMentions Connection
db GroupInfo
g ChatItem 'CTGroup d
ci Map MemberName CIMention
mentions'

deleteGroupChatItem :: DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup d -> IO ()
deleteGroupChatItem :: forall (d :: MsgDirection).
Connection -> User -> GroupInfo -> ChatItem 'CTGroup d -> IO ()
deleteGroupChatItem Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} g :: GroupInfo
g@GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} ChatItem 'CTGroup d
ci = do
  let itemId :: ChatItemId
itemId = ChatItem 'CTGroup d -> ChatItemId
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> ChatItemId
chatItemId' ChatItem 'CTGroup d
ci
  Connection -> ChatItemId -> IO ()
deleteChatItemMessages_ Connection
db ChatItemId
itemId
  Connection -> ChatItemId -> IO ()
deleteChatItemVersions_ Connection
db ChatItemId
itemId
  Connection -> GroupInfo -> ChatItem 'CTGroup d -> IO ()
forall (d :: MsgDirection).
Connection -> GroupInfo -> ChatItem 'CTGroup d -> IO ()
deleteGroupCIReactions_ Connection
db GroupInfo
g ChatItem 'CTGroup d
ci
  Connection
-> Query -> (ChatItemId, ChatItemId, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      DELETE FROM chat_items
      WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
    |]
    (ChatItemId
userId, ChatItemId
groupId, ChatItemId
itemId)

updateGroupChatItemModerated :: forall d. MsgDirectionI d => DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup d -> GroupMember -> UTCTime -> IO (ChatItem 'CTGroup d)
updateGroupChatItemModerated :: forall (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> User
-> GroupInfo
-> ChatItem 'CTGroup d
-> GroupMember
-> UTCTime
-> IO (ChatItem 'CTGroup d)
updateGroupChatItemModerated Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} ChatItem 'CTGroup d
ci m :: GroupMember
m@GroupMember {ChatItemId
groupMemberId :: GroupMember -> ChatItemId
groupMemberId :: ChatItemId
groupMemberId} UTCTime
deletedTs = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  let toContent :: CIContent d
toContent = SMsgDirection d -> CIContent d
forall (d :: MsgDirection). SMsgDirection d -> CIContent d
msgDirToModeratedContent_ (SMsgDirection d -> CIContent d) -> SMsgDirection d -> CIContent d
forall a b. (a -> b) -> a -> b
$ forall (d :: MsgDirection). MsgDirectionI d => SMsgDirection d
msgDirection @d
      toText :: MemberName
toText = MemberName
ciModeratedText
      itemId :: ChatItemId
itemId = ChatItem 'CTGroup d -> ChatItemId
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> ChatItemId
chatItemId' ChatItem 'CTGroup d
ci
  Connection -> ChatItemId -> IO ()
deleteChatItemMessages_ Connection
db ChatItemId
itemId
  Connection -> ChatItemId -> IO ()
deleteChatItemVersions_ Connection
db ChatItemId
itemId
  IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (UTCTime, ChatItemId, CIContent d, MemberName, UTCTime,
    ChatItemId, ChatItemId, ChatItemId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      [sql|
        UPDATE chat_items
        SET item_deleted = 1, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, item_content = ?, item_text = ?, updated_at = ?
        WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
      |]
      (UTCTime
deletedTs, ChatItemId
groupMemberId, CIContent d
toContent, MemberName
toText, UTCTime
currentTs, ChatItemId
userId, ChatItemId
groupId, ChatItemId
itemId)
  ChatItem 'CTGroup d -> IO (ChatItem 'CTGroup d)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatItem 'CTGroup d
ci {content = toContent, meta = (meta ci) {itemText = toText, itemDeleted = Just (CIModerated (Just deletedTs) m), editable = False, deletable = False}, formattedText = Nothing}

updateMemberCIsModerated :: MsgDirectionI d => DB.Connection -> User -> GroupInfo -> GroupMember -> GroupMember -> SMsgDirection d -> UTCTime -> IO ()
updateMemberCIsModerated :: forall (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> User
-> GroupInfo
-> GroupMember
-> GroupMember
-> SMsgDirection d
-> UTCTime
-> IO ()
updateMemberCIsModerated Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId, GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} GroupMember
member GroupMember
byGroupMember SMsgDirection d
md UTCTime
deletedTs = do
  [Only ChatItemId]
itemIds <- UTCTime -> IO [Only ChatItemId]
updateCIs (UTCTime -> IO [Only ChatItemId])
-> IO UTCTime -> IO [Only ChatItemId]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime
getCurrentTime
#if defined(dbPostgres)
  let inItemIds = Only $ In (map fromOnly itemIds)
  DB.execute db "DELETE FROM messages WHERE message_id IN (SELECT message_id FROM chat_item_messages WHERE chat_item_id IN ?)" inItemIds
  DB.execute db "DELETE FROM chat_item_versions WHERE chat_item_id IN ?" inItemIds
#else
  Connection -> Query -> [Only ChatItemId] -> IO ()
forall q. ToRow q => Connection -> Query -> [q] -> IO ()
DB.executeMany Connection
db Query
deleteChatItemMessagesQuery [Only ChatItemId]
itemIds
  Connection -> Query -> [Only ChatItemId] -> IO ()
forall q. ToRow q => Connection -> Query -> [q] -> IO ()
DB.executeMany Connection
db Query
"DELETE FROM chat_item_versions WHERE chat_item_id = ?" [Only ChatItemId]
itemIds
#endif
  where
    memId :: ChatItemId
memId = GroupMember -> ChatItemId
groupMemberId' GroupMember
member
    updateQuery :: Query
updateQuery =
      [sql|
        UPDATE chat_items
        SET item_deleted = 1, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, item_content = ?, item_text = ?, updated_at = ?
        WHERE user_id = ? AND group_id = ?
      |]
    updateCIs :: UTCTime -> IO [Only Int64]
    updateCIs :: UTCTime -> IO [Only ChatItemId]
updateCIs UTCTime
currentTs
      | ChatItemId
memId ChatItemId -> ChatItemId -> Bool
forall a. Eq a => a -> a -> Bool
== GroupMember -> ChatItemId
groupMemberId' GroupMember
membership =
          Connection
-> Query
-> ((UTCTime, ChatItemId, CIContent d, MemberName, UTCTime)
    :. (ChatItemId, ChatItemId))
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
            Connection
db
            (Query
updateQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND group_member_id IS NULL AND item_sent = 1 RETURNING chat_item_id")
            ((UTCTime, ChatItemId, CIContent d, MemberName, UTCTime)
columns (UTCTime, ChatItemId, CIContent d, MemberName, UTCTime)
-> (ChatItemId, ChatItemId)
-> (UTCTime, ChatItemId, CIContent d, MemberName, UTCTime)
   :. (ChatItemId, ChatItemId)
forall h t. h -> t -> h :. t
:. (ChatItemId
userId, ChatItemId
groupId))
      | Bool
otherwise =
          Connection
-> Query
-> ((UTCTime, ChatItemId, CIContent d, MemberName, UTCTime)
    :. (ChatItemId, ChatItemId, ChatItemId))
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
            Connection
db
            (Query
updateQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND group_member_id = ? RETURNING chat_item_id")
            ((UTCTime, ChatItemId, CIContent d, MemberName, UTCTime)
columns (UTCTime, ChatItemId, CIContent d, MemberName, UTCTime)
-> (ChatItemId, ChatItemId, ChatItemId)
-> (UTCTime, ChatItemId, CIContent d, MemberName, UTCTime)
   :. (ChatItemId, ChatItemId, ChatItemId)
forall h t. h -> t -> h :. t
:. (ChatItemId
userId, ChatItemId
groupId, ChatItemId
memId))
      where
        columns :: (UTCTime, ChatItemId, CIContent d, MemberName, UTCTime)
columns = (UTCTime
deletedTs, GroupMember -> ChatItemId
groupMemberId' GroupMember
byGroupMember, SMsgDirection d -> CIContent d
forall (d :: MsgDirection). SMsgDirection d -> CIContent d
msgDirToModeratedContent_ SMsgDirection d
md, MemberName
ciModeratedText, UTCTime
currentTs)

updateGroupCIBlockedByAdmin :: DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup d -> UTCTime -> IO (ChatItem 'CTGroup d)
updateGroupCIBlockedByAdmin :: forall (d :: MsgDirection).
Connection
-> User
-> GroupInfo
-> ChatItem 'CTGroup d
-> UTCTime
-> IO (ChatItem 'CTGroup d)
updateGroupCIBlockedByAdmin Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} ChatItem 'CTGroup d
ci UTCTime
deletedTs = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  let itemId :: ChatItemId
itemId = ChatItem 'CTGroup d -> ChatItemId
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> ChatItemId
chatItemId' ChatItem 'CTGroup d
ci
  Connection -> ChatItemId -> IO ()
deleteChatItemMessages_ Connection
db ChatItemId
itemId
  Connection -> ChatItemId -> IO ()
deleteChatItemVersions_ Connection
db ChatItemId
itemId
  IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (Int, UTCTime, UTCTime, ChatItemId, ChatItemId, ChatItemId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      [sql|
        UPDATE chat_items
        SET item_deleted = ?, item_deleted_ts = ?, updated_at = ?
        WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
      |]
      (Int
DBCIBlockedByAdmin, UTCTime
deletedTs, UTCTime
currentTs, ChatItemId
userId, ChatItemId
groupId, ChatItemId
itemId)
  ChatItem 'CTGroup d -> IO (ChatItem 'CTGroup d)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatItem 'CTGroup d -> IO (ChatItem 'CTGroup d))
-> ChatItem 'CTGroup d -> IO (ChatItem 'CTGroup d)
forall a b. (a -> b) -> a -> b
$ ChatItem 'CTGroup d
ci {meta = (meta ci) {itemDeleted = Just (CIBlockedByAdmin $ Just deletedTs), editable = False, deletable = False}, formattedText = Nothing}

pattern DBCINotDeleted :: Int
pattern $mDBCINotDeleted :: forall {r}. Int -> ((# #) -> r) -> ((# #) -> r) -> r
$bDBCINotDeleted :: Int
DBCINotDeleted = 0

pattern DBCIDeleted :: Int
pattern $mDBCIDeleted :: forall {r}. Int -> ((# #) -> r) -> ((# #) -> r) -> r
$bDBCIDeleted :: Int
DBCIDeleted = 1

pattern DBCIBlocked :: Int
pattern $mDBCIBlocked :: forall {r}. Int -> ((# #) -> r) -> ((# #) -> r) -> r
$bDBCIBlocked :: Int
DBCIBlocked = 2

pattern DBCIBlockedByAdmin :: Int
pattern $mDBCIBlockedByAdmin :: forall {r}. Int -> ((# #) -> r) -> ((# #) -> r) -> r
$bDBCIBlockedByAdmin :: Int
DBCIBlockedByAdmin = 3

markGroupChatItemDeleted :: DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup d -> Maybe GroupMember -> UTCTime -> IO (ChatItem 'CTGroup d)
markGroupChatItemDeleted :: forall (d :: MsgDirection).
Connection
-> User
-> GroupInfo
-> ChatItem 'CTGroup d
-> Maybe GroupMember
-> UTCTime
-> IO (ChatItem 'CTGroup d)
markGroupChatItemDeleted Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} ci :: ChatItem 'CTGroup d
ci@ChatItem {CIMeta 'CTGroup d
meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta :: CIMeta 'CTGroup d
meta} Maybe GroupMember
byGroupMember_ UTCTime
deletedTs = do
  UTCTime
currentTs <- IO UTCTime -> IO UTCTime
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  let itemId :: ChatItemId
itemId = ChatItem 'CTGroup d -> ChatItemId
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> ChatItemId
chatItemId' ChatItem 'CTGroup d
ci
      (Maybe ChatItemId
deletedByGroupMemberId, Maybe (CIDeleted 'CTGroup)
itemDeleted) = case Maybe GroupMember
byGroupMember_ of
        Just m :: GroupMember
m@GroupMember {ChatItemId
groupMemberId :: GroupMember -> ChatItemId
groupMemberId :: ChatItemId
groupMemberId} -> (ChatItemId -> Maybe ChatItemId
forall a. a -> Maybe a
Just ChatItemId
groupMemberId, CIDeleted 'CTGroup -> Maybe (CIDeleted 'CTGroup)
forall a. a -> Maybe a
Just (CIDeleted 'CTGroup -> Maybe (CIDeleted 'CTGroup))
-> CIDeleted 'CTGroup -> Maybe (CIDeleted 'CTGroup)
forall a b. (a -> b) -> a -> b
$ Maybe UTCTime -> GroupMember -> CIDeleted 'CTGroup
CIModerated (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
deletedTs) GroupMember
m)
        Maybe GroupMember
_ -> (Maybe ChatItemId
forall a. Maybe a
Nothing, CIDeleted 'CTGroup -> Maybe (CIDeleted 'CTGroup)
forall a. a -> Maybe a
Just (CIDeleted 'CTGroup -> Maybe (CIDeleted 'CTGroup))
-> CIDeleted 'CTGroup -> Maybe (CIDeleted 'CTGroup)
forall a b. (a -> b) -> a -> b
$ forall (c :: ChatType). Maybe UTCTime -> CIDeleted c
CIDeleted @'CTGroup (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
deletedTs))
  Connection
-> Query
-> (Int, UTCTime, Maybe ChatItemId, UTCTime, ChatItemId,
    ChatItemId, ChatItemId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE chat_items
      SET item_deleted = ?, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, updated_at = ?
      WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
    |]
    (Int
DBCIDeleted, UTCTime
deletedTs, Maybe ChatItemId
deletedByGroupMemberId, UTCTime
currentTs, ChatItemId
userId, ChatItemId
groupId, ChatItemId
itemId)
  ChatItem 'CTGroup d -> IO (ChatItem 'CTGroup d)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatItem 'CTGroup d
ci {meta = meta {itemDeleted, editable = False, deletable = False}}

markMemberCIsDeleted :: DB.Connection -> User -> GroupInfo -> GroupMember -> GroupMember -> UTCTime -> IO ()
markMemberCIsDeleted :: Connection
-> User
-> GroupInfo
-> GroupMember
-> GroupMember
-> UTCTime
-> IO ()
markMemberCIsDeleted Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId, GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} GroupMember
member GroupMember
byGroupMember UTCTime
deletedTs =
  UTCTime -> IO ()
updateCIs (UTCTime -> IO ()) -> IO UTCTime -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime
getCurrentTime
  where
    memId :: ChatItemId
memId = GroupMember -> ChatItemId
groupMemberId' GroupMember
member
    updateQuery :: Query
updateQuery =
      [sql|
        UPDATE chat_items
        SET item_deleted = ?, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, updated_at = ?
        WHERE user_id = ? AND group_id = ?
      |]
    updateCIs :: UTCTime -> IO ()
updateCIs UTCTime
currentTs
      | ChatItemId
memId ChatItemId -> ChatItemId -> Bool
forall a. Eq a => a -> a -> Bool
== GroupMember -> ChatItemId
groupMemberId' GroupMember
membership =
          Connection
-> Query
-> ((Int, UTCTime, ChatItemId, UTCTime)
    :. (ChatItemId, ChatItemId))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
            Connection
db
            (Query
updateQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND group_member_id IS NULL AND item_sent = 1")
            ((Int, UTCTime, ChatItemId, UTCTime)
columns (Int, UTCTime, ChatItemId, UTCTime)
-> (ChatItemId, ChatItemId)
-> (Int, UTCTime, ChatItemId, UTCTime) :. (ChatItemId, ChatItemId)
forall h t. h -> t -> h :. t
:. (ChatItemId
userId, ChatItemId
groupId))
      | Bool
otherwise =
          Connection
-> Query
-> ((Int, UTCTime, ChatItemId, UTCTime)
    :. (ChatItemId, ChatItemId, ChatItemId))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
            Connection
db
            (Query
updateQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" AND group_member_id = ?")
            ((Int, UTCTime, ChatItemId, UTCTime)
columns (Int, UTCTime, ChatItemId, UTCTime)
-> (ChatItemId, ChatItemId, ChatItemId)
-> (Int, UTCTime, ChatItemId, UTCTime)
   :. (ChatItemId, ChatItemId, ChatItemId)
forall h t. h -> t -> h :. t
:. (ChatItemId
userId, ChatItemId
groupId, ChatItemId
memId))
      where
        columns :: (Int, UTCTime, ChatItemId, UTCTime)
columns = (Int
DBCIDeleted, UTCTime
deletedTs, GroupMember -> ChatItemId
groupMemberId' GroupMember
byGroupMember, UTCTime
currentTs)

markGroupChatItemBlocked :: DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup 'MDRcv -> IO (ChatItem 'CTGroup 'MDRcv)
markGroupChatItemBlocked :: Connection
-> User
-> GroupInfo
-> ChatItem 'CTGroup 'MDRcv
-> IO (ChatItem 'CTGroup 'MDRcv)
markGroupChatItemBlocked Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} ci :: ChatItem 'CTGroup 'MDRcv
ci@ChatItem {CIMeta 'CTGroup 'MDRcv
meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta :: CIMeta 'CTGroup 'MDRcv
meta} = do
  UTCTime
deletedTs <- IO UTCTime
getCurrentTime
  Connection
-> Query
-> (Int, UTCTime, UTCTime, ChatItemId, ChatItemId, ChatItemId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE chat_items
      SET item_deleted = ?, item_deleted_ts = ?, updated_at = ?
      WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
    |]
    (Int
DBCIBlocked, UTCTime
deletedTs, UTCTime
deletedTs, ChatItemId
userId, ChatItemId
groupId, ChatItem 'CTGroup 'MDRcv -> ChatItemId
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> ChatItemId
chatItemId' ChatItem 'CTGroup 'MDRcv
ci)
  ChatItem 'CTGroup 'MDRcv -> IO (ChatItem 'CTGroup 'MDRcv)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatItem 'CTGroup 'MDRcv
ci {meta = meta {itemDeleted = Just $ CIBlocked $ Just deletedTs, editable = False, deletable = False}}

markGroupCIBlockedByAdmin :: DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup 'MDRcv -> IO (ChatItem 'CTGroup 'MDRcv)
markGroupCIBlockedByAdmin :: Connection
-> User
-> GroupInfo
-> ChatItem 'CTGroup 'MDRcv
-> IO (ChatItem 'CTGroup 'MDRcv)
markGroupCIBlockedByAdmin Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} ci :: ChatItem 'CTGroup 'MDRcv
ci@ChatItem {CIMeta 'CTGroup 'MDRcv
meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta :: CIMeta 'CTGroup 'MDRcv
meta} = do
  UTCTime
deletedTs <- IO UTCTime
getCurrentTime
  Connection
-> Query
-> (Int, UTCTime, UTCTime, ChatItemId, ChatItemId, ChatItemId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE chat_items
      SET item_deleted = ?, item_deleted_ts = ?, updated_at = ?
      WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
    |]
    (Int
DBCIBlockedByAdmin, UTCTime
deletedTs, UTCTime
deletedTs, ChatItemId
userId, ChatItemId
groupId, ChatItem 'CTGroup 'MDRcv -> ChatItemId
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> ChatItemId
chatItemId' ChatItem 'CTGroup 'MDRcv
ci)
  ChatItem 'CTGroup 'MDRcv -> IO (ChatItem 'CTGroup 'MDRcv)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatItem 'CTGroup 'MDRcv
ci {meta = meta {itemDeleted = Just $ CIBlockedByAdmin $ Just deletedTs, editable = False, deletable = False}}

markMessageReportsDeleted :: DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup d -> GroupMember -> UTCTime -> IO [ChatItemId]
markMessageReportsDeleted :: forall (d :: MsgDirection).
Connection
-> User
-> GroupInfo
-> ChatItem 'CTGroup d
-> GroupMember
-> UTCTime
-> IO [ChatItemId]
markMessageReportsDeleted Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {Maybe SharedMsgId
itemSharedMsgId :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe SharedMsgId
itemSharedMsgId :: Maybe SharedMsgId
itemSharedMsgId}} GroupMember {ChatItemId
groupMemberId :: GroupMember -> ChatItemId
groupMemberId :: ChatItemId
groupMemberId} UTCTime
deletedTs = do
  UTCTime
currentTs <- IO UTCTime -> IO UTCTime
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  (Only ChatItemId -> ChatItemId)
-> [Only ChatItemId] -> [ChatItemId]
forall a b. (a -> b) -> [a] -> [b]
map Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly
    ([Only ChatItemId] -> [ChatItemId])
-> IO [Only ChatItemId] -> IO [ChatItemId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (Int, UTCTime, ChatItemId, UTCTime, ChatItemId, ChatItemId,
    MsgContentTag, Maybe SharedMsgId, Int)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        UPDATE chat_items
        SET item_deleted = ?, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, updated_at = ?
        WHERE user_id = ? AND group_id = ? AND msg_content_tag = ? AND quoted_shared_msg_id = ? AND item_deleted = ?
        RETURNING chat_item_id;
      |]
      (Int
DBCIDeleted, UTCTime
deletedTs, ChatItemId
groupMemberId, UTCTime
currentTs, ChatItemId
userId, ChatItemId
groupId, MsgContentTag
MCReport_, Maybe SharedMsgId
itemSharedMsgId, Int
DBCINotDeleted)

markReceivedGroupReportsDeleted :: DB.Connection -> User -> GroupInfo -> UTCTime -> IO [ChatItemId]
markReceivedGroupReportsDeleted :: Connection -> User -> GroupInfo -> UTCTime -> IO [ChatItemId]
markReceivedGroupReportsDeleted Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId, GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} UTCTime
deletedTs = do
  UTCTime
currentTs <- IO UTCTime -> IO UTCTime
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  (Only ChatItemId -> ChatItemId)
-> [Only ChatItemId] -> [ChatItemId]
forall a b. (a -> b) -> [a] -> [b]
map Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly
    ([Only ChatItemId] -> [ChatItemId])
-> IO [Only ChatItemId] -> IO [ChatItemId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (Int, UTCTime, ChatItemId, UTCTime, ChatItemId, ChatItemId,
    MsgContentTag, Int)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        UPDATE chat_items
        SET item_deleted = ?, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, updated_at = ?
        WHERE user_id = ? AND group_id = ? AND msg_content_tag = ? AND item_deleted = ? AND item_sent = 0
        RETURNING chat_item_id
      |]
      (Int
DBCIDeleted, UTCTime
deletedTs, GroupMember -> ChatItemId
groupMemberId' GroupMember
membership, UTCTime
currentTs, ChatItemId
userId, ChatItemId
groupId, MsgContentTag
MCReport_, Int
DBCINotDeleted)

getGroupChatItemBySharedMsgId :: DB.Connection -> User -> GroupInfo -> GroupMemberId -> SharedMsgId -> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupChatItemBySharedMsgId :: Connection
-> User
-> GroupInfo
-> ChatItemId
-> SharedMsgId
-> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupChatItemBySharedMsgId Connection
db user :: User
user@User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} g :: GroupInfo
g@GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} ChatItemId
groupMemberId SharedMsgId
sharedMsgId = do
  ChatItemId
itemId <-
    IO (Either StoreError ChatItemId)
-> ExceptT StoreError IO ChatItemId
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError ChatItemId)
 -> ExceptT StoreError IO ChatItemId)
-> (IO [Only ChatItemId] -> IO (Either StoreError ChatItemId))
-> IO [Only ChatItemId]
-> ExceptT StoreError IO ChatItemId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only ChatItemId -> ChatItemId)
-> StoreError
-> IO [Only ChatItemId]
-> IO (Either StoreError ChatItemId)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly (SharedMsgId -> StoreError
SEChatItemSharedMsgIdNotFound SharedMsgId
sharedMsgId) (IO [Only ChatItemId] -> ExceptT StoreError IO ChatItemId)
-> IO [Only ChatItemId] -> ExceptT StoreError IO ChatItemId
forall a b. (a -> b) -> a -> b
$
      Connection
-> Query
-> (ChatItemId, ChatItemId, ChatItemId, SharedMsgId)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT chat_item_id
          FROM chat_items
          WHERE user_id = ? AND group_id = ? AND group_member_id = ? AND shared_msg_id = ?
          ORDER BY chat_item_id DESC
          LIMIT 1
        |]
        (ChatItemId
userId, ChatItemId
groupId, ChatItemId
groupMemberId, SharedMsgId
sharedMsgId)
  Connection
-> User
-> GroupInfo
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupCIWithReactions Connection
db User
user GroupInfo
g ChatItemId
itemId

getGroupMemberCIBySharedMsgId :: DB.Connection -> User -> GroupInfo -> MemberId -> SharedMsgId -> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupMemberCIBySharedMsgId :: Connection
-> User
-> GroupInfo
-> MemberId
-> SharedMsgId
-> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupMemberCIBySharedMsgId Connection
db user :: User
user@User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} g :: GroupInfo
g@GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} MemberId
memberId SharedMsgId
sharedMsgId = do
  ChatItemId
itemId <-
    IO (Either StoreError ChatItemId)
-> ExceptT StoreError IO ChatItemId
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError ChatItemId)
 -> ExceptT StoreError IO ChatItemId)
-> (IO [Only ChatItemId] -> IO (Either StoreError ChatItemId))
-> IO [Only ChatItemId]
-> ExceptT StoreError IO ChatItemId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only ChatItemId -> ChatItemId)
-> StoreError
-> IO [Only ChatItemId]
-> IO (Either StoreError ChatItemId)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly (SharedMsgId -> StoreError
SEChatItemSharedMsgIdNotFound SharedMsgId
sharedMsgId) (IO [Only ChatItemId] -> ExceptT StoreError IO ChatItemId)
-> IO [Only ChatItemId] -> ExceptT StoreError IO ChatItemId
forall a b. (a -> b) -> a -> b
$
      Connection
-> Query
-> (GroupMemberCategory, ChatItemId, ChatItemId, MemberId,
    SharedMsgId)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT i.chat_item_id
          FROM chat_items i
          JOIN group_members m ON m.group_id = i.group_id
                              AND ((i.group_member_id IS NULL AND m.member_category = ?)
                                  OR i.group_member_id = m.group_member_id)
          WHERE i.user_id = ? AND i.group_id = ? AND m.member_id = ? AND i.shared_msg_id = ?
          ORDER BY i.chat_item_id DESC
          LIMIT 1
        |]
        (GroupMemberCategory
GCUserMember, ChatItemId
userId, ChatItemId
groupId, MemberId
memberId, SharedMsgId
sharedMsgId)
  Connection
-> User
-> GroupInfo
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupCIWithReactions Connection
db User
user GroupInfo
g ChatItemId
itemId

getGroupChatItemsByAgentMsgId :: DB.Connection -> User -> GroupId -> Int64 -> AgentMsgId -> IO [CChatItem 'CTGroup]
getGroupChatItemsByAgentMsgId :: Connection
-> User
-> ChatItemId
-> ChatItemId
-> ChatItemId
-> IO [CChatItem 'CTGroup]
getGroupChatItemsByAgentMsgId Connection
db User
user ChatItemId
groupId ChatItemId
connId ChatItemId
msgId = do
  [ChatItemId]
itemIds <- Connection -> ChatItemId -> ChatItemId -> IO [ChatItemId]
getChatItemIdsByAgentMsgId Connection
db ChatItemId
connId ChatItemId
msgId
  [Maybe (CChatItem 'CTGroup)] -> [CChatItem 'CTGroup]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (CChatItem 'CTGroup)] -> [CChatItem 'CTGroup])
-> IO [Maybe (CChatItem 'CTGroup)] -> IO [CChatItem 'CTGroup]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ChatItemId -> IO (Maybe (CChatItem 'CTGroup)))
-> [ChatItemId] -> IO [Maybe (CChatItem 'CTGroup)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Either StoreError (CChatItem 'CTGroup)
 -> Maybe (CChatItem 'CTGroup))
-> IO (Either StoreError (CChatItem 'CTGroup))
-> IO (Maybe (CChatItem 'CTGroup))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either StoreError (CChatItem 'CTGroup)
-> Maybe (CChatItem 'CTGroup)
forall a b. Either a b -> Maybe b
eitherToMaybe (IO (Either StoreError (CChatItem 'CTGroup))
 -> IO (Maybe (CChatItem 'CTGroup)))
-> (ChatItemId -> IO (Either StoreError (CChatItem 'CTGroup)))
-> ChatItemId
-> IO (Maybe (CChatItem 'CTGroup))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT StoreError IO (CChatItem 'CTGroup)
-> IO (Either StoreError (CChatItem 'CTGroup))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO (CChatItem 'CTGroup)
 -> IO (Either StoreError (CChatItem 'CTGroup)))
-> (ChatItemId -> ExceptT StoreError IO (CChatItem 'CTGroup))
-> ChatItemId
-> IO (Either StoreError (CChatItem 'CTGroup))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupChatItem Connection
db User
user ChatItemId
groupId) [ChatItemId]
itemIds

getGroupChatItem :: DB.Connection -> User -> Int64 -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupChatItem :: Connection
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupChatItem Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId, ChatItemId
userContactId :: User -> ChatItemId
userContactId :: ChatItemId
userContactId} ChatItemId
groupId ChatItemId
itemId = IO (Either StoreError (CChatItem 'CTGroup))
-> ExceptT StoreError IO (CChatItem 'CTGroup)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (CChatItem 'CTGroup))
 -> ExceptT StoreError IO (CChatItem 'CTGroup))
-> IO (Either StoreError (CChatItem 'CTGroup))
-> ExceptT StoreError IO (CChatItem 'CTGroup)
forall a b. (a -> b) -> a -> b
$ do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  ((ChatItemRow
  :. ((Maybe ChatItemId, BoolInt)
      :. (MaybeGroupMemberRow
          :. (GroupQuoteRow :. MaybeGroupMemberRow))))
 -> Either StoreError (CChatItem 'CTGroup))
-> StoreError
-> IO
     [ChatItemRow
      :. ((Maybe ChatItemId, BoolInt)
          :. (MaybeGroupMemberRow
              :. (GroupQuoteRow :. MaybeGroupMemberRow)))]
-> IO (Either StoreError (CChatItem 'CTGroup))
forall a e b. (a -> Either e b) -> e -> IO [a] -> IO (Either e b)
firstRow' (UTCTime
-> ChatItemId
-> (ChatItemRow
    :. ((Maybe ChatItemId, BoolInt)
        :. (MaybeGroupMemberRow
            :. (GroupQuoteRow :. MaybeGroupMemberRow))))
-> Either StoreError (CChatItem 'CTGroup)
toGroupChatItem UTCTime
currentTs ChatItemId
userContactId) (ChatItemId -> StoreError
SEChatItemNotFound ChatItemId
itemId) IO
  [ChatItemRow
   :. ((Maybe ChatItemId, BoolInt)
       :. (MaybeGroupMemberRow
           :. (GroupQuoteRow :. MaybeGroupMemberRow)))]
getItem
  where
    getItem :: IO
  [ChatItemRow
   :. ((Maybe ChatItemId, BoolInt)
       :. (MaybeGroupMemberRow
           :. (GroupQuoteRow :. MaybeGroupMemberRow)))]
getItem =
      Connection
-> Query
-> (ChatItemId, ChatItemId, ChatItemId)
-> IO
     [ChatItemRow
      :. ((Maybe ChatItemId, BoolInt)
          :. (MaybeGroupMemberRow
              :. (GroupQuoteRow :. MaybeGroupMemberRow)))]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT
            -- ChatItem
            i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.via_proxy, i.shared_msg_id,
            i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at,
            i.fwd_from_tag, i.fwd_from_chat_name, i.fwd_from_msg_dir, i.fwd_from_contact_id, i.fwd_from_group_id, i.fwd_from_chat_item_id,
            i.timed_ttl, i.timed_delete_at, i.item_live, i.user_mention,
            -- CIFile
            f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
            -- CIMeta forwardedByMember, showGroupAsSender
            i.forwarded_by_group_member_id, i.show_group_as_sender,
            -- GroupMember
            m.group_member_id, m.group_id, m.index_in_group, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
            m.member_status, m.show_messages, m.member_restriction, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
            p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
            m.created_at, m.updated_at,
            m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts,
            -- quoted ChatItem
            ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
            -- quoted GroupMember
            rm.group_member_id, rm.group_id, rm.index_in_group, rm.member_id, rm.peer_chat_min_version, rm.peer_chat_max_version, rm.member_role, rm.member_category,
            rm.member_status, rm.show_messages, rm.member_restriction, rm.invited_by, rm.invited_by_group_member_id, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
            rp.display_name, rp.full_name, rp.short_descr, rp.image, rp.contact_link, rp.chat_peer_type, rp.local_alias, rp.preferences,
            rm.created_at, rm.updated_at,
            rm.support_chat_ts, rm.support_chat_items_unread, rm.support_chat_items_member_attention, rm.support_chat_items_mentions, rm.support_chat_last_msg_from_member_ts,
            -- deleted by GroupMember
            dbm.group_member_id, dbm.group_id, dbm.index_in_group, dbm.member_id, dbm.peer_chat_min_version, dbm.peer_chat_max_version, dbm.member_role, dbm.member_category,
            dbm.member_status, dbm.show_messages, dbm.member_restriction, dbm.invited_by, dbm.invited_by_group_member_id, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
            dbp.display_name, dbp.full_name, dbp.short_descr, dbp.image, dbp.contact_link, dbp.chat_peer_type, dbp.local_alias, dbp.preferences,
            dbm.created_at, dbm.updated_at,
            dbm.support_chat_ts, dbm.support_chat_items_unread, dbm.support_chat_items_member_attention, dbm.support_chat_items_mentions, dbm.support_chat_last_msg_from_member_ts
          FROM chat_items i
          LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
          LEFT JOIN group_members gsm ON gsm.group_member_id = i.group_scope_group_member_id
          LEFT JOIN contact_profiles gsp ON gsp.contact_profile_id = COALESCE(gsm.member_profile_id, gsm.contact_profile_id)
          LEFT JOIN group_members m ON m.group_member_id = i.group_member_id
          LEFT JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
          LEFT JOIN chat_items ri ON ri.shared_msg_id = i.quoted_shared_msg_id AND ri.group_id = i.group_id
          LEFT JOIN group_members rm ON rm.group_member_id = ri.group_member_id
          LEFT JOIN contact_profiles rp ON rp.contact_profile_id = COALESCE(rm.member_profile_id, rm.contact_profile_id)
          LEFT JOIN group_members dbm ON dbm.group_member_id = i.item_deleted_by_group_member_id
          LEFT JOIN contact_profiles dbp ON dbp.contact_profile_id = COALESCE(dbm.member_profile_id, dbm.contact_profile_id)
          WHERE i.user_id = ? AND i.group_id = ? AND i.chat_item_id = ?
        |]
        (ChatItemId
userId, ChatItemId
groupId, ChatItemId
itemId)

getGroupChatItemIdByText :: DB.Connection -> User -> GroupId -> Maybe ContactName -> Text -> ExceptT StoreError IO ChatItemId
getGroupChatItemIdByText :: Connection
-> User
-> ChatItemId
-> Maybe MemberName
-> MemberName
-> ExceptT StoreError IO ChatItemId
getGroupChatItemIdByText Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId, localDisplayName :: User -> MemberName
localDisplayName = MemberName
userName} ChatItemId
groupId Maybe MemberName
contactName_ MemberName
quotedMsg =
  IO (Either StoreError ChatItemId)
-> ExceptT StoreError IO ChatItemId
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError ChatItemId)
 -> ExceptT StoreError IO ChatItemId)
-> (IO [Only ChatItemId] -> IO (Either StoreError ChatItemId))
-> IO [Only ChatItemId]
-> ExceptT StoreError IO ChatItemId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only ChatItemId -> ChatItemId)
-> StoreError
-> IO [Only ChatItemId]
-> IO (Either StoreError ChatItemId)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly (MemberName -> StoreError
SEChatItemNotFoundByText MemberName
quotedMsg) (IO [Only ChatItemId] -> ExceptT StoreError IO ChatItemId)
-> IO [Only ChatItemId] -> ExceptT StoreError IO ChatItemId
forall a b. (a -> b) -> a -> b
$ case Maybe MemberName
contactName_ of
    Maybe MemberName
Nothing -> IO [Only ChatItemId]
anyMemberChatItem_
    Just MemberName
cName
      | MemberName
userName MemberName -> MemberName -> Bool
forall a. Eq a => a -> a -> Bool
== MemberName
cName -> IO [Only ChatItemId]
userChatItem_
      | Bool
otherwise -> MemberName -> IO [Only ChatItemId]
memberChatItem_ MemberName
cName
  where
    anyMemberChatItem_ :: IO [Only ChatItemId]
anyMemberChatItem_ =
      Connection
-> Query
-> (ChatItemId, ChatItemId, MemberName)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT chat_item_id
          FROM chat_items
          WHERE user_id = ? AND group_id = ? AND item_text like ?
          ORDER BY chat_item_id DESC
          LIMIT 1
        |]
        (ChatItemId
userId, ChatItemId
groupId, MemberName
quotedMsg MemberName -> MemberName -> MemberName
forall a. Semigroup a => a -> a -> a
<> MemberName
"%")
    userChatItem_ :: IO [Only ChatItemId]
userChatItem_ =
      Connection
-> Query
-> (ChatItemId, ChatItemId, MemberName)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT chat_item_id
          FROM chat_items
          WHERE user_id = ? AND group_id = ? AND group_member_id IS NULL AND item_text like ?
          ORDER BY chat_item_id DESC
          LIMIT 1
        |]
        (ChatItemId
userId, ChatItemId
groupId, MemberName
quotedMsg MemberName -> MemberName -> MemberName
forall a. Semigroup a => a -> a -> a
<> MemberName
"%")
    memberChatItem_ :: MemberName -> IO [Only ChatItemId]
memberChatItem_ MemberName
cName =
      Connection
-> Query
-> (ChatItemId, ChatItemId, MemberName, MemberName)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT i.chat_item_id
          FROM chat_items i
          JOIN group_members m ON m.group_member_id = i.group_member_id
          WHERE i.user_id = ? AND i.group_id = ? AND m.local_display_name = ? AND i.item_text like ?
          ORDER BY i.chat_item_id DESC
          LIMIT 1
        |]
        (ChatItemId
userId, ChatItemId
groupId, MemberName
cName, MemberName
quotedMsg MemberName -> MemberName -> MemberName
forall a. Semigroup a => a -> a -> a
<> MemberName
"%")

getGroupChatItemIdByText' :: DB.Connection -> User -> GroupId -> Text -> ExceptT StoreError IO ChatItemId
getGroupChatItemIdByText' :: Connection
-> User
-> ChatItemId
-> MemberName
-> ExceptT StoreError IO ChatItemId
getGroupChatItemIdByText' Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
groupId MemberName
msg =
  IO (Either StoreError ChatItemId)
-> ExceptT StoreError IO ChatItemId
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError ChatItemId)
 -> ExceptT StoreError IO ChatItemId)
-> (IO [Only ChatItemId] -> IO (Either StoreError ChatItemId))
-> IO [Only ChatItemId]
-> ExceptT StoreError IO ChatItemId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only ChatItemId -> ChatItemId)
-> StoreError
-> IO [Only ChatItemId]
-> IO (Either StoreError ChatItemId)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly (MemberName -> StoreError
SEChatItemNotFoundByText MemberName
msg) (IO [Only ChatItemId] -> ExceptT StoreError IO ChatItemId)
-> IO [Only ChatItemId] -> ExceptT StoreError IO ChatItemId
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (ChatItemId, ChatItemId, MemberName)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT chat_item_id
        FROM chat_items
        WHERE user_id = ? AND group_id = ? AND item_text like ?
        ORDER BY chat_item_id DESC
        LIMIT 1
      |]
      (ChatItemId
userId, ChatItemId
groupId, MemberName
msg MemberName -> MemberName -> MemberName
forall a. Semigroup a => a -> a -> a
<> MemberName
"%")

getLocalChatItem :: DB.Connection -> User -> Int64 -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTLocal)
getLocalChatItem :: Connection
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTLocal)
getLocalChatItem Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
folderId ChatItemId
itemId = IO (Either StoreError (CChatItem 'CTLocal))
-> ExceptT StoreError IO (CChatItem 'CTLocal)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (CChatItem 'CTLocal))
 -> ExceptT StoreError IO (CChatItem 'CTLocal))
-> IO (Either StoreError (CChatItem 'CTLocal))
-> ExceptT StoreError IO (CChatItem 'CTLocal)
forall a b. (a -> b) -> a -> b
$ do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  (ChatItemRow -> Either StoreError (CChatItem 'CTLocal))
-> StoreError
-> IO [ChatItemRow]
-> IO (Either StoreError (CChatItem 'CTLocal))
forall a e b. (a -> Either e b) -> e -> IO [a] -> IO (Either e b)
firstRow' (UTCTime -> ChatItemRow -> Either StoreError (CChatItem 'CTLocal)
toLocalChatItem UTCTime
currentTs) (ChatItemId -> StoreError
SEChatItemNotFound ChatItemId
itemId) IO [ChatItemRow]
getItem
  where
    getItem :: IO [ChatItemRow]
getItem =
      Connection
-> Query
-> (ChatItemId, ChatItemId, ChatItemId)
-> IO [ChatItemRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT
            -- ChatItem
            i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.via_proxy, i.shared_msg_id,
            i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at,
            i.fwd_from_tag, i.fwd_from_chat_name, i.fwd_from_msg_dir, i.fwd_from_contact_id, i.fwd_from_group_id, i.fwd_from_chat_item_id,
            i.timed_ttl, i.timed_delete_at, i.item_live, i.user_mention,
            -- CIFile
            f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol
          FROM chat_items i
          LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
          WHERE i.user_id = ? AND i.note_folder_id = ? AND i.chat_item_id = ?
        |]
        (ChatItemId
userId, ChatItemId
folderId, ChatItemId
itemId)

getLocalChatItemIdByText :: DB.Connection -> User -> NoteFolderId -> SMsgDirection d -> Text -> ExceptT StoreError IO ChatItemId
getLocalChatItemIdByText :: forall (d :: MsgDirection).
Connection
-> User
-> ChatItemId
-> SMsgDirection d
-> MemberName
-> ExceptT StoreError IO ChatItemId
getLocalChatItemIdByText Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
noteFolderId SMsgDirection d
msgDir MemberName
quotedMsg =
  IO (Either StoreError ChatItemId)
-> ExceptT StoreError IO ChatItemId
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError ChatItemId)
 -> ExceptT StoreError IO ChatItemId)
-> (IO [Only ChatItemId] -> IO (Either StoreError ChatItemId))
-> IO [Only ChatItemId]
-> ExceptT StoreError IO ChatItemId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only ChatItemId -> ChatItemId)
-> StoreError
-> IO [Only ChatItemId]
-> IO (Either StoreError ChatItemId)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly (MemberName -> StoreError
SEChatItemNotFoundByText MemberName
quotedMsg) (IO [Only ChatItemId] -> ExceptT StoreError IO ChatItemId)
-> IO [Only ChatItemId] -> ExceptT StoreError IO ChatItemId
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (ChatItemId, ChatItemId, SMsgDirection d, MemberName)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT chat_item_id
        FROM chat_items
        WHERE user_id = ? AND note_folder_id = ? AND item_sent = ? AND item_text LIKE ?
        ORDER BY chat_item_id DESC
        LIMIT 1
      |]
      (ChatItemId
userId, ChatItemId
noteFolderId, SMsgDirection d
msgDir, MemberName
quotedMsg MemberName -> MemberName -> MemberName
forall a. Semigroup a => a -> a -> a
<> MemberName
"%")

getLocalChatItemIdByText' :: DB.Connection -> User -> NoteFolderId -> Text -> ExceptT StoreError IO ChatItemId
getLocalChatItemIdByText' :: Connection
-> User
-> ChatItemId
-> MemberName
-> ExceptT StoreError IO ChatItemId
getLocalChatItemIdByText' Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
noteFolderId MemberName
msg =
  IO (Either StoreError ChatItemId)
-> ExceptT StoreError IO ChatItemId
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError ChatItemId)
 -> ExceptT StoreError IO ChatItemId)
-> (IO [Only ChatItemId] -> IO (Either StoreError ChatItemId))
-> IO [Only ChatItemId]
-> ExceptT StoreError IO ChatItemId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only ChatItemId -> ChatItemId)
-> StoreError
-> IO [Only ChatItemId]
-> IO (Either StoreError ChatItemId)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly (MemberName -> StoreError
SEChatItemNotFoundByText MemberName
msg) (IO [Only ChatItemId] -> ExceptT StoreError IO ChatItemId)
-> IO [Only ChatItemId] -> ExceptT StoreError IO ChatItemId
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (ChatItemId, ChatItemId, MemberName)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT chat_item_id
        FROM chat_items
        WHERE user_id = ? AND note_folder_id = ? AND item_text LIKE ?
        ORDER BY chat_item_id DESC
        LIMIT 1
      |]
      (ChatItemId
userId, ChatItemId
noteFolderId, MemberName
msg MemberName -> MemberName -> MemberName
forall a. Semigroup a => a -> a -> a
<> MemberName
"%")

updateLocalChatItem' :: forall d. MsgDirectionI d => DB.Connection -> User -> NoteFolderId -> ChatItem 'CTLocal d -> CIContent d -> Bool -> IO (ChatItem 'CTLocal d)
updateLocalChatItem' :: forall (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> User
-> ChatItemId
-> ChatItem 'CTLocal d
-> CIContent d
-> Bool
-> IO (ChatItem 'CTLocal d)
updateLocalChatItem' Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
noteFolderId ChatItem 'CTLocal d
ci CIContent d
newContent Bool
edited = do
  UTCTime
currentTs <- IO UTCTime -> IO UTCTime
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  let ci' :: ChatItem 'CTLocal d
ci' = ChatItem 'CTLocal d
-> CIContent d
-> Bool
-> Bool
-> Maybe CITimed
-> UTCTime
-> ChatItem 'CTLocal d
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d
-> CIContent d
-> Bool
-> Bool
-> Maybe CITimed
-> UTCTime
-> ChatItem c d
updatedChatItem ChatItem 'CTLocal d
ci CIContent d
newContent Bool
edited Bool
False Maybe CITimed
forall a. Maybe a
Nothing UTCTime
currentTs
  IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> ChatItemId -> ChatItemId -> ChatItem 'CTLocal d -> IO ()
forall (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> ChatItemId -> ChatItemId -> ChatItem 'CTLocal d -> IO ()
updateLocalChatItem_ Connection
db ChatItemId
userId ChatItemId
noteFolderId ChatItem 'CTLocal d
ci'
  ChatItem 'CTLocal d -> IO (ChatItem 'CTLocal d)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatItem 'CTLocal d
ci'

-- this function assumes that local item with correct chat direction already exists,
-- it should be checked before calling it
updateLocalChatItem_ :: forall d. MsgDirectionI d => DB.Connection -> UserId -> NoteFolderId -> ChatItem 'CTLocal d -> IO ()
updateLocalChatItem_ :: forall (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> ChatItemId -> ChatItemId -> ChatItem 'CTLocal d -> IO ()
updateLocalChatItem_ Connection
db ChatItemId
userId ChatItemId
noteFolderId ChatItem {CIMeta 'CTLocal d
meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta :: CIMeta 'CTLocal d
meta, CIContent d
content :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIContent d
content :: CIContent d
content} = do
  let CIMeta {ChatItemId
itemId :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> ChatItemId
itemId :: ChatItemId
itemId, MemberName
itemText :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> MemberName
itemText :: MemberName
itemText, CIStatus d
itemStatus :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> CIStatus d
itemStatus :: CIStatus d
itemStatus, Maybe (CIDeleted 'CTLocal)
itemDeleted :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe (CIDeleted c)
itemDeleted :: Maybe (CIDeleted 'CTLocal)
itemDeleted, Bool
itemEdited :: forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> Bool
itemEdited :: Bool
itemEdited, UTCTime
updatedAt :: forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> UTCTime
updatedAt :: UTCTime
updatedAt} = CIMeta 'CTLocal d
meta
      itemDeleted' :: Bool
itemDeleted' = Maybe (CIDeleted 'CTLocal) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (CIDeleted 'CTLocal)
itemDeleted
      itemDeletedTs' :: Maybe UTCTime
itemDeletedTs' = CIDeleted 'CTLocal -> Maybe UTCTime
forall (d :: ChatType). CIDeleted d -> Maybe UTCTime
itemDeletedTs (CIDeleted 'CTLocal -> Maybe UTCTime)
-> Maybe (CIDeleted 'CTLocal) -> Maybe UTCTime
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (CIDeleted 'CTLocal)
itemDeleted
  Connection
-> Query
-> ((CIContent d, MemberName, CIStatus d, BoolInt, Maybe UTCTime,
     BoolInt, UTCTime)
    :. (ChatItemId, ChatItemId, ChatItemId))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE chat_items
      SET item_content = ?, item_text = ?, item_status = ?, item_deleted = ?, item_deleted_ts = ?, item_edited = ?, updated_at = ?
      WHERE user_id = ? AND note_folder_id = ? AND chat_item_id = ?
    |]
    ((CIContent d
content, MemberName
itemText, CIStatus d
itemStatus, Bool -> BoolInt
BI Bool
itemDeleted', Maybe UTCTime
itemDeletedTs', Bool -> BoolInt
BI Bool
itemEdited, UTCTime
updatedAt) (CIContent d, MemberName, CIStatus d, BoolInt, Maybe UTCTime,
 BoolInt, UTCTime)
-> (ChatItemId, ChatItemId, ChatItemId)
-> (CIContent d, MemberName, CIStatus d, BoolInt, Maybe UTCTime,
    BoolInt, UTCTime)
   :. (ChatItemId, ChatItemId, ChatItemId)
forall h t. h -> t -> h :. t
:. (ChatItemId
userId, ChatItemId
noteFolderId, ChatItemId
itemId))

deleteLocalChatItem :: DB.Connection -> User -> NoteFolder -> ChatItem 'CTLocal d -> IO ()
deleteLocalChatItem :: forall (d :: MsgDirection).
Connection -> User -> NoteFolder -> ChatItem 'CTLocal d -> IO ()
deleteLocalChatItem Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} NoteFolder {ChatItemId
noteFolderId :: NoteFolder -> ChatItemId
noteFolderId :: ChatItemId
noteFolderId} ChatItem 'CTLocal d
ci = do
  let itemId :: ChatItemId
itemId = ChatItem 'CTLocal d -> ChatItemId
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> ChatItemId
chatItemId' ChatItem 'CTLocal d
ci
  Connection -> ChatItemId -> IO ()
deleteChatItemVersions_ Connection
db ChatItemId
itemId
  Connection
-> Query -> (ChatItemId, ChatItemId, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      DELETE FROM chat_items
      WHERE user_id = ? AND note_folder_id = ? AND chat_item_id = ?
    |]
    (ChatItemId
userId, ChatItemId
noteFolderId, ChatItemId
itemId)

getChatItemByFileId :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO AChatItem
getChatItemByFileId :: Connection
-> VersionRangeChat
-> User
-> ChatItemId
-> ExceptT StoreError IO AChatItem
getChatItemByFileId Connection
db VersionRangeChat
vr user :: User
user@User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
fileId = do
  (ChatRef
chatRef, ChatItemId
itemId) <-
    IO (Either StoreError (ChatRef, ChatItemId))
-> ExceptT StoreError IO (ChatRef, ChatItemId)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (ChatRef, ChatItemId))
 -> ExceptT StoreError IO (ChatRef, ChatItemId))
-> (IO
      [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
        Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
    -> IO (Either StoreError (ChatRef, ChatItemId)))
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> ExceptT StoreError IO (ChatRef, ChatItemId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
  Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)
 -> Either StoreError (ChatRef, ChatItemId))
-> StoreError
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> IO (Either StoreError (ChatRef, ChatItemId))
forall a e b. (a -> Either e b) -> e -> IO [a] -> IO (Either e b)
firstRow' (ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
 Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)
-> Either StoreError (ChatRef, ChatItemId)
toChatItemRef (ChatItemId -> StoreError
SEChatItemNotFoundByFileId ChatItemId
fileId) (IO
   [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
     Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
 -> ExceptT StoreError IO (ChatRef, ChatItemId))
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> ExceptT StoreError IO (ChatRef, ChatItemId)
forall a b. (a -> b) -> a -> b
$
      Connection
-> Query
-> (ChatItemId, ChatItemId)
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
            SELECT i.chat_item_id, i.contact_id, i.group_id, i.group_scope_tag, i.group_scope_group_member_id, i.note_folder_id
            FROM chat_items i
            JOIN files f ON f.chat_item_id = i.chat_item_id
            WHERE f.user_id = ? AND f.file_id = ?
            LIMIT 1
          |]
        (ChatItemId
userId, ChatItemId
fileId)
  Connection
-> VersionRangeChat
-> User
-> ChatRef
-> ChatItemId
-> ExceptT StoreError IO AChatItem
getAChatItem Connection
db VersionRangeChat
vr User
user ChatRef
chatRef ChatItemId
itemId

lookupChatItemByFileId :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO (Maybe AChatItem)
lookupChatItemByFileId :: Connection
-> VersionRangeChat
-> User
-> ChatItemId
-> ExceptT StoreError IO (Maybe AChatItem)
lookupChatItemByFileId Connection
db VersionRangeChat
vr User
user ChatItemId
fileId = do
  (AChatItem -> Maybe AChatItem)
-> ExceptT StoreError IO AChatItem
-> ExceptT StoreError IO (Maybe AChatItem)
forall a b.
(a -> b) -> ExceptT StoreError IO a -> ExceptT StoreError IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AChatItem -> Maybe AChatItem
forall a. a -> Maybe a
Just (Connection
-> VersionRangeChat
-> User
-> ChatItemId
-> ExceptT StoreError IO AChatItem
getChatItemByFileId Connection
db VersionRangeChat
vr User
user ChatItemId
fileId) ExceptT StoreError IO (Maybe AChatItem)
-> (StoreError -> ExceptT StoreError IO (Maybe AChatItem))
-> ExceptT StoreError IO (Maybe AChatItem)
forall a.
ExceptT StoreError IO a
-> (StoreError -> ExceptT StoreError IO a)
-> ExceptT StoreError IO a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \case
    SEChatItemNotFoundByFileId {} -> Maybe AChatItem -> ExceptT StoreError IO (Maybe AChatItem)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe AChatItem
forall a. Maybe a
Nothing
    StoreError
e -> StoreError -> ExceptT StoreError IO (Maybe AChatItem)
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError StoreError
e

getChatItemByGroupId :: DB.Connection -> VersionRangeChat -> User -> GroupId -> ExceptT StoreError IO AChatItem
getChatItemByGroupId :: Connection
-> VersionRangeChat
-> User
-> ChatItemId
-> ExceptT StoreError IO AChatItem
getChatItemByGroupId Connection
db VersionRangeChat
vr user :: User
user@User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
groupId = do
  (ChatRef
chatRef, ChatItemId
itemId) <-
    IO (Either StoreError (ChatRef, ChatItemId))
-> ExceptT StoreError IO (ChatRef, ChatItemId)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (ChatRef, ChatItemId))
 -> ExceptT StoreError IO (ChatRef, ChatItemId))
-> (IO
      [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
        Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
    -> IO (Either StoreError (ChatRef, ChatItemId)))
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> ExceptT StoreError IO (ChatRef, ChatItemId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
  Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)
 -> Either StoreError (ChatRef, ChatItemId))
-> StoreError
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> IO (Either StoreError (ChatRef, ChatItemId))
forall a e b. (a -> Either e b) -> e -> IO [a] -> IO (Either e b)
firstRow' (ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
 Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)
-> Either StoreError (ChatRef, ChatItemId)
toChatItemRef (ChatItemId -> StoreError
SEChatItemNotFoundByGroupId ChatItemId
groupId) (IO
   [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
     Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
 -> ExceptT StoreError IO (ChatRef, ChatItemId))
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
-> ExceptT StoreError IO (ChatRef, ChatItemId)
forall a b. (a -> b) -> a -> b
$
      Connection
-> Query
-> (ChatItemId, ChatItemId)
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, Maybe ChatItemId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT i.chat_item_id, i.contact_id, i.group_id, i.group_scope_tag, i.group_scope_group_member_id, i.note_folder_id
          FROM chat_items i
          JOIN groups g ON g.chat_item_id = i.chat_item_id
          WHERE g.user_id = ? AND g.group_id = ?
          LIMIT 1
        |]
        (ChatItemId
userId, ChatItemId
groupId)
  Connection
-> VersionRangeChat
-> User
-> ChatRef
-> ChatItemId
-> ExceptT StoreError IO AChatItem
getAChatItem Connection
db VersionRangeChat
vr User
user ChatRef
chatRef ChatItemId
itemId

getChatRefViaItemId :: DB.Connection -> User -> ChatItemId -> ExceptT StoreError IO ChatRef
getChatRefViaItemId :: Connection -> User -> ChatItemId -> ExceptT StoreError IO ChatRef
getChatRefViaItemId Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
itemId = do
  IO (Either StoreError ChatRef) -> ExceptT StoreError IO ChatRef
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError ChatRef) -> ExceptT StoreError IO ChatRef)
-> (IO [(Maybe ChatItemId, Maybe ChatItemId)]
    -> IO (Either StoreError ChatRef))
-> IO [(Maybe ChatItemId, Maybe ChatItemId)]
-> ExceptT StoreError IO ChatRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe ChatItemId, Maybe ChatItemId) -> Either StoreError ChatRef)
-> StoreError
-> IO [(Maybe ChatItemId, Maybe ChatItemId)]
-> IO (Either StoreError ChatRef)
forall a e b. (a -> Either e b) -> e -> IO [a] -> IO (Either e b)
firstRow' (Maybe ChatItemId, Maybe ChatItemId) -> Either StoreError ChatRef
toChatRef (ChatItemId -> StoreError
SEChatItemNotFound ChatItemId
itemId) (IO [(Maybe ChatItemId, Maybe ChatItemId)]
 -> ExceptT StoreError IO ChatRef)
-> IO [(Maybe ChatItemId, Maybe ChatItemId)]
-> ExceptT StoreError IO ChatRef
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (ChatItemId, ChatItemId)
-> IO [(Maybe ChatItemId, Maybe ChatItemId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT contact_id, group_id FROM chat_items WHERE user_id = ? AND chat_item_id = ?" (ChatItemId
userId, ChatItemId
itemId)
  where
    toChatRef :: (Maybe ChatItemId, Maybe ChatItemId) -> Either StoreError ChatRef
toChatRef = \case
      (Just ChatItemId
contactId, Maybe ChatItemId
Nothing) -> ChatRef -> Either StoreError ChatRef
forall a b. b -> Either a b
Right (ChatRef -> Either StoreError ChatRef)
-> ChatRef -> Either StoreError ChatRef
forall a b. (a -> b) -> a -> b
$ ChatType -> ChatItemId -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTDirect ChatItemId
contactId Maybe GroupChatScope
forall a. Maybe a
Nothing
      -- Only used in CLI and unused APIs
      (Maybe ChatItemId
Nothing, Just ChatItemId
groupId) -> ChatRef -> Either StoreError ChatRef
forall a b. b -> Either a b
Right (ChatRef -> Either StoreError ChatRef)
-> ChatRef -> Either StoreError ChatRef
forall a b. (a -> b) -> a -> b
$ ChatType -> ChatItemId -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTGroup ChatItemId
groupId Maybe GroupChatScope
forall a. Maybe a
Nothing
      (Maybe ChatItemId
_, Maybe ChatItemId
_) -> StoreError -> Either StoreError ChatRef
forall a b. a -> Either a b
Left (StoreError -> Either StoreError ChatRef)
-> StoreError -> Either StoreError ChatRef
forall a b. (a -> b) -> a -> b
$ ChatItemId -> Maybe UTCTime -> StoreError
SEBadChatItem ChatItemId
itemId Maybe UTCTime
forall a. Maybe a
Nothing

getAChatItem :: DB.Connection -> VersionRangeChat -> User -> ChatRef -> ChatItemId -> ExceptT StoreError IO AChatItem
getAChatItem :: Connection
-> VersionRangeChat
-> User
-> ChatRef
-> ChatItemId
-> ExceptT StoreError IO AChatItem
getAChatItem Connection
db VersionRangeChat
vr User
user (ChatRef ChatType
cType ChatItemId
chatId Maybe GroupChatScope
scope) ChatItemId
itemId = do
  AChatItem
aci <- case ChatType
cType of
    ChatType
CTDirect -> do
      Contact
ct <- Connection
-> VersionRangeChat
-> User
-> ChatItemId
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user ChatItemId
chatId
      (CChatItem SMsgDirection d
msgDir ChatItem 'CTDirect d
ci) <- Connection
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectChatItem Connection
db User
user ChatItemId
chatId ChatItemId
itemId
      AChatItem -> ExceptT StoreError IO AChatItem
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AChatItem -> ExceptT StoreError IO AChatItem)
-> AChatItem -> ExceptT StoreError IO AChatItem
forall a b. (a -> b) -> a -> b
$ SChatType 'CTDirect
-> SMsgDirection d
-> ChatInfo 'CTDirect
-> ChatItem 'CTDirect d
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTDirect
SCTDirect SMsgDirection d
msgDir (Contact -> ChatInfo 'CTDirect
DirectChat Contact
ct) ChatItem 'CTDirect d
ci
    ChatType
CTGroup -> do
      GroupInfo
gInfo <- Connection
-> VersionRangeChat
-> User
-> ChatItemId
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user ChatItemId
chatId
      (CChatItem SMsgDirection d
msgDir ChatItem 'CTGroup d
ci) <- Connection
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupChatItem Connection
db User
user ChatItemId
chatId ChatItemId
itemId
      Maybe GroupChatScopeInfo
scopeInfo <- (GroupChatScope -> ExceptT StoreError IO GroupChatScopeInfo)
-> Maybe GroupChatScope
-> ExceptT StoreError IO (Maybe GroupChatScopeInfo)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> GroupChatScope
-> ExceptT StoreError IO GroupChatScopeInfo
getGroupChatScopeInfo Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo) Maybe GroupChatScope
scope
      AChatItem -> ExceptT StoreError IO AChatItem
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AChatItem -> ExceptT StoreError IO AChatItem)
-> AChatItem -> ExceptT StoreError IO AChatItem
forall a b. (a -> b) -> a -> b
$ SChatType 'CTGroup
-> SMsgDirection d
-> ChatInfo 'CTGroup
-> ChatItem 'CTGroup d
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTGroup
SCTGroup SMsgDirection d
msgDir (GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
gInfo Maybe GroupChatScopeInfo
scopeInfo) ChatItem 'CTGroup d
ci
    ChatType
CTLocal -> do
      NoteFolder
nf <- Connection
-> User -> ChatItemId -> ExceptT StoreError IO NoteFolder
getNoteFolder Connection
db User
user ChatItemId
chatId
      CChatItem SMsgDirection d
msgDir ChatItem 'CTLocal d
ci <- Connection
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTLocal)
getLocalChatItem Connection
db User
user ChatItemId
chatId ChatItemId
itemId
      AChatItem -> ExceptT StoreError IO AChatItem
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AChatItem -> ExceptT StoreError IO AChatItem)
-> AChatItem -> ExceptT StoreError IO AChatItem
forall a b. (a -> b) -> a -> b
$ SChatType 'CTLocal
-> SMsgDirection d
-> ChatInfo 'CTLocal
-> ChatItem 'CTLocal d
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTLocal
SCTLocal SMsgDirection d
msgDir (NoteFolder -> ChatInfo 'CTLocal
LocalChat NoteFolder
nf) ChatItem 'CTLocal d
ci
    ChatType
_ -> StoreError -> ExceptT StoreError IO AChatItem
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO AChatItem)
-> StoreError -> ExceptT StoreError IO AChatItem
forall a b. (a -> b) -> a -> b
$ ChatItemId -> StoreError
SEChatItemNotFound ChatItemId
itemId
  IO AChatItem -> ExceptT StoreError IO AChatItem
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AChatItem -> ExceptT StoreError IO AChatItem)
-> IO AChatItem -> ExceptT StoreError IO AChatItem
forall a b. (a -> b) -> a -> b
$ Connection -> AChatItem -> IO AChatItem
getACIReactions Connection
db AChatItem
aci

getAChatItemBySharedMsgId :: ChatTypeQuotable c => DB.Connection -> User -> ChatDirection c 'MDRcv -> SharedMsgId -> ExceptT StoreError IO AChatItem
getAChatItemBySharedMsgId :: forall (c :: ChatType).
ChatTypeQuotable c =>
Connection
-> User
-> ChatDirection c 'MDRcv
-> SharedMsgId
-> ExceptT StoreError IO AChatItem
getAChatItemBySharedMsgId Connection
db User
user ChatDirection c 'MDRcv
cd SharedMsgId
sharedMsgId = case ChatDirection c 'MDRcv
cd of
  CDDirectRcv ct :: Contact
ct@Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} -> do
    (CChatItem SMsgDirection d
msgDir ChatItem 'CTDirect d
ci) <- Connection
-> User
-> ChatItemId
-> SharedMsgId
-> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectChatItemBySharedMsgId Connection
db User
user ChatItemId
contactId SharedMsgId
sharedMsgId
    AChatItem -> ExceptT StoreError IO AChatItem
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AChatItem -> ExceptT StoreError IO AChatItem)
-> AChatItem -> ExceptT StoreError IO AChatItem
forall a b. (a -> b) -> a -> b
$ SChatType 'CTDirect
-> SMsgDirection d
-> ChatInfo 'CTDirect
-> ChatItem 'CTDirect d
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTDirect
SCTDirect SMsgDirection d
msgDir (Contact -> ChatInfo 'CTDirect
DirectChat Contact
ct) ChatItem 'CTDirect d
ci
  CDGroupRcv GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo GroupMember {ChatItemId
groupMemberId :: GroupMember -> ChatItemId
groupMemberId :: ChatItemId
groupMemberId} -> do
    (CChatItem SMsgDirection d
msgDir ChatItem 'CTGroup d
ci) <- Connection
-> User
-> GroupInfo
-> ChatItemId
-> SharedMsgId
-> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupChatItemBySharedMsgId Connection
db User
user GroupInfo
g ChatItemId
groupMemberId SharedMsgId
sharedMsgId
    AChatItem -> ExceptT StoreError IO AChatItem
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AChatItem -> ExceptT StoreError IO AChatItem)
-> AChatItem -> ExceptT StoreError IO AChatItem
forall a b. (a -> b) -> a -> b
$ SChatType 'CTGroup
-> SMsgDirection d
-> ChatInfo 'CTGroup
-> ChatItem 'CTGroup d
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTGroup
SCTGroup SMsgDirection d
msgDir (GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
g Maybe GroupChatScopeInfo
scopeInfo) ChatItem 'CTGroup d
ci

getChatItemVersions :: DB.Connection -> ChatItemId -> IO [ChatItemVersion]
getChatItemVersions :: Connection -> ChatItemId -> IO [ChatItemVersion]
getChatItemVersions Connection
db ChatItemId
itemId = do
  ((ChatItemId, MsgContent, UTCTime, UTCTime) -> ChatItemVersion)
-> [(ChatItemId, MsgContent, UTCTime, UTCTime)]
-> [ChatItemVersion]
forall a b. (a -> b) -> [a] -> [b]
map (ChatItemId, MsgContent, UTCTime, UTCTime) -> ChatItemVersion
toChatItemVersion
    ([(ChatItemId, MsgContent, UTCTime, UTCTime)] -> [ChatItemVersion])
-> IO [(ChatItemId, MsgContent, UTCTime, UTCTime)]
-> IO [ChatItemVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> Only ChatItemId
-> IO [(ChatItemId, MsgContent, UTCTime, UTCTime)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT chat_item_version_id, msg_content, item_version_ts, created_at
        FROM chat_item_versions
        WHERE chat_item_id = ?
        ORDER BY chat_item_version_id DESC
      |]
      (ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
itemId)
  where
    toChatItemVersion :: (Int64, MsgContent, UTCTime, UTCTime) -> ChatItemVersion
    toChatItemVersion :: (ChatItemId, MsgContent, UTCTime, UTCTime) -> ChatItemVersion
toChatItemVersion (ChatItemId
chatItemVersionId, MsgContent
msgContent, UTCTime
itemVersionTs, UTCTime
createdAt) =
      let formattedText :: Maybe MarkdownList
formattedText = MemberName -> Maybe MarkdownList
parseMaybeMarkdownList (MemberName -> Maybe MarkdownList)
-> MemberName -> Maybe MarkdownList
forall a b. (a -> b) -> a -> b
$ MsgContent -> MemberName
msgContentText MsgContent
msgContent
       in ChatItemVersion {ChatItemId
chatItemVersionId :: ChatItemId
chatItemVersionId :: ChatItemId
chatItemVersionId, MsgContent
msgContent :: MsgContent
msgContent :: MsgContent
msgContent, Maybe MarkdownList
formattedText :: Maybe MarkdownList
formattedText :: Maybe MarkdownList
formattedText, UTCTime
itemVersionTs :: UTCTime
itemVersionTs :: UTCTime
itemVersionTs, UTCTime
createdAt :: UTCTime
createdAt :: UTCTime
createdAt}

directCIWithReactions :: DB.Connection -> Contact -> CChatItem 'CTDirect -> IO (CChatItem 'CTDirect)
directCIWithReactions :: Connection
-> Contact -> CChatItem 'CTDirect -> IO (CChatItem 'CTDirect)
directCIWithReactions Connection
db Contact
ct cci :: CChatItem 'CTDirect
cci@(CChatItem SMsgDirection d
md ci :: ChatItem 'CTDirect d
ci@ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {Maybe SharedMsgId
itemSharedMsgId :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe SharedMsgId
itemSharedMsgId :: Maybe SharedMsgId
itemSharedMsgId}}) = case Maybe SharedMsgId
itemSharedMsgId of
  Just SharedMsgId
sharedMsgId -> do
    [CIReactionCount]
reactions <- Connection -> Contact -> SharedMsgId -> IO [CIReactionCount]
getDirectCIReactions Connection
db Contact
ct SharedMsgId
sharedMsgId
    CChatItem 'CTDirect -> IO (CChatItem 'CTDirect)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CChatItem 'CTDirect -> IO (CChatItem 'CTDirect))
-> CChatItem 'CTDirect -> IO (CChatItem 'CTDirect)
forall a b. (a -> b) -> a -> b
$ SMsgDirection d -> ChatItem 'CTDirect d -> CChatItem 'CTDirect
forall (c :: ChatType) (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> ChatItem c d -> CChatItem c
CChatItem SMsgDirection d
md ChatItem 'CTDirect d
ci {reactions}
  Maybe SharedMsgId
Nothing -> CChatItem 'CTDirect -> IO (CChatItem 'CTDirect)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CChatItem 'CTDirect
cci

getDirectCIReactions :: DB.Connection -> Contact -> SharedMsgId -> IO [CIReactionCount]
getDirectCIReactions :: Connection -> Contact -> SharedMsgId -> IO [CIReactionCount]
getDirectCIReactions Connection
db Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} SharedMsgId
itemSharedMsgId =
  ((MsgReaction, BoolInt, Int) -> CIReactionCount)
-> [(MsgReaction, BoolInt, Int)] -> [CIReactionCount]
forall a b. (a -> b) -> [a] -> [b]
map (MsgReaction, BoolInt, Int) -> CIReactionCount
toCIReaction
    ([(MsgReaction, BoolInt, Int)] -> [CIReactionCount])
-> IO [(MsgReaction, BoolInt, Int)] -> IO [CIReactionCount]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (ChatItemId, SharedMsgId)
-> IO [(MsgReaction, BoolInt, Int)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT reaction, MAX(reaction_sent), COUNT(chat_item_reaction_id)
        FROM chat_item_reactions
        WHERE contact_id = ? AND shared_msg_id = ?
        GROUP BY reaction
      |]
      (ChatItemId
contactId, SharedMsgId
itemSharedMsgId)

getGroupCIReactions :: DB.Connection -> GroupInfo -> MemberId -> SharedMsgId -> IO [CIReactionCount]
getGroupCIReactions :: Connection
-> GroupInfo -> MemberId -> SharedMsgId -> IO [CIReactionCount]
getGroupCIReactions Connection
db GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} MemberId
itemMemberId SharedMsgId
itemSharedMsgId =
  ((MsgReaction, BoolInt, Int) -> CIReactionCount)
-> [(MsgReaction, BoolInt, Int)] -> [CIReactionCount]
forall a b. (a -> b) -> [a] -> [b]
map (MsgReaction, BoolInt, Int) -> CIReactionCount
toCIReaction
    ([(MsgReaction, BoolInt, Int)] -> [CIReactionCount])
-> IO [(MsgReaction, BoolInt, Int)] -> IO [CIReactionCount]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (ChatItemId, MemberId, SharedMsgId)
-> IO [(MsgReaction, BoolInt, Int)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT reaction, MAX(reaction_sent), COUNT(chat_item_reaction_id)
        FROM chat_item_reactions
        WHERE group_id = ? AND item_member_id = ? AND shared_msg_id = ?
        GROUP BY reaction
      |]
      (ChatItemId
groupId, MemberId
itemMemberId, SharedMsgId
itemSharedMsgId)

getGroupCIMentions :: DB.Connection -> ChatItemId -> IO (Map MemberName CIMention)
getGroupCIMentions :: Connection -> ChatItemId -> IO (Map MemberName CIMention)
getGroupCIMentions Connection
db ChatItemId
ciId =
  [(MemberName, CIMention)] -> Map MemberName CIMention
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(MemberName, CIMention)] -> Map MemberName CIMention)
-> ([(MemberName, MemberId, Maybe ChatItemId,
      Maybe GroupMemberRole, Maybe MemberName, Maybe MemberName)]
    -> [(MemberName, CIMention)])
-> [(MemberName, MemberId, Maybe ChatItemId, Maybe GroupMemberRole,
     Maybe MemberName, Maybe MemberName)]
-> Map MemberName CIMention
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MemberName, MemberId, Maybe ChatItemId, Maybe GroupMemberRole,
  Maybe MemberName, Maybe MemberName)
 -> (MemberName, CIMention))
-> [(MemberName, MemberId, Maybe ChatItemId, Maybe GroupMemberRole,
     Maybe MemberName, Maybe MemberName)]
-> [(MemberName, CIMention)]
forall a b. (a -> b) -> [a] -> [b]
map (MemberName, MemberId, Maybe ChatItemId, Maybe GroupMemberRole,
 Maybe MemberName, Maybe MemberName)
-> (MemberName, CIMention)
mentionedMember
    ([(MemberName, MemberId, Maybe ChatItemId, Maybe GroupMemberRole,
   Maybe MemberName, Maybe MemberName)]
 -> Map MemberName CIMention)
-> IO
     [(MemberName, MemberId, Maybe ChatItemId, Maybe GroupMemberRole,
       Maybe MemberName, Maybe MemberName)]
-> IO (Map MemberName CIMention)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> Only ChatItemId
-> IO
     [(MemberName, MemberId, Maybe ChatItemId, Maybe GroupMemberRole,
       Maybe MemberName, Maybe MemberName)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT r.display_name, r.member_id, m.group_member_id, m.member_role, p.display_name, p.local_alias
        FROM chat_item_mentions r
        LEFT JOIN group_members m ON r.group_id = m.group_id AND r.member_id = m.member_id
        LEFT JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
        WHERE r.chat_item_id = ?
      |]
      (ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
ciId)
  where
    mentionedMember :: (ContactName, MemberId, Maybe GroupMemberId, Maybe GroupMemberRole, Maybe Text, Maybe Text) -> (ContactName, CIMention)
    mentionedMember :: (MemberName, MemberId, Maybe ChatItemId, Maybe GroupMemberRole,
 Maybe MemberName, Maybe MemberName)
-> (MemberName, CIMention)
mentionedMember (MemberName
name, MemberId
memberId, Maybe ChatItemId
gmId_, Maybe GroupMemberRole
mRole_, Maybe MemberName
displayName_, Maybe MemberName
localAlias) =
      let memberRef :: Maybe CIMentionMember
memberRef = case (Maybe ChatItemId
gmId_, Maybe GroupMemberRole
mRole_, Maybe MemberName
displayName_) of
            (Just ChatItemId
groupMemberId, Just GroupMemberRole
memberRole, Just MemberName
displayName) ->
              CIMentionMember -> Maybe CIMentionMember
forall a. a -> Maybe a
Just CIMentionMember {ChatItemId
groupMemberId :: ChatItemId
groupMemberId :: ChatItemId
groupMemberId, MemberName
displayName :: MemberName
displayName :: MemberName
displayName, Maybe MemberName
localAlias :: Maybe MemberName
localAlias :: Maybe MemberName
localAlias, GroupMemberRole
memberRole :: GroupMemberRole
memberRole :: GroupMemberRole
memberRole}
            (Maybe ChatItemId, Maybe GroupMemberRole, Maybe MemberName)
_ -> Maybe CIMentionMember
forall a. Maybe a
Nothing
       in (MemberName
name, CIMention {MemberId
memberId :: MemberId
memberId :: MemberId
memberId, Maybe CIMentionMember
memberRef :: Maybe CIMentionMember
memberRef :: Maybe CIMentionMember
memberRef})

getACIReactions :: DB.Connection -> AChatItem -> IO AChatItem
getACIReactions :: Connection -> AChatItem -> IO AChatItem
getACIReactions Connection
db aci :: AChatItem
aci@(AChatItem SChatType c
_ SMsgDirection d
md ChatInfo c
chat ci :: ChatItem c d
ci@ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {Maybe SharedMsgId
itemSharedMsgId :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe SharedMsgId
itemSharedMsgId :: Maybe SharedMsgId
itemSharedMsgId}}) = case Maybe SharedMsgId
itemSharedMsgId of
  Just SharedMsgId
itemSharedMId -> case ChatInfo c
chat of
    DirectChat Contact
ct -> do
      [CIReactionCount]
reactions <- Connection -> Contact -> SharedMsgId -> IO [CIReactionCount]
getDirectCIReactions Connection
db Contact
ct SharedMsgId
itemSharedMId
      AChatItem -> IO AChatItem
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AChatItem -> IO AChatItem) -> AChatItem -> IO AChatItem
forall a b. (a -> b) -> a -> b
$ SChatType 'CTDirect
-> SMsgDirection d
-> ChatInfo 'CTDirect
-> ChatItem 'CTDirect d
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTDirect
SCTDirect SMsgDirection d
md ChatInfo c
ChatInfo 'CTDirect
chat ChatItem c d
ci {reactions}
    GroupChat GroupInfo
g Maybe GroupChatScopeInfo
_s -> do
      let GroupMember {MemberId
memberId :: GroupMember -> MemberId
memberId :: MemberId
memberId} = GroupInfo -> ChatItem 'CTGroup d -> GroupMember
forall (d :: MsgDirection).
GroupInfo -> ChatItem 'CTGroup d -> GroupMember
chatItemMember GroupInfo
g ChatItem c d
ChatItem 'CTGroup d
ci
      [CIReactionCount]
reactions <- Connection
-> GroupInfo -> MemberId -> SharedMsgId -> IO [CIReactionCount]
getGroupCIReactions Connection
db GroupInfo
g MemberId
memberId SharedMsgId
itemSharedMId
      AChatItem -> IO AChatItem
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AChatItem -> IO AChatItem) -> AChatItem -> IO AChatItem
forall a b. (a -> b) -> a -> b
$ SChatType 'CTGroup
-> SMsgDirection d
-> ChatInfo 'CTGroup
-> ChatItem 'CTGroup d
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTGroup
SCTGroup SMsgDirection d
md ChatInfo c
ChatInfo 'CTGroup
chat ChatItem c d
ci {reactions}
    ChatInfo c
_ -> AChatItem -> IO AChatItem
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AChatItem
aci
  Maybe SharedMsgId
_ -> AChatItem -> IO AChatItem
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AChatItem
aci

deleteDirectCIReactions_ :: DB.Connection -> ContactId -> ChatItem 'CTDirect d -> IO ()
deleteDirectCIReactions_ :: forall (d :: MsgDirection).
Connection -> ChatItemId -> ChatItem 'CTDirect d -> IO ()
deleteDirectCIReactions_ Connection
db ChatItemId
contactId ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {Maybe SharedMsgId
itemSharedMsgId :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe SharedMsgId
itemSharedMsgId :: Maybe SharedMsgId
itemSharedMsgId}} =
  Maybe SharedMsgId -> (SharedMsgId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe SharedMsgId
itemSharedMsgId ((SharedMsgId -> IO ()) -> IO ())
-> (SharedMsgId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \SharedMsgId
itemSharedMId ->
    Connection -> Query -> (ChatItemId, SharedMsgId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM chat_item_reactions WHERE contact_id = ? AND shared_msg_id = ?" (ChatItemId
contactId, SharedMsgId
itemSharedMId)

deleteGroupCIReactions_ :: DB.Connection -> GroupInfo -> ChatItem 'CTGroup d -> IO ()
deleteGroupCIReactions_ :: forall (d :: MsgDirection).
Connection -> GroupInfo -> ChatItem 'CTGroup d -> IO ()
deleteGroupCIReactions_ Connection
db g :: GroupInfo
g@GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} ci :: ChatItem 'CTGroup d
ci@ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {Maybe SharedMsgId
itemSharedMsgId :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe SharedMsgId
itemSharedMsgId :: Maybe SharedMsgId
itemSharedMsgId}} =
  Maybe SharedMsgId -> (SharedMsgId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe SharedMsgId
itemSharedMsgId ((SharedMsgId -> IO ()) -> IO ())
-> (SharedMsgId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \SharedMsgId
itemSharedMId -> do
    let GroupMember {MemberId
memberId :: GroupMember -> MemberId
memberId :: MemberId
memberId} = GroupInfo -> ChatItem 'CTGroup d -> GroupMember
forall (d :: MsgDirection).
GroupInfo -> ChatItem 'CTGroup d -> GroupMember
chatItemMember GroupInfo
g ChatItem 'CTGroup d
ci
    Connection -> Query -> (ChatItemId, SharedMsgId, MemberId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      Query
"DELETE FROM chat_item_reactions WHERE group_id = ? AND shared_msg_id = ? AND item_member_id = ?"
      (ChatItemId
groupId, SharedMsgId
itemSharedMId, MemberId
memberId)

toCIReaction :: (MsgReaction, BoolInt, Int) -> CIReactionCount
toCIReaction :: (MsgReaction, BoolInt, Int) -> CIReactionCount
toCIReaction (MsgReaction
reaction, BI Bool
userReacted, Int
totalReacted) = CIReactionCount {MsgReaction
reaction :: MsgReaction
reaction :: MsgReaction
reaction, Bool
userReacted :: Bool
userReacted :: Bool
userReacted, Int
totalReacted :: Int
totalReacted :: Int
totalReacted}

getDirectReactions :: DB.Connection -> Contact -> SharedMsgId -> Bool -> IO [MsgReaction]
getDirectReactions :: Connection -> Contact -> SharedMsgId -> Bool -> IO [MsgReaction]
getDirectReactions Connection
db Contact
ct SharedMsgId
itemSharedMId Bool
sent =
  (Only MsgReaction -> MsgReaction)
-> [Only MsgReaction] -> [MsgReaction]
forall a b. (a -> b) -> [a] -> [b]
map Only MsgReaction -> MsgReaction
forall a. Only a -> a
fromOnly
    ([Only MsgReaction] -> [MsgReaction])
-> IO [Only MsgReaction] -> IO [MsgReaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (ChatItemId, SharedMsgId, BoolInt)
-> IO [Only MsgReaction]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT reaction
        FROM chat_item_reactions
        WHERE contact_id = ? AND shared_msg_id = ? AND reaction_sent = ?
      |]
      (Contact -> ChatItemId
forall a. IsContact a => a -> ChatItemId
contactId' Contact
ct, SharedMsgId
itemSharedMId, Bool -> BoolInt
BI Bool
sent)

setDirectReaction :: DB.Connection -> Contact -> SharedMsgId -> Bool -> MsgReaction -> Bool -> MessageId -> UTCTime -> IO ()
setDirectReaction :: Connection
-> Contact
-> SharedMsgId
-> Bool
-> MsgReaction
-> Bool
-> ChatItemId
-> UTCTime
-> IO ()
setDirectReaction Connection
db Contact
ct SharedMsgId
itemSharedMId Bool
sent MsgReaction
reaction Bool
add ChatItemId
msgId UTCTime
reactionTs
  | Bool
add =
      Connection
-> Query
-> (ChatItemId, SharedMsgId, BoolInt, MsgReaction, ChatItemId,
    UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        [sql|
          INSERT INTO chat_item_reactions
            (contact_id, shared_msg_id, reaction_sent, reaction, created_by_msg_id, reaction_ts)
            VALUES (?,?,?,?,?,?)
        |]
        (Contact -> ChatItemId
forall a. IsContact a => a -> ChatItemId
contactId' Contact
ct, SharedMsgId
itemSharedMId, Bool -> BoolInt
BI Bool
sent, MsgReaction
reaction, ChatItemId
msgId, UTCTime
reactionTs)
  | Bool
otherwise =
      Connection
-> Query
-> (ChatItemId, SharedMsgId, BoolInt, MsgReaction)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        [sql|
          DELETE FROM chat_item_reactions
          WHERE contact_id = ? AND shared_msg_id = ? AND reaction_sent = ? AND reaction = ?
        |]
        (Contact -> ChatItemId
forall a. IsContact a => a -> ChatItemId
contactId' Contact
ct, SharedMsgId
itemSharedMId, Bool -> BoolInt
BI Bool
sent, MsgReaction
reaction)

getGroupReactions :: DB.Connection -> GroupInfo -> GroupMember -> MemberId -> SharedMsgId -> Bool -> IO [MsgReaction]
getGroupReactions :: Connection
-> GroupInfo
-> GroupMember
-> MemberId
-> SharedMsgId
-> Bool
-> IO [MsgReaction]
getGroupReactions Connection
db GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} GroupMember
m MemberId
itemMemberId SharedMsgId
itemSharedMId Bool
sent =
  (Only MsgReaction -> MsgReaction)
-> [Only MsgReaction] -> [MsgReaction]
forall a b. (a -> b) -> [a] -> [b]
map Only MsgReaction -> MsgReaction
forall a. Only a -> a
fromOnly
    ([Only MsgReaction] -> [MsgReaction])
-> IO [Only MsgReaction] -> IO [MsgReaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (ChatItemId, ChatItemId, MemberId, SharedMsgId, BoolInt)
-> IO [Only MsgReaction]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT reaction
        FROM chat_item_reactions
        WHERE group_id = ? AND group_member_id = ? AND item_member_id = ? AND shared_msg_id = ? AND reaction_sent = ?
      |]
      (ChatItemId
groupId, GroupMember -> ChatItemId
groupMemberId' GroupMember
m, MemberId
itemMemberId, SharedMsgId
itemSharedMId, Bool -> BoolInt
BI Bool
sent)

setGroupReaction :: DB.Connection -> GroupInfo -> GroupMember -> MemberId -> SharedMsgId -> Bool -> MsgReaction -> Bool -> MessageId -> UTCTime -> IO ()
setGroupReaction :: Connection
-> GroupInfo
-> GroupMember
-> MemberId
-> SharedMsgId
-> Bool
-> MsgReaction
-> Bool
-> ChatItemId
-> UTCTime
-> IO ()
setGroupReaction Connection
db GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} GroupMember
m MemberId
itemMemberId SharedMsgId
itemSharedMId Bool
sent MsgReaction
reaction Bool
add ChatItemId
msgId UTCTime
reactionTs
  | Bool
add =
      Connection
-> Query
-> (ChatItemId, ChatItemId, MemberId, SharedMsgId, BoolInt,
    MsgReaction, ChatItemId, UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        [sql|
          INSERT INTO chat_item_reactions
            (group_id, group_member_id, item_member_id, shared_msg_id, reaction_sent, reaction, created_by_msg_id, reaction_ts)
            VALUES (?,?,?,?,?,?,?,?)
        |]
        (ChatItemId
groupId, GroupMember -> ChatItemId
groupMemberId' GroupMember
m, MemberId
itemMemberId, SharedMsgId
itemSharedMId, Bool -> BoolInt
BI Bool
sent, MsgReaction
reaction, ChatItemId
msgId, UTCTime
reactionTs)
  | Bool
otherwise =
      Connection
-> Query
-> (ChatItemId, ChatItemId, SharedMsgId, MemberId, BoolInt,
    MsgReaction)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        [sql|
          DELETE FROM chat_item_reactions
          WHERE group_id = ? AND group_member_id = ? AND shared_msg_id = ? AND item_member_id = ? AND reaction_sent = ? AND reaction = ?
        |]
        (ChatItemId
groupId, GroupMember -> ChatItemId
groupMemberId' GroupMember
m, SharedMsgId
itemSharedMId, MemberId
itemMemberId, Bool -> BoolInt
BI Bool
sent, MsgReaction
reaction)

getReactionMembers :: DB.Connection -> VersionRangeChat -> User -> GroupId -> SharedMsgId -> MsgReaction -> IO [MemberReaction]
getReactionMembers :: Connection
-> VersionRangeChat
-> User
-> ChatItemId
-> SharedMsgId
-> MsgReaction
-> IO [MemberReaction]
getReactionMembers Connection
db VersionRangeChat
vr User
user ChatItemId
groupId SharedMsgId
itemSharedMId MsgReaction
reaction = do
  [(ChatItemId, UTCTime)]
reactions <-
    Connection
-> Query
-> (ChatItemId, SharedMsgId, MsgReaction)
-> IO [(ChatItemId, UTCTime)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT group_member_id, reaction_ts
        FROM chat_item_reactions
        WHERE group_id = ? AND shared_msg_id = ? AND reaction = ?
      |]
      (ChatItemId
groupId, SharedMsgId
itemSharedMId, MsgReaction
reaction)
  [Either StoreError MemberReaction] -> [MemberReaction]
forall a b. [Either a b] -> [b]
rights ([Either StoreError MemberReaction] -> [MemberReaction])
-> IO [Either StoreError MemberReaction] -> IO [MemberReaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ChatItemId, UTCTime) -> IO (Either StoreError MemberReaction))
-> [(ChatItemId, UTCTime)] -> IO [Either StoreError MemberReaction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ExceptT StoreError IO MemberReaction
-> IO (Either StoreError MemberReaction)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO MemberReaction
 -> IO (Either StoreError MemberReaction))
-> ((ChatItemId, UTCTime) -> ExceptT StoreError IO MemberReaction)
-> (ChatItemId, UTCTime)
-> IO (Either StoreError MemberReaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChatItemId, UTCTime) -> ExceptT StoreError IO MemberReaction
toMemberReaction) [(ChatItemId, UTCTime)]
reactions
  where
    toMemberReaction :: (GroupMemberId, UTCTime) -> ExceptT StoreError IO MemberReaction
    toMemberReaction :: (ChatItemId, UTCTime) -> ExceptT StoreError IO MemberReaction
toMemberReaction (ChatItemId
groupMemberId, UTCTime
reactionTs) = do
      GroupMember
groupMember <- Connection
-> VersionRangeChat
-> User
-> ChatItemId
-> ExceptT StoreError IO GroupMember
getGroupMemberById Connection
db VersionRangeChat
vr User
user ChatItemId
groupMemberId
      MemberReaction -> ExceptT StoreError IO MemberReaction
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MemberReaction {GroupMember
groupMember :: GroupMember
groupMember :: GroupMember
groupMember, UTCTime
reactionTs :: UTCTime
reactionTs :: UTCTime
reactionTs}

getTimedItems :: DB.Connection -> User -> UTCTime -> IO [((ChatRef, ChatItemId), UTCTime)]
getTimedItems :: Connection
-> User -> UTCTime -> IO [((ChatRef, ChatItemId), UTCTime)]
getTimedItems Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} UTCTime
startTimedThreadCutoff =
  ((ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
  Maybe GroupChatScopeTag, Maybe ChatItemId, UTCTime)
 -> Maybe ((ChatRef, ChatItemId), UTCTime))
-> [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
     Maybe GroupChatScopeTag, Maybe ChatItemId, UTCTime)]
-> [((ChatRef, ChatItemId), UTCTime)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
 Maybe GroupChatScopeTag, Maybe ChatItemId, UTCTime)
-> Maybe ((ChatRef, ChatItemId), UTCTime)
toCIRefDeleteAt
    ([(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
   Maybe GroupChatScopeTag, Maybe ChatItemId, UTCTime)]
 -> [((ChatRef, ChatItemId), UTCTime)])
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, UTCTime)]
-> IO [((ChatRef, ChatItemId), UTCTime)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (ChatItemId, UTCTime)
-> IO
     [(ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
       Maybe GroupChatScopeTag, Maybe ChatItemId, UTCTime)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT chat_item_id, contact_id, group_id, group_scope_tag, group_scope_group_member_id, timed_delete_at
        FROM chat_items
        WHERE user_id = ? AND timed_delete_at IS NOT NULL AND timed_delete_at <= ?
      |]
      (ChatItemId
userId, UTCTime
startTimedThreadCutoff)
  where
    toCIRefDeleteAt :: (ChatItemId, Maybe ContactId, Maybe GroupId, Maybe GroupChatScopeTag, Maybe GroupMemberId, UTCTime) -> Maybe ((ChatRef, ChatItemId), UTCTime)
    toCIRefDeleteAt :: (ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
 Maybe GroupChatScopeTag, Maybe ChatItemId, UTCTime)
-> Maybe ((ChatRef, ChatItemId), UTCTime)
toCIRefDeleteAt = \case
      (ChatItemId
itemId, Just ChatItemId
contactId, Maybe ChatItemId
Nothing, Maybe GroupChatScopeTag
Nothing, Maybe ChatItemId
Nothing, UTCTime
deleteAt) ->
        ((ChatRef, ChatItemId), UTCTime)
-> Maybe ((ChatRef, ChatItemId), UTCTime)
forall a. a -> Maybe a
Just ((ChatType -> ChatItemId -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTDirect ChatItemId
contactId Maybe GroupChatScope
forall a. Maybe a
Nothing, ChatItemId
itemId), UTCTime
deleteAt)
      (ChatItemId
itemId, Maybe ChatItemId
Nothing, Just ChatItemId
groupId, Maybe GroupChatScopeTag
scopeTag_, Maybe ChatItemId
scopeGMId_, UTCTime
deleteAt) ->
        let scope :: Maybe GroupChatScope
scope = case (Maybe GroupChatScopeTag
scopeTag_, Maybe ChatItemId
scopeGMId_) of
              (Maybe GroupChatScopeTag
Nothing, Maybe ChatItemId
Nothing) -> Maybe GroupChatScope
forall a. Maybe a
Nothing
              (Just GroupChatScopeTag
GCSTMemberSupport_, Just ChatItemId
groupMemberId) -> GroupChatScope -> Maybe GroupChatScope
forall a. a -> Maybe a
Just (GroupChatScope -> Maybe GroupChatScope)
-> GroupChatScope -> Maybe GroupChatScope
forall a b. (a -> b) -> a -> b
$ Maybe ChatItemId -> GroupChatScope
GCSMemberSupport (ChatItemId -> Maybe ChatItemId
forall a. a -> Maybe a
Just ChatItemId
groupMemberId)
              (Just GroupChatScopeTag
GCSTMemberSupport_, Maybe ChatItemId
Nothing) -> GroupChatScope -> Maybe GroupChatScope
forall a. a -> Maybe a
Just (GroupChatScope -> Maybe GroupChatScope)
-> GroupChatScope -> Maybe GroupChatScope
forall a b. (a -> b) -> a -> b
$ Maybe ChatItemId -> GroupChatScope
GCSMemberSupport Maybe ChatItemId
forall a. Maybe a
Nothing
              (Maybe GroupChatScopeTag
Nothing, Just ChatItemId
_) -> Maybe GroupChatScope
forall a. Maybe a
Nothing -- should not happen
         in ((ChatRef, ChatItemId), UTCTime)
-> Maybe ((ChatRef, ChatItemId), UTCTime)
forall a. a -> Maybe a
Just ((ChatType -> ChatItemId -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTGroup ChatItemId
groupId Maybe GroupChatScope
scope, ChatItemId
itemId), UTCTime
deleteAt)
      (ChatItemId, Maybe ChatItemId, Maybe ChatItemId,
 Maybe GroupChatScopeTag, Maybe ChatItemId, UTCTime)
_ -> Maybe ((ChatRef, ChatItemId), UTCTime)
forall a. Maybe a
Nothing

getChatItemTTL :: DB.Connection -> User -> IO Int64
getChatItemTTL :: Connection -> User -> IO ChatItemId
getChatItemTTL Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} =
  (Maybe (Maybe ChatItemId) -> ChatItemId)
-> IO (Maybe (Maybe ChatItemId)) -> IO ChatItemId
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ChatItemId -> Maybe ChatItemId -> ChatItemId
forall a. a -> Maybe a -> a
fromMaybe ChatItemId
0 (Maybe ChatItemId -> ChatItemId)
-> (Maybe (Maybe ChatItemId) -> Maybe ChatItemId)
-> Maybe (Maybe ChatItemId)
-> ChatItemId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Maybe ChatItemId) -> Maybe ChatItemId
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join) (IO (Maybe (Maybe ChatItemId)) -> IO ChatItemId)
-> (IO [Only (Maybe ChatItemId)] -> IO (Maybe (Maybe ChatItemId)))
-> IO [Only (Maybe ChatItemId)]
-> IO ChatItemId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only (Maybe ChatItemId) -> Maybe ChatItemId)
-> IO [Only (Maybe ChatItemId)] -> IO (Maybe (Maybe ChatItemId))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only (Maybe ChatItemId) -> Maybe ChatItemId
forall a. Only a -> a
fromOnly (IO [Only (Maybe ChatItemId)] -> IO ChatItemId)
-> IO [Only (Maybe ChatItemId)] -> IO ChatItemId
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query -> Only ChatItemId -> IO [Only (Maybe ChatItemId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT chat_item_ttl FROM settings WHERE user_id = ? LIMIT 1" (ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
userId)

setChatItemTTL :: DB.Connection -> User -> Int64 -> IO ()
setChatItemTTL :: Connection -> User -> ChatItemId -> IO ()
setChatItemTTL Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ChatItemId
chatItemTTL = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Maybe ChatItemId
r :: (Maybe Int64) <- (Only ChatItemId -> ChatItemId)
-> IO [Only ChatItemId] -> IO (Maybe ChatItemId)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly (IO [Only ChatItemId] -> IO (Maybe ChatItemId))
-> IO [Only ChatItemId] -> IO (Maybe ChatItemId)
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> Only ChatItemId -> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT 1 FROM settings WHERE user_id = ? LIMIT 1" (ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
userId)
  case Maybe ChatItemId
r of
    Just ChatItemId
_ -> do
      Connection -> Query -> (ChatItemId, UTCTime, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        Query
"UPDATE settings SET chat_item_ttl = ?, updated_at = ? WHERE user_id = ?"
        (ChatItemId
chatItemTTL, UTCTime
currentTs, ChatItemId
userId)
    Maybe ChatItemId
Nothing -> do
      Connection
-> Query -> (ChatItemId, ChatItemId, UTCTime, UTCTime) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
        Connection
db
        Query
"INSERT INTO settings (user_id, chat_item_ttl, created_at, updated_at) VALUES (?,?,?,?)"
        (ChatItemId
userId, ChatItemId
chatItemTTL, UTCTime
currentTs, UTCTime
currentTs)

getChatTTLCount :: DB.Connection -> User -> IO Int
getChatTTLCount :: Connection -> User -> IO Int
getChatTTLCount Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} = do
  Int
contactCount <- Query -> IO Int
getCount Query
"SELECT COUNT(1) FROM contacts WHERE user_id = ? AND chat_item_ttl > 0"
  Int
groupCount <- Query -> IO Int
getCount Query
"SELECT COUNT(1) FROM groups WHERE user_id = ? AND chat_item_ttl > 0"
  Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Int
contactCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
groupCount
  where
    getCount :: Query -> IO Int
getCount Query
q = Only Int -> Int
forall a. Only a -> a
fromOnly (Only Int -> Int) -> ([Only Int] -> Only Int) -> [Only Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Only Int] -> Only Int
forall a. HasCallStack => [a] -> a
head ([Only Int] -> Int) -> IO [Only Int] -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> Only ChatItemId -> IO [Only Int]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
q (ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
userId)

getContactExpiredFileInfo :: DB.Connection -> User -> Contact -> UTCTime -> IO [CIFileInfo]
getContactExpiredFileInfo :: Connection -> User -> Contact -> UTCTime -> IO [CIFileInfo]
getContactExpiredFileInfo Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} UTCTime
expirationDate =
  ((ChatItemId, Maybe ACIFileStatus, Maybe FilePath) -> CIFileInfo)
-> [(ChatItemId, Maybe ACIFileStatus, Maybe FilePath)]
-> [CIFileInfo]
forall a b. (a -> b) -> [a] -> [b]
map (ChatItemId, Maybe ACIFileStatus, Maybe FilePath) -> CIFileInfo
toFileInfo
    ([(ChatItemId, Maybe ACIFileStatus, Maybe FilePath)]
 -> [CIFileInfo])
-> IO [(ChatItemId, Maybe ACIFileStatus, Maybe FilePath)]
-> IO [CIFileInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (ChatItemId, ChatItemId, UTCTime)
-> IO [(ChatItemId, Maybe ACIFileStatus, Maybe FilePath)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      (Query
fileInfoQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE i.user_id = ? AND i.contact_id = ? AND i.created_at <= ?")
      (ChatItemId
userId, ChatItemId
contactId, UTCTime
expirationDate)

deleteContactExpiredCIs :: DB.Connection -> User -> Contact -> UTCTime -> IO ()
deleteContactExpiredCIs :: Connection -> User -> Contact -> UTCTime -> IO ()
deleteContactExpiredCIs Connection
db user :: User
user@User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} ct :: Contact
ct@Contact {ChatItemId
contactId :: Contact -> ChatItemId
contactId :: ChatItemId
contactId} UTCTime
expirationDate = do
  [ChatItemId]
connIds <- Connection -> User -> Contact -> IO [ChatItemId]
getContactConnIds_ Connection
db User
user Contact
ct
  [ChatItemId] -> (ChatItemId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ChatItemId]
connIds ((ChatItemId -> IO ()) -> IO ()) -> (ChatItemId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ChatItemId
connId ->
    Connection -> Query -> (ChatItemId, UTCTime) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM messages WHERE connection_id = ? AND created_at <= ?" (ChatItemId
connId, UTCTime
expirationDate)
  Connection -> Query -> (ChatItemId, UTCTime) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM chat_item_reactions WHERE contact_id = ? AND created_at <= ?" (ChatItemId
contactId, UTCTime
expirationDate)
  Connection -> Query -> (ChatItemId, ChatItemId, UTCTime) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM chat_items WHERE user_id = ? AND contact_id = ? AND created_at <= ? AND item_content_tag != 'chatBanner'" (ChatItemId
userId, ChatItemId
contactId, UTCTime
expirationDate)

getGroupExpiredFileInfo :: DB.Connection -> User -> GroupInfo -> UTCTime -> UTCTime -> IO [CIFileInfo]
getGroupExpiredFileInfo :: Connection
-> User -> GroupInfo -> UTCTime -> UTCTime -> IO [CIFileInfo]
getGroupExpiredFileInfo Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} UTCTime
expirationDate UTCTime
createdAtCutoff =
  ((ChatItemId, Maybe ACIFileStatus, Maybe FilePath) -> CIFileInfo)
-> [(ChatItemId, Maybe ACIFileStatus, Maybe FilePath)]
-> [CIFileInfo]
forall a b. (a -> b) -> [a] -> [b]
map (ChatItemId, Maybe ACIFileStatus, Maybe FilePath) -> CIFileInfo
toFileInfo
    ([(ChatItemId, Maybe ACIFileStatus, Maybe FilePath)]
 -> [CIFileInfo])
-> IO [(ChatItemId, Maybe ACIFileStatus, Maybe FilePath)]
-> IO [CIFileInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (ChatItemId, ChatItemId, UTCTime, UTCTime)
-> IO [(ChatItemId, Maybe ACIFileStatus, Maybe FilePath)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      (Query
fileInfoQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE i.user_id = ? AND i.group_id = ? AND i.item_ts <= ? AND i.created_at <= ?")
      (ChatItemId
userId, ChatItemId
groupId, UTCTime
expirationDate, UTCTime
createdAtCutoff)

deleteGroupExpiredCIs :: DB.Connection -> User -> GroupInfo -> UTCTime -> UTCTime -> IO ()
deleteGroupExpiredCIs :: Connection -> User -> GroupInfo -> UTCTime -> UTCTime -> IO ()
deleteGroupExpiredCIs Connection
db User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} UTCTime
expirationDate UTCTime
createdAtCutoff = do
  Connection -> Query -> (ChatItemId, UTCTime) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM messages WHERE group_id = ? AND created_at <= ?" (ChatItemId
groupId, UTCTime -> UTCTime -> UTCTime
forall a. Ord a => a -> a -> a
min UTCTime
expirationDate UTCTime
createdAtCutoff)
  Connection -> Query -> (ChatItemId, UTCTime, UTCTime) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM chat_item_reactions WHERE group_id = ? AND reaction_ts <= ? AND created_at <= ?" (ChatItemId
groupId, UTCTime
expirationDate, UTCTime
createdAtCutoff)
  Connection
-> Query -> (ChatItemId, ChatItemId, UTCTime, UTCTime) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM chat_items WHERE user_id = ? AND group_id = ? AND item_ts <= ? AND created_at <= ? AND item_content_tag != 'chatBanner'" (ChatItemId
userId, ChatItemId
groupId, UTCTime
expirationDate, UTCTime
createdAtCutoff)

createCIModeration :: DB.Connection -> GroupInfo -> GroupMember -> MemberId -> SharedMsgId -> MessageId -> UTCTime -> IO ()
createCIModeration :: Connection
-> GroupInfo
-> GroupMember
-> MemberId
-> SharedMsgId
-> ChatItemId
-> UTCTime
-> IO ()
createCIModeration Connection
db GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} GroupMember
moderatorMember MemberId
itemMemberId SharedMsgId
itemSharedMId ChatItemId
msgId UTCTime
moderatedAtTs =
  Connection
-> Query
-> (ChatItemId, ChatItemId, MemberId, SharedMsgId, ChatItemId,
    UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      INSERT INTO chat_item_moderations
        (group_id, moderator_member_id, item_member_id, shared_msg_id, created_by_msg_id, moderated_at)
        VALUES (?,?,?,?,?,?)
    |]
    (ChatItemId
groupId, GroupMember -> ChatItemId
groupMemberId' GroupMember
moderatorMember, MemberId
itemMemberId, SharedMsgId
itemSharedMId, ChatItemId
msgId, UTCTime
moderatedAtTs)

getCIModeration :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> MemberId -> Maybe SharedMsgId -> IO (Maybe CIModeration)
getCIModeration :: Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> MemberId
-> Maybe SharedMsgId
-> IO (Maybe CIModeration)
getCIModeration Connection
_ VersionRangeChat
_ User
_ GroupInfo
_ MemberId
_ Maybe SharedMsgId
Nothing = Maybe CIModeration -> IO (Maybe CIModeration)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CIModeration
forall a. Maybe a
Nothing
getCIModeration Connection
db VersionRangeChat
vr User
user GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} MemberId
itemMemberId (Just SharedMsgId
sharedMsgId) = do
  Maybe (ChatItemId, ChatItemId, ChatItemId, UTCTime)
r_ <-
    ((ChatItemId, ChatItemId, ChatItemId, UTCTime)
 -> (ChatItemId, ChatItemId, ChatItemId, UTCTime))
-> IO [(ChatItemId, ChatItemId, ChatItemId, UTCTime)]
-> IO (Maybe (ChatItemId, ChatItemId, ChatItemId, UTCTime))
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow (ChatItemId, ChatItemId, ChatItemId, UTCTime)
-> (ChatItemId, ChatItemId, ChatItemId, UTCTime)
forall a. a -> a
id (IO [(ChatItemId, ChatItemId, ChatItemId, UTCTime)]
 -> IO (Maybe (ChatItemId, ChatItemId, ChatItemId, UTCTime)))
-> IO [(ChatItemId, ChatItemId, ChatItemId, UTCTime)]
-> IO (Maybe (ChatItemId, ChatItemId, ChatItemId, UTCTime))
forall a b. (a -> b) -> a -> b
$
      Connection
-> Query
-> (ChatItemId, MemberId, SharedMsgId)
-> IO [(ChatItemId, ChatItemId, ChatItemId, UTCTime)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT chat_item_moderation_id, moderator_member_id, created_by_msg_id, moderated_at
          FROM chat_item_moderations
          WHERE group_id = ? AND item_member_id = ? AND shared_msg_id = ?
          LIMIT 1
        |]
        (ChatItemId
groupId, MemberId
itemMemberId, SharedMsgId
sharedMsgId)
  case Maybe (ChatItemId, ChatItemId, ChatItemId, UTCTime)
r_ of
    Just (ChatItemId
moderationId, ChatItemId
moderatorId, ChatItemId
createdByMsgId, UTCTime
moderatedAt) -> do
      ExceptT StoreError IO GroupMember
-> IO (Either StoreError GroupMember)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (Connection
-> VersionRangeChat
-> User
-> ChatItemId
-> ChatItemId
-> ExceptT StoreError IO GroupMember
getGroupMember Connection
db VersionRangeChat
vr User
user ChatItemId
groupId ChatItemId
moderatorId) IO (Either StoreError GroupMember)
-> (Either StoreError GroupMember -> IO (Maybe CIModeration))
-> IO (Maybe CIModeration)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right GroupMember
moderatorMember -> Maybe CIModeration -> IO (Maybe CIModeration)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CIModeration -> Maybe CIModeration
forall a. a -> Maybe a
Just CIModeration {ChatItemId
moderationId :: ChatItemId
moderationId :: ChatItemId
moderationId, GroupMember
moderatorMember :: GroupMember
moderatorMember :: GroupMember
moderatorMember, ChatItemId
createdByMsgId :: ChatItemId
createdByMsgId :: ChatItemId
createdByMsgId, UTCTime
moderatedAt :: UTCTime
moderatedAt :: UTCTime
moderatedAt})
        Either StoreError GroupMember
_ -> Maybe CIModeration -> IO (Maybe CIModeration)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CIModeration
forall a. Maybe a
Nothing
    Maybe (ChatItemId, ChatItemId, ChatItemId, UTCTime)
_ -> Maybe CIModeration -> IO (Maybe CIModeration)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CIModeration
forall a. Maybe a
Nothing

deleteCIModeration :: DB.Connection -> GroupInfo -> MemberId -> Maybe SharedMsgId -> IO ()
deleteCIModeration :: Connection -> GroupInfo -> MemberId -> Maybe SharedMsgId -> IO ()
deleteCIModeration Connection
_ GroupInfo
_ MemberId
_ Maybe SharedMsgId
Nothing = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
deleteCIModeration Connection
db GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} MemberId
itemMemberId (Just SharedMsgId
sharedMsgId) =
  Connection -> Query -> (ChatItemId, MemberId, SharedMsgId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"DELETE FROM chat_item_moderations WHERE group_id = ? AND item_member_id = ? AND shared_msg_id = ?"
    (ChatItemId
groupId, MemberId
itemMemberId, SharedMsgId
sharedMsgId)

createGroupSndStatus :: DB.Connection -> ChatItemId -> GroupMemberId -> GroupSndStatus -> IO ()
createGroupSndStatus :: Connection -> ChatItemId -> ChatItemId -> GroupSndStatus -> IO ()
createGroupSndStatus Connection
db ChatItemId
itemId ChatItemId
memberId GroupSndStatus
status =
  Connection
-> Query -> (ChatItemId, ChatItemId, GroupSndStatus) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"INSERT INTO group_snd_item_statuses (chat_item_id, group_member_id, group_snd_item_status) VALUES (?,?,?)"
    (ChatItemId
itemId, ChatItemId
memberId, GroupSndStatus
status)

getGroupSndStatus :: DB.Connection -> ChatItemId -> GroupMemberId -> ExceptT StoreError IO GroupSndStatus
getGroupSndStatus :: Connection
-> ChatItemId -> ChatItemId -> ExceptT StoreError IO GroupSndStatus
getGroupSndStatus Connection
db ChatItemId
itemId ChatItemId
memberId =
  IO (Either StoreError GroupSndStatus)
-> ExceptT StoreError IO GroupSndStatus
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError GroupSndStatus)
 -> ExceptT StoreError IO GroupSndStatus)
-> (IO [Only GroupSndStatus]
    -> IO (Either StoreError GroupSndStatus))
-> IO [Only GroupSndStatus]
-> ExceptT StoreError IO GroupSndStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only GroupSndStatus -> GroupSndStatus)
-> StoreError
-> IO [Only GroupSndStatus]
-> IO (Either StoreError GroupSndStatus)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only GroupSndStatus -> GroupSndStatus
forall a. Only a -> a
fromOnly (ChatItemId -> ChatItemId -> StoreError
SENoGroupSndStatus ChatItemId
itemId ChatItemId
memberId) (IO [Only GroupSndStatus] -> ExceptT StoreError IO GroupSndStatus)
-> IO [Only GroupSndStatus] -> ExceptT StoreError IO GroupSndStatus
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query -> (ChatItemId, ChatItemId) -> IO [Only GroupSndStatus]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT group_snd_item_status
        FROM group_snd_item_statuses
        WHERE chat_item_id = ? AND group_member_id = ?
        LIMIT 1
      |]
      (ChatItemId
itemId, ChatItemId
memberId)

updateGroupSndStatus :: DB.Connection -> ChatItemId -> GroupMemberId -> GroupSndStatus -> IO ()
updateGroupSndStatus :: Connection -> ChatItemId -> ChatItemId -> GroupSndStatus -> IO ()
updateGroupSndStatus Connection
db ChatItemId
itemId ChatItemId
memberId GroupSndStatus
status = do
  UTCTime
currentTs <- IO UTCTime -> IO UTCTime
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  Connection
-> Query
-> (GroupSndStatus, UTCTime, ChatItemId, ChatItemId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE group_snd_item_statuses
      SET group_snd_item_status = ?, updated_at = ?
      WHERE chat_item_id = ? AND group_member_id  = ?
    |]
    (GroupSndStatus
status, UTCTime
currentTs, ChatItemId
itemId, ChatItemId
memberId)

setGroupSndViaProxy :: DB.Connection -> ChatItemId -> GroupMemberId -> Bool -> IO ()
setGroupSndViaProxy :: Connection -> ChatItemId -> ChatItemId -> Bool -> IO ()
setGroupSndViaProxy Connection
db ChatItemId
itemId ChatItemId
memberId Bool
viaProxy =
  Connection -> Query -> (BoolInt, ChatItemId, ChatItemId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE group_snd_item_statuses
      SET via_proxy = ?
      WHERE chat_item_id = ? AND group_member_id  = ?
    |]
    (Bool -> BoolInt
BI Bool
viaProxy, ChatItemId
itemId, ChatItemId
memberId)

getGroupSndStatuses :: DB.Connection -> ChatItemId -> IO [MemberDeliveryStatus]
getGroupSndStatuses :: Connection -> ChatItemId -> IO [MemberDeliveryStatus]
getGroupSndStatuses Connection
db ChatItemId
itemId =
  ((ChatItemId, GroupSndStatus, Maybe BoolInt)
 -> MemberDeliveryStatus)
-> [(ChatItemId, GroupSndStatus, Maybe BoolInt)]
-> [MemberDeliveryStatus]
forall a b. (a -> b) -> [a] -> [b]
map (ChatItemId, GroupSndStatus, Maybe BoolInt) -> MemberDeliveryStatus
memStatus
    ([(ChatItemId, GroupSndStatus, Maybe BoolInt)]
 -> [MemberDeliveryStatus])
-> IO [(ChatItemId, GroupSndStatus, Maybe BoolInt)]
-> IO [MemberDeliveryStatus]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> Only ChatItemId
-> IO [(ChatItemId, GroupSndStatus, Maybe BoolInt)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT group_member_id, group_snd_item_status, via_proxy
        FROM group_snd_item_statuses
        WHERE chat_item_id = ?
      |]
      (ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
itemId)
  where
    memStatus :: (ChatItemId, GroupSndStatus, Maybe BoolInt) -> MemberDeliveryStatus
memStatus (ChatItemId
groupMemberId, GroupSndStatus
memberDeliveryStatus, Maybe BoolInt
sentViaProxy) =
      MemberDeliveryStatus {ChatItemId
groupMemberId :: ChatItemId
groupMemberId :: ChatItemId
groupMemberId, GroupSndStatus
memberDeliveryStatus :: GroupSndStatus
memberDeliveryStatus :: GroupSndStatus
memberDeliveryStatus, sentViaProxy :: Maybe Bool
sentViaProxy = BoolInt -> Bool
unBI (BoolInt -> Bool) -> Maybe BoolInt -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BoolInt
sentViaProxy}

getGroupSndStatusCounts :: DB.Connection -> ChatItemId -> IO [(GroupSndStatus, Int)]
getGroupSndStatusCounts :: Connection -> ChatItemId -> IO [(GroupSndStatus, Int)]
getGroupSndStatusCounts Connection
db ChatItemId
itemId =
  Connection
-> Query -> Only ChatItemId -> IO [(GroupSndStatus, Int)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
    Connection
db
    [sql|
      SELECT group_snd_item_status, COUNT(1)
      FROM group_snd_item_statuses
      WHERE chat_item_id = ?
      GROUP BY group_snd_item_status
    |]
    (ChatItemId -> Only ChatItemId
forall a. a -> Only a
Only ChatItemId
itemId)

getGroupHistoryItems :: DB.Connection -> User -> GroupInfo -> GroupMember -> Int -> IO [Either StoreError (CChatItem 'CTGroup)]
getGroupHistoryItems :: Connection
-> User
-> GroupInfo
-> GroupMember
-> Int
-> IO [Either StoreError (CChatItem 'CTGroup)]
getGroupHistoryItems Connection
db user :: User
user@User {ChatItemId
userId :: User -> ChatItemId
userId :: ChatItemId
userId} g :: GroupInfo
g@GroupInfo {ChatItemId
groupId :: GroupInfo -> ChatItemId
groupId :: ChatItemId
groupId} GroupMember
m Int
count = do
  [ChatItemId]
ciIds <- IO [ChatItemId]
getLastItemIds_
  [Either StoreError (CChatItem 'CTGroup)]
-> [Either StoreError (CChatItem 'CTGroup)]
forall a. [a] -> [a]
reverse ([Either StoreError (CChatItem 'CTGroup)]
 -> [Either StoreError (CChatItem 'CTGroup)])
-> IO [Either StoreError (CChatItem 'CTGroup)]
-> IO [Either StoreError (CChatItem 'CTGroup)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ChatItemId -> IO (Either StoreError (CChatItem 'CTGroup)))
-> [ChatItemId] -> IO [Either StoreError (CChatItem 'CTGroup)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ExceptT StoreError IO (CChatItem 'CTGroup)
-> IO (Either StoreError (CChatItem 'CTGroup))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO (CChatItem 'CTGroup)
 -> IO (Either StoreError (CChatItem 'CTGroup)))
-> (ChatItemId -> ExceptT StoreError IO (CChatItem 'CTGroup))
-> ChatItemId
-> IO (Either StoreError (CChatItem 'CTGroup))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> User
-> GroupInfo
-> ChatItemId
-> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupCIWithReactions Connection
db User
user GroupInfo
g) [ChatItemId]
ciIds
  where
    getLastItemIds_ :: IO [ChatItemId]
    getLastItemIds_ :: IO [ChatItemId]
getLastItemIds_ =
      (Only ChatItemId -> ChatItemId)
-> [Only ChatItemId] -> [ChatItemId]
forall a b. (a -> b) -> [a] -> [b]
map Only ChatItemId -> ChatItemId
forall a. Only a -> a
fromOnly
        ([Only ChatItemId] -> [ChatItemId])
-> IO [Only ChatItemId] -> IO [ChatItemId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (ChatItemId, ChatItemId, ChatItemId, Int)
-> IO [Only ChatItemId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
          Connection
db
          [sql|
            SELECT i.chat_item_id
            FROM chat_items i
            LEFT JOIN group_snd_item_statuses s ON s.chat_item_id = i.chat_item_id AND s.group_member_id = ?
            WHERE s.group_snd_item_status_id IS NULL
              AND i.user_id = ? AND i.group_id = ?
              AND i.include_in_history = 1
              AND i.item_deleted = 0
            ORDER BY i.item_ts DESC, i.chat_item_id DESC
            LIMIT ?
          |]
          (GroupMember -> ChatItemId
groupMemberId' GroupMember
m, ChatItemId
userId, ChatItemId
groupId, Int
count)