mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-05-25 02:05:40 +00:00
core: sending messages with files (#507)
Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
This commit is contained in:
JRoberts
@@ -94,8 +94,8 @@ data ChatCommand
|
||||
| APIGetChats
|
||||
| APIGetChat ChatType Int64 ChatPagination
|
||||
| APIGetChatItems Int
|
||||
| APISendMessage ChatType Int64 (Maybe FilePath) MsgContent
|
||||
| APISendMessageQuote ChatType Int64 ChatItemId (Maybe FilePath) MsgContent
|
||||
| APISendMessage ChatType Int64 (Maybe FilePath) (Maybe ChatItemId) MsgContent
|
||||
| APISendMessageQuote ChatType Int64 ChatItemId MsgContent -- TODO discontinue
|
||||
| APIUpdateChatItem ChatType Int64 ChatItemId MsgContent
|
||||
| APIDeleteChatItem ChatType Int64 ChatItemId CIDeleteMode
|
||||
| APIChatRead ChatType Int64 (ChatItemId, ChatItemId)
|
||||
|
||||
@@ -20,7 +20,6 @@ import qualified Data.ByteString.Base64 as B64
|
||||
import qualified Data.ByteString.Lazy.Char8 as LB
|
||||
import Data.Int (Int64)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
|
||||
import Data.Time.Clock (UTCTime, diffUTCTime, nominalDay)
|
||||
import Data.Time.LocalTime (TimeZone, ZonedTime, utcToZonedTime)
|
||||
@@ -80,11 +79,11 @@ data ChatItem (c :: ChatType) (d :: MsgDirection) = ChatItem
|
||||
content :: CIContent d,
|
||||
formattedText :: Maybe MarkdownList,
|
||||
quotedItem :: Maybe (CIQuote c),
|
||||
file :: Maybe CIFile
|
||||
file :: Maybe (CIFile d)
|
||||
}
|
||||
deriving (Show, Generic)
|
||||
|
||||
instance ToJSON (ChatItem c d) where
|
||||
instance MsgDirectionI d => ToJSON (ChatItem c d) where
|
||||
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
|
||||
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
|
||||
|
||||
@@ -197,7 +196,7 @@ instance ToJSON AChatItem where
|
||||
data JSONAnyChatItem c d = JSONAnyChatItem {chatInfo :: ChatInfo c, chatItem :: ChatItem c d}
|
||||
deriving (Generic)
|
||||
|
||||
instance ToJSON (JSONAnyChatItem c d) where
|
||||
instance MsgDirectionI d => ToJSON (JSONAnyChatItem c d) where
|
||||
toJSON = J.genericToJSON J.defaultOptions
|
||||
toEncoding = J.genericToEncoding J.defaultOptions
|
||||
|
||||
@@ -266,16 +265,63 @@ quoteMsgDirection = \case
|
||||
CIQGroupSnd -> MDSnd
|
||||
CIQGroupRcv _ -> MDRcv
|
||||
|
||||
data CIFile = CIFile
|
||||
{ file :: FilePath, -- local file path
|
||||
loaded :: Bool
|
||||
data CIFile (d :: MsgDirection) = CIFile
|
||||
{ fileId :: Int64,
|
||||
fileName :: String,
|
||||
fileSize :: Integer,
|
||||
filePath :: Maybe FilePath, -- local file path
|
||||
fileStatus :: CIFileStatus d
|
||||
}
|
||||
deriving (Show, Generic)
|
||||
|
||||
instance ToJSON CIFile where
|
||||
instance MsgDirectionI d => ToJSON (CIFile d) where
|
||||
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
|
||||
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
|
||||
|
||||
data CIFileStatus (d :: MsgDirection) where
|
||||
CIFSSndStored :: CIFileStatus 'MDSnd
|
||||
CIFSSndCancelled :: CIFileStatus 'MDSnd
|
||||
CIFSRcvInvitation :: CIFileStatus 'MDRcv
|
||||
CIFSRcvTransfer :: CIFileStatus 'MDRcv
|
||||
CIFSRcvComplete :: CIFileStatus 'MDRcv
|
||||
CIFSRcvCancelled :: CIFileStatus 'MDRcv
|
||||
|
||||
deriving instance Show (CIFileStatus d)
|
||||
|
||||
instance MsgDirectionI d => ToJSON (CIFileStatus d) where
|
||||
toJSON = strToJSON
|
||||
toEncoding = strToJEncoding
|
||||
|
||||
instance MsgDirectionI d => ToField (CIFileStatus d) where toField = toField . decodeLatin1 . strEncode
|
||||
|
||||
instance FromField ACIFileStatus where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
|
||||
|
||||
data ACIFileStatus = forall d. MsgDirectionI d => AFS (SMsgDirection d) (CIFileStatus d)
|
||||
|
||||
deriving instance Show ACIFileStatus
|
||||
|
||||
instance MsgDirectionI d => StrEncoding (CIFileStatus d) where
|
||||
strEncode = \case
|
||||
CIFSSndStored -> "snd_stored"
|
||||
CIFSSndCancelled -> "snd_cancelled"
|
||||
CIFSRcvInvitation -> "rcv_invitation"
|
||||
CIFSRcvTransfer -> "rcv_transfer"
|
||||
CIFSRcvComplete -> "rcv_complete"
|
||||
CIFSRcvCancelled -> "rcv_cancelled"
|
||||
strP = (\(AFS _ st) -> checkDirection st) <$?> strP
|
||||
|
||||
instance StrEncoding ACIFileStatus where
|
||||
strEncode (AFS _ s) = strEncode s
|
||||
strP =
|
||||
A.takeTill (== ' ') >>= \case
|
||||
"snd_stored" -> pure $ AFS SMDSnd CIFSSndStored
|
||||
"snd_cancelled" -> pure $ AFS SMDSnd CIFSSndCancelled
|
||||
"rcv_invitation" -> pure $ AFS SMDRcv CIFSRcvInvitation
|
||||
"rcv_transfer" -> pure $ AFS SMDRcv CIFSRcvTransfer
|
||||
"rcv_complete" -> pure $ AFS SMDRcv CIFSRcvComplete
|
||||
"rcv_cancelled" -> pure $ AFS SMDRcv CIFSRcvCancelled
|
||||
_ -> fail "bad file status"
|
||||
|
||||
data CIStatus (d :: MsgDirection) where
|
||||
CISSndNew :: CIStatus 'MDSnd
|
||||
CISSndSent :: CIStatus 'MDSnd
|
||||
@@ -377,8 +423,6 @@ data CIContent (d :: MsgDirection) where
|
||||
CIRcvMsgContent :: MsgContent -> CIContent 'MDRcv
|
||||
CISndDeleted :: CIDeleteMode -> CIContent 'MDSnd
|
||||
CIRcvDeleted :: CIDeleteMode -> CIContent 'MDRcv
|
||||
CISndFileInvitation :: FileTransferId -> FilePath -> CIContent 'MDSnd
|
||||
CIRcvFileInvitation :: RcvFileTransfer -> CIContent 'MDRcv
|
||||
|
||||
deriving instance Show (CIContent d)
|
||||
|
||||
@@ -388,8 +432,6 @@ ciContentToText = \case
|
||||
CIRcvMsgContent mc -> msgContentText mc
|
||||
CISndDeleted cidm -> ciDeleteModeToText cidm
|
||||
CIRcvDeleted cidm -> ciDeleteModeToText cidm
|
||||
CISndFileInvitation fId fPath -> "you sent file #" <> T.pack (show fId) <> ": " <> T.pack fPath
|
||||
CIRcvFileInvitation RcvFileTransfer {fileInvitation = FileInvitation {fileName}} -> "file " <> T.pack fileName
|
||||
|
||||
msgDirToDeletedContent_ :: SMsgDirection d -> CIDeleteMode -> CIContent d
|
||||
msgDirToDeletedContent_ msgDir mode = case msgDir of
|
||||
@@ -422,8 +464,6 @@ data JSONCIContent
|
||||
| JCIRcvMsgContent {msgContent :: MsgContent}
|
||||
| JCISndDeleted {deleteMode :: CIDeleteMode}
|
||||
| JCIRcvDeleted {deleteMode :: CIDeleteMode}
|
||||
| JCISndFileInvitation {fileId :: FileTransferId, filePath :: FilePath}
|
||||
| JCIRcvFileInvitation {rcvFileTransfer :: RcvFileTransfer}
|
||||
deriving (Generic)
|
||||
|
||||
instance FromJSON JSONCIContent where
|
||||
@@ -439,8 +479,6 @@ jsonCIContent = \case
|
||||
CIRcvMsgContent mc -> JCIRcvMsgContent mc
|
||||
CISndDeleted cidm -> JCISndDeleted cidm
|
||||
CIRcvDeleted cidm -> JCIRcvDeleted cidm
|
||||
CISndFileInvitation fId fPath -> JCISndFileInvitation fId fPath
|
||||
CIRcvFileInvitation ft -> JCIRcvFileInvitation ft
|
||||
|
||||
aciContentJSON :: JSONCIContent -> ACIContent
|
||||
aciContentJSON = \case
|
||||
@@ -448,8 +486,6 @@ aciContentJSON = \case
|
||||
JCIRcvMsgContent mc -> ACIContent SMDRcv $ CIRcvMsgContent mc
|
||||
JCISndDeleted cidm -> ACIContent SMDSnd $ CISndDeleted cidm
|
||||
JCIRcvDeleted cidm -> ACIContent SMDRcv $ CIRcvDeleted cidm
|
||||
JCISndFileInvitation fId fPath -> ACIContent SMDSnd $ CISndFileInvitation fId fPath
|
||||
JCIRcvFileInvitation ft -> ACIContent SMDRcv $ CIRcvFileInvitation ft
|
||||
|
||||
-- platform independent
|
||||
data DBJSONCIContent
|
||||
@@ -457,8 +493,6 @@ data DBJSONCIContent
|
||||
| DBJCIRcvMsgContent {msgContent :: MsgContent}
|
||||
| DBJCISndDeleted {deleteMode :: CIDeleteMode}
|
||||
| DBJCIRcvDeleted {deleteMode :: CIDeleteMode}
|
||||
| DBJCISndFileInvitation {fileId :: FileTransferId, filePath :: FilePath}
|
||||
| DBJCIRcvFileInvitation {rcvFileTransfer :: RcvFileTransfer}
|
||||
deriving (Generic)
|
||||
|
||||
instance FromJSON DBJSONCIContent where
|
||||
@@ -474,8 +508,6 @@ dbJsonCIContent = \case
|
||||
CIRcvMsgContent mc -> DBJCIRcvMsgContent mc
|
||||
CISndDeleted cidm -> DBJCISndDeleted cidm
|
||||
CIRcvDeleted cidm -> DBJCIRcvDeleted cidm
|
||||
CISndFileInvitation fId fPath -> DBJCISndFileInvitation fId fPath
|
||||
CIRcvFileInvitation ft -> DBJCIRcvFileInvitation ft
|
||||
|
||||
aciContentDBJSON :: DBJSONCIContent -> ACIContent
|
||||
aciContentDBJSON = \case
|
||||
@@ -483,8 +515,6 @@ aciContentDBJSON = \case
|
||||
DBJCIRcvMsgContent mc -> ACIContent SMDRcv $ CIRcvMsgContent mc
|
||||
DBJCISndDeleted cidm -> ACIContent SMDSnd $ CISndDeleted cidm
|
||||
DBJCIRcvDeleted cidm -> ACIContent SMDRcv $ CIRcvDeleted cidm
|
||||
DBJCISndFileInvitation fId fPath -> ACIContent SMDSnd $ CISndFileInvitation fId fPath
|
||||
DBJCIRcvFileInvitation ft -> ACIContent SMDRcv $ CIRcvFileInvitation ft
|
||||
|
||||
data SChatType (c :: ChatType) where
|
||||
SCTDirect :: SChatType 'CTDirect
|
||||
|
||||
@@ -1,12 +0,0 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20220404_files_cancelled where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20220404_files_cancelled :: Query
|
||||
m20220404_files_cancelled =
|
||||
[sql|
|
||||
ALTER TABLE files ADD COLUMN cancelled INTEGER; -- 1 for cancelled
|
||||
|]
|
||||
@@ -0,0 +1,19 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20220404_files_status_fields where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20220404_files_status_fields :: Query
|
||||
m20220404_files_status_fields =
|
||||
[sql|
|
||||
ALTER TABLE files ADD COLUMN cancelled INTEGER; -- 1 for cancelled
|
||||
ALTER TABLE files ADD COLUMN ci_file_status TEXT; -- CIFileStatus
|
||||
|
||||
DELETE FROM chat_items
|
||||
WHERE chat_item_id IN (
|
||||
SELECT chat_item_id
|
||||
FROM files
|
||||
);
|
||||
|]
|
||||
@@ -134,7 +134,7 @@ CREATE TABLE files (
|
||||
chunk_size INTEGER NOT NULL,
|
||||
created_at TEXT NOT NULL DEFAULT (datetime('now')),
|
||||
user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE
|
||||
, chat_item_id INTEGER DEFAULT NULL REFERENCES chat_items ON DELETE CASCADE, updated_at TEXT CHECK (updated_at NOT NULL), cancelled INTEGER);
|
||||
, chat_item_id INTEGER DEFAULT NULL REFERENCES chat_items ON DELETE CASCADE, updated_at TEXT CHECK (updated_at NOT NULL), cancelled INTEGER, ci_file_status TEXT);
|
||||
CREATE TABLE snd_files (
|
||||
file_id INTEGER NOT NULL REFERENCES files ON DELETE CASCADE,
|
||||
connection_id INTEGER NOT NULL REFERENCES connections ON DELETE CASCADE,
|
||||
|
||||
@@ -112,7 +112,7 @@ data ChatMsgEvent
|
||||
| XMsgUpdate SharedMsgId MsgContent
|
||||
| XMsgDel SharedMsgId
|
||||
| XMsgDeleted
|
||||
| XFile FileInvitation
|
||||
| XFile FileInvitation -- TODO discontinue
|
||||
| XFileAcpt String -- old file protocol
|
||||
| XFileAcptInv SharedMsgId ConnReqInvitation String -- new file protocol
|
||||
| XInfo Profile
|
||||
@@ -176,11 +176,11 @@ data MsgContainer
|
||||
| MCForward ExtMsgContent
|
||||
deriving (Eq, Show)
|
||||
|
||||
mcContent :: MsgContainer -> MsgContent
|
||||
mcContent = \case
|
||||
MCSimple (ExtMsgContent c _) -> c
|
||||
MCQuote _ (ExtMsgContent c _) -> c
|
||||
MCForward (ExtMsgContent c _) -> c
|
||||
mcExtMsgContent :: MsgContainer -> ExtMsgContent
|
||||
mcExtMsgContent = \case
|
||||
MCSimple c -> c
|
||||
MCQuote _ c -> c
|
||||
MCForward c -> c
|
||||
|
||||
data LinkPreview = LinkPreview {uri :: Text, title :: Text, description :: Text, image :: ImageData}
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
+98
-45
@@ -95,6 +95,7 @@ module Simplex.Chat.Store
|
||||
createSndGroupFileTransferV2,
|
||||
createSndGroupFileTransferV2Connection,
|
||||
updateFileCancelled,
|
||||
updateCIFileStatus,
|
||||
getSharedMsgIdByFileId,
|
||||
getFileIdBySharedMsgId,
|
||||
getGroupFileIdBySharedMsgId,
|
||||
@@ -188,7 +189,7 @@ import Simplex.Chat.Migrations.M20220301_smp_servers
|
||||
import Simplex.Chat.Migrations.M20220302_profile_images
|
||||
import Simplex.Chat.Migrations.M20220304_msg_quotes
|
||||
import Simplex.Chat.Migrations.M20220321_chat_item_edited
|
||||
import Simplex.Chat.Migrations.M20220404_files_cancelled
|
||||
import Simplex.Chat.Migrations.M20220404_files_status_fields
|
||||
import Simplex.Chat.Protocol
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Util (eitherToMaybe)
|
||||
@@ -213,7 +214,7 @@ schemaMigrations =
|
||||
("20220302_profile_images", m20220302_profile_images),
|
||||
("20220304_msg_quotes", m20220304_msg_quotes),
|
||||
("20220321_chat_item_edited", m20220321_chat_item_edited),
|
||||
("20220404_files_cancelled", m20220404_files_cancelled)
|
||||
("20220404_files_status_fields", m20220404_files_status_fields)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
@@ -1783,14 +1784,14 @@ getViaGroupContact st User {userId} GroupMember {groupMemberId} =
|
||||
in Just Contact {contactId, localDisplayName, profile, activeConn, viaGroup, createdAt}
|
||||
toContact' _ = Nothing
|
||||
|
||||
createSndFileTransfer :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> FilePath -> FileInvitation -> ConnId -> Integer -> m SndFileTransfer
|
||||
createSndFileTransfer st userId Contact {contactId, localDisplayName = recipientDisplayName} filePath FileInvitation {fileName, fileSize} acId chunkSize =
|
||||
createSndFileTransfer :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> FilePath -> FileInvitation -> ConnId -> Integer -> m Int64
|
||||
createSndFileTransfer st userId Contact {contactId} filePath FileInvitation {fileName, fileSize} acId chunkSize =
|
||||
liftIO . withTransaction st $ \db -> do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO files (user_id, contact_id, file_name, file_path, file_size, chunk_size, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
|
||||
(userId, contactId, fileName, filePath, fileSize, chunkSize, currentTs, currentTs)
|
||||
"INSERT INTO files (user_id, contact_id, file_name, file_path, file_size, chunk_size, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
|
||||
(userId, contactId, fileName, filePath, fileSize, chunkSize, CIFSSndStored, currentTs, currentTs)
|
||||
fileId <- insertedRowId db
|
||||
Connection {connId} <- createSndFileConnection_ db userId fileId acId
|
||||
let fileStatus = FSNew
|
||||
@@ -1798,7 +1799,7 @@ createSndFileTransfer st userId Contact {contactId, localDisplayName = recipient
|
||||
db
|
||||
"INSERT INTO snd_files (file_id, file_status, connection_id, created_at, updated_at) VALUES (?,?,?,?,?)"
|
||||
(fileId, fileStatus, connId, currentTs, currentTs)
|
||||
pure SndFileTransfer {fileId, fileName, filePath, fileSize, chunkSize, recipientDisplayName, connId, fileStatus, agentConnId = AgentConnId acId}
|
||||
pure fileId
|
||||
|
||||
createSndFileTransferV2 :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> FilePath -> FileInvitation -> Integer -> m Int64
|
||||
createSndFileTransferV2 st userId Contact {contactId} filePath FileInvitation {fileName, fileSize} chunkSize =
|
||||
@@ -1806,8 +1807,8 @@ createSndFileTransferV2 st userId Contact {contactId} filePath FileInvitation {f
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO files (user_id, contact_id, file_name, file_path, file_size, chunk_size, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
|
||||
(userId, contactId, fileName, filePath, fileSize, chunkSize, currentTs, currentTs)
|
||||
"INSERT INTO files (user_id, contact_id, file_name, file_path, file_size, chunk_size, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
|
||||
(userId, contactId, fileName, filePath, fileSize, chunkSize, CIFSSndStored, currentTs, currentTs)
|
||||
insertedRowId db
|
||||
|
||||
createSndFileTransferV2Connection :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> ConnId -> m ()
|
||||
@@ -1827,8 +1828,8 @@ createSndGroupFileTransfer st userId GroupInfo {groupId} ms filePath fileSize ch
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO files (user_id, group_id, file_name, file_path, file_size, chunk_size, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
|
||||
(userId, groupId, fileName, filePath, fileSize, chunkSize, currentTs, currentTs)
|
||||
"INSERT INTO files (user_id, group_id, file_name, file_path, file_size, chunk_size, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
|
||||
(userId, groupId, fileName, filePath, fileSize, chunkSize, CIFSSndStored, currentTs, currentTs)
|
||||
fileId <- insertedRowId db
|
||||
forM_ ms $ \(GroupMember {groupMemberId}, agentConnId, _) -> do
|
||||
Connection {connId} <- createSndFileConnection_ db userId fileId agentConnId
|
||||
@@ -1844,8 +1845,8 @@ createSndGroupFileTransferV2 st userId GroupInfo {groupId} filePath FileInvitati
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO files (user_id, group_id, file_name, file_path, file_size, chunk_size, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
|
||||
(userId, groupId, fileName, filePath, fileSize, chunkSize, currentTs, currentTs)
|
||||
"INSERT INTO files (user_id, group_id, file_name, file_path, file_size, chunk_size, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
|
||||
(userId, groupId, fileName, filePath, fileSize, chunkSize, CIFSSndStored, currentTs, currentTs)
|
||||
insertedRowId db
|
||||
|
||||
createSndGroupFileTransferV2Connection :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> ConnId -> GroupMember -> m ()
|
||||
@@ -1864,6 +1865,12 @@ updateFileCancelled st userId fileId =
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute db "UPDATE files SET cancelled = 1, updated_at = ? WHERE user_id = ? AND file_id = ?" (currentTs, userId, fileId)
|
||||
|
||||
updateCIFileStatus :: MsgDirectionI d => MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> CIFileStatus d -> m ()
|
||||
updateCIFileStatus st userId fileId ciFileStatus =
|
||||
liftIO . withTransaction st $ \db -> do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute db "UPDATE files SET ci_file_status = ?, updated_at = ? WHERE user_id = ? AND file_id = ?" (ciFileStatus, currentTs, userId, fileId)
|
||||
|
||||
getSharedMsgIdByFileId :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> m SharedMsgId
|
||||
getSharedMsgIdByFileId st userId fileId =
|
||||
liftIOEither . withTransaction st $ \db ->
|
||||
@@ -1975,8 +1982,8 @@ createRcvFileTransfer st userId Contact {contactId, localDisplayName = c} f@File
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO files (user_id, contact_id, file_name, file_size, chunk_size, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
|
||||
(userId, contactId, fileName, fileSize, chunkSize, currentTs, currentTs)
|
||||
"INSERT INTO files (user_id, contact_id, file_name, file_size, chunk_size, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
|
||||
(userId, contactId, fileName, fileSize, chunkSize, CIFSRcvInvitation, currentTs, currentTs)
|
||||
fileId <- insertedRowId db
|
||||
DB.execute
|
||||
db
|
||||
@@ -2052,8 +2059,8 @@ acceptRcvFileTransfer st userId fileId agentConnId filePath =
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE files SET file_path = ?, updated_at = ? WHERE user_id = ? AND file_id = ?"
|
||||
(filePath, currentTs, userId, fileId)
|
||||
"UPDATE files SET file_path = ?, ci_file_status = ?, updated_at = ? WHERE user_id = ? AND file_id = ?"
|
||||
(filePath, CIFSRcvTransfer, currentTs, userId, fileId)
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE rcv_files SET file_status = ?, updated_at = ? WHERE file_id = ?"
|
||||
@@ -2512,6 +2519,8 @@ getDirectChatPreviews_ db User {userId} = do
|
||||
COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0),
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
|
||||
-- DirectQuote
|
||||
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent
|
||||
FROM contacts ct
|
||||
@@ -2525,6 +2534,7 @@ getDirectChatPreviews_ db User {userId} = do
|
||||
) MaxIds ON MaxIds.contact_id = ct.contact_id
|
||||
LEFT JOIN chat_items i ON i.contact_id = MaxIds.contact_id
|
||||
AND i.chat_item_id = MaxIds.MaxId
|
||||
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
|
||||
LEFT JOIN (
|
||||
SELECT contact_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||
FROM chat_items
|
||||
@@ -2574,6 +2584,8 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
|
||||
COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0),
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
|
||||
-- Maybe GroupMember - sender
|
||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
|
||||
m.member_status, m.invited_by, m.local_display_name, m.contact_id,
|
||||
@@ -2596,6 +2608,7 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
|
||||
) MaxIds ON MaxIds.group_id = g.group_id
|
||||
LEFT JOIN chat_items i ON i.group_id = MaxIds.group_id
|
||||
AND i.chat_item_id = MaxIds.MaxId
|
||||
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
|
||||
LEFT JOIN (
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||
FROM chat_items
|
||||
@@ -2667,9 +2680,12 @@ getDirectChatLast_ db User {userId} contactId count = do
|
||||
SELECT
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
|
||||
-- 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 i.quoted_shared_msg_id = ri.shared_msg_id
|
||||
WHERE i.user_id = ? AND i.contact_id = ? AND i.item_deleted != 1
|
||||
ORDER BY i.chat_item_id DESC
|
||||
@@ -2695,9 +2711,12 @@ getDirectChatAfter_ db User {userId} contactId afterChatItemId count = do
|
||||
SELECT
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
|
||||
-- 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 i.quoted_shared_msg_id = ri.shared_msg_id
|
||||
WHERE i.user_id = ? AND i.contact_id = ? AND i.chat_item_id > ? AND i.item_deleted != 1
|
||||
ORDER BY i.chat_item_id ASC
|
||||
@@ -2723,9 +2742,12 @@ getDirectChatBefore_ db User {userId} contactId beforeChatItemId count = do
|
||||
SELECT
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
|
||||
-- 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 i.quoted_shared_msg_id = ri.shared_msg_id
|
||||
WHERE i.user_id = ? AND i.contact_id = ? AND i.chat_item_id < ? AND i.item_deleted != 1
|
||||
ORDER BY i.chat_item_id DESC
|
||||
@@ -2823,6 +2845,8 @@ getGroupChatLast_ db user@User {userId, userContactId} groupId count = do
|
||||
SELECT
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
|
||||
-- GroupMember
|
||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
|
||||
m.member_status, m.invited_by, m.local_display_name, m.contact_id,
|
||||
@@ -2834,6 +2858,7 @@ getGroupChatLast_ db user@User {userId, userContactId} groupId count = do
|
||||
rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id,
|
||||
rp.display_name, rp.full_name, rp.image
|
||||
FROM chat_items i
|
||||
LEFT JOIN files f ON f.chat_item_id = i.chat_item_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 = m.contact_profile_id
|
||||
LEFT JOIN chat_items ri ON i.quoted_shared_msg_id = ri.shared_msg_id
|
||||
@@ -2863,6 +2888,8 @@ getGroupChatAfter_ db user@User {userId, userContactId} groupId afterChatItemId
|
||||
SELECT
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
|
||||
-- GroupMember
|
||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
|
||||
m.member_status, m.invited_by, m.local_display_name, m.contact_id,
|
||||
@@ -2874,6 +2901,7 @@ getGroupChatAfter_ db user@User {userId, userContactId} groupId afterChatItemId
|
||||
rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id,
|
||||
rp.display_name, rp.full_name, rp.image
|
||||
FROM chat_items i
|
||||
LEFT JOIN files f ON f.chat_item_id = i.chat_item_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 = m.contact_profile_id
|
||||
LEFT JOIN chat_items ri ON i.quoted_shared_msg_id = ri.shared_msg_id
|
||||
@@ -2903,6 +2931,8 @@ getGroupChatBefore_ db user@User {userId, userContactId} groupId beforeChatItemI
|
||||
SELECT
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
|
||||
-- GroupMember
|
||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
|
||||
m.member_status, m.invited_by, m.local_display_name, m.contact_id,
|
||||
@@ -2914,6 +2944,7 @@ getGroupChatBefore_ db user@User {userId, userContactId} groupId beforeChatItemI
|
||||
rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id,
|
||||
rp.display_name, rp.full_name, rp.image
|
||||
FROM chat_items i
|
||||
LEFT JOIN files f ON f.chat_item_id = i.chat_item_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 = m.contact_profile_id
|
||||
LEFT JOIN chat_items ri ON i.quoted_shared_msg_id = ri.shared_msg_id
|
||||
@@ -3138,9 +3169,12 @@ getDirectChatItem_ db userId contactId itemId = do
|
||||
SELECT
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
|
||||
-- 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 i.quoted_shared_msg_id = ri.shared_msg_id
|
||||
WHERE i.user_id = ? AND i.contact_id = ? AND i.chat_item_id = ?
|
||||
|]
|
||||
@@ -3265,6 +3299,8 @@ getGroupChatItem_ db User {userId, userContactId} groupId itemId = do
|
||||
SELECT
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
|
||||
-- GroupMember
|
||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
|
||||
m.member_status, m.invited_by, m.local_display_name, m.contact_id,
|
||||
@@ -3276,6 +3312,7 @@ getGroupChatItem_ db User {userId, userContactId} groupId itemId = do
|
||||
rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id,
|
||||
rp.display_name, rp.full_name, rp.image
|
||||
FROM chat_items i
|
||||
LEFT JOIN files f ON f.chat_item_id = i.chat_item_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 = m.contact_profile_id
|
||||
LEFT JOIN chat_items ri ON i.quoted_shared_msg_id = ri.shared_msg_id
|
||||
@@ -3359,20 +3396,14 @@ type ChatStatsRow = (Int, ChatItemId)
|
||||
toChatStats :: ChatStatsRow -> ChatStats
|
||||
toChatStats (unreadCount, minUnreadItemId) = ChatStats {unreadCount, minUnreadItemId}
|
||||
|
||||
type ChatItemRow = (Int64, ChatItemTs, ACIContent, Text, ACIStatus, Maybe SharedMsgId, Bool, Maybe Bool, UTCTime)
|
||||
type MaybeCIFIleRow = (Maybe Int64, Maybe String, Maybe Integer, Maybe FilePath, Maybe ACIFileStatus)
|
||||
|
||||
type MaybeChatItemRow = (Maybe Int64, Maybe ChatItemTs, Maybe ACIContent, Maybe Text, Maybe ACIStatus, Maybe SharedMsgId, Maybe Bool, Maybe Bool, Maybe UTCTime)
|
||||
type ChatItemRow = (Int64, ChatItemTs, ACIContent, Text, ACIStatus, Maybe SharedMsgId, Bool, Maybe Bool, UTCTime) :. MaybeCIFIleRow
|
||||
|
||||
type MaybeChatItemRow = (Maybe Int64, Maybe ChatItemTs, Maybe ACIContent, Maybe Text, Maybe ACIStatus, Maybe SharedMsgId, Maybe Bool, Maybe Bool, Maybe UTCTime) :. MaybeCIFIleRow
|
||||
|
||||
type QuoteRow = (Maybe ChatItemId, Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool)
|
||||
|
||||
-- type DirectChatItemRow = ChatItemRow :. DirectQuoteRow
|
||||
|
||||
-- type MaybeDirectChatItemRow = MaybeChatItemRow :. DirectQuoteRow
|
||||
|
||||
-- toQuoteData :: QuoteDataRow -> Maybe CIQuoteData
|
||||
-- toQuoteData (quotedItemId, quotedSentAt, quotedMsgContent) =
|
||||
-- CIQuoteData quotedItemId <$> quotedSentAt <*> quotedMsgContent <*> (parseMaybeMarkdownList . msgContentText <$> quotedMsgContent)
|
||||
|
||||
toDirectQuote :: QuoteRow -> Maybe (CIQuote 'CTDirect)
|
||||
toDirectQuote qr@(_, _, _, _, quotedSent) = toQuote qr $ direction <$> quotedSent
|
||||
where
|
||||
@@ -3383,22 +3414,33 @@ toQuote (quotedItemId, quotedSharedMsgId, quotedSentAt, quotedMsgContent, _) dir
|
||||
CIQuote <$> dir <*> pure quotedItemId <*> pure quotedSharedMsgId <*> quotedSentAt <*> quotedMsgContent <*> (parseMaybeMarkdownList . msgContentText <$> quotedMsgContent)
|
||||
|
||||
toDirectChatItem :: TimeZone -> UTCTime -> ChatItemRow :. QuoteRow -> Either StoreError (CChatItem 'CTDirect)
|
||||
toDirectChatItem tz currentTs ((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt) :. quoteRow) =
|
||||
case (itemContent, itemStatus) of
|
||||
(ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus) -> Right $ cItem SMDSnd CIDirectSnd ciStatus ciContent
|
||||
(ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus) -> Right $ cItem SMDRcv CIDirectRcv ciStatus ciContent
|
||||
toDirectChatItem tz currentTs (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_)) :. quoteRow) =
|
||||
case (itemContent, itemStatus, fileStatus_) of
|
||||
(ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, Just (AFS SMDSnd fileStatus)) ->
|
||||
Right $ cItem SMDSnd CIDirectSnd ciStatus ciContent (maybeCIFile fileStatus)
|
||||
(ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, Nothing) ->
|
||||
Right $ cItem SMDSnd CIDirectSnd ciStatus ciContent Nothing
|
||||
(ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus, Just (AFS SMDRcv fileStatus)) ->
|
||||
Right $ cItem SMDRcv CIDirectRcv ciStatus ciContent (maybeCIFile fileStatus)
|
||||
(ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus, Nothing) ->
|
||||
Right $ cItem SMDRcv CIDirectRcv ciStatus ciContent Nothing
|
||||
_ -> badItem
|
||||
where
|
||||
cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTDirect d -> CIStatus d -> CIContent d -> CChatItem 'CTDirect
|
||||
cItem d chatDir ciStatus content =
|
||||
CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toDirectQuote quoteRow, file = Nothing}
|
||||
maybeCIFile :: CIFileStatus d -> Maybe (CIFile d)
|
||||
maybeCIFile fileStatus =
|
||||
case (fileId_, fileName_, fileSize_) of
|
||||
(Just fileId, Just fileName, Just fileSize) -> Just CIFile {fileId, fileName, fileSize, filePath, fileStatus}
|
||||
_ -> Nothing
|
||||
cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTDirect d -> CIStatus d -> CIContent d -> Maybe (CIFile d) -> CChatItem 'CTDirect
|
||||
cItem d chatDir ciStatus content file =
|
||||
CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toDirectQuote quoteRow, file}
|
||||
badItem = Left $ SEBadChatItem itemId
|
||||
ciMeta :: CIContent d -> CIStatus d -> CIMeta d
|
||||
ciMeta content status = mkCIMeta itemId content itemText status sharedMsgId itemDeleted (fromMaybe False itemEdited) tz currentTs itemTs createdAt
|
||||
|
||||
toDirectChatItemList :: TimeZone -> UTCTime -> MaybeChatItemRow :. QuoteRow -> [CChatItem 'CTDirect]
|
||||
toDirectChatItemList tz currentTs ((Just itemId, Just itemTs, Just itemContent, Just itemText, Just itemStatus, sharedMsgId, Just itemDeleted, itemEdited, Just createdAt) :. quoteRow) =
|
||||
either (const []) (: []) $ toDirectChatItem tz currentTs ((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt) :. quoteRow)
|
||||
toDirectChatItemList tz currentTs (((Just itemId, Just itemTs, Just itemContent, Just itemText, Just itemStatus, sharedMsgId, Just itemDeleted, itemEdited, Just createdAt) :. fileRow) :. quoteRow) =
|
||||
either (const []) (: []) $ toDirectChatItem tz currentTs (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt) :. fileRow) :. quoteRow)
|
||||
toDirectChatItemList _ _ _ = []
|
||||
|
||||
type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow
|
||||
@@ -3414,24 +3456,35 @@ toGroupQuote qr@(_, _, _, _, quotedSent) quotedMember_ = toQuote qr $ direction
|
||||
direction _ _ = Nothing
|
||||
|
||||
toGroupChatItem :: TimeZone -> UTCTime -> Int64 -> ChatItemRow :. MaybeGroupMemberRow :. GroupQuoteRow -> Either StoreError (CChatItem 'CTGroup)
|
||||
toGroupChatItem tz currentTs userContactId ((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt) :. memberRow_ :. quoteRow :. quotedMemberRow_) = do
|
||||
toGroupChatItem tz currentTs userContactId (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_)) :. memberRow_ :. quoteRow :. quotedMemberRow_) = do
|
||||
let member_ = toMaybeGroupMember userContactId memberRow_
|
||||
let quotedMember_ = toMaybeGroupMember userContactId quotedMemberRow_
|
||||
case (itemContent, itemStatus, member_) of
|
||||
(ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, _) -> Right $ cItem SMDSnd CIGroupSnd ciStatus ciContent quotedMember_
|
||||
(ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus, Just member) -> Right $ cItem SMDRcv (CIGroupRcv member) ciStatus ciContent quotedMember_
|
||||
case (itemContent, itemStatus, member_, fileStatus_) of
|
||||
(ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, _, Just (AFS SMDSnd fileStatus)) ->
|
||||
Right $ cItem SMDSnd CIGroupSnd ciStatus ciContent quotedMember_ (maybeCIFile fileStatus)
|
||||
(ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, _, Nothing) ->
|
||||
Right $ cItem SMDSnd CIGroupSnd ciStatus ciContent quotedMember_ Nothing
|
||||
(ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus, Just member, Just (AFS SMDRcv fileStatus)) ->
|
||||
Right $ cItem SMDRcv (CIGroupRcv member) ciStatus ciContent quotedMember_ (maybeCIFile fileStatus)
|
||||
(ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus, Just member, Nothing) ->
|
||||
Right $ cItem SMDRcv (CIGroupRcv member) ciStatus ciContent quotedMember_ Nothing
|
||||
_ -> badItem
|
||||
where
|
||||
cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTGroup d -> CIStatus d -> CIContent d -> Maybe GroupMember -> CChatItem 'CTGroup
|
||||
cItem d chatDir ciStatus content quotedMember_ =
|
||||
CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toGroupQuote quoteRow quotedMember_, file = Nothing}
|
||||
maybeCIFile :: CIFileStatus d -> Maybe (CIFile d)
|
||||
maybeCIFile fileStatus =
|
||||
case (fileId_, fileName_, fileSize_) of
|
||||
(Just fileId, Just fileName, Just fileSize) -> Just CIFile {fileId, fileName, fileSize, filePath, fileStatus}
|
||||
_ -> Nothing
|
||||
cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTGroup d -> CIStatus d -> CIContent d -> Maybe GroupMember -> Maybe (CIFile d) -> CChatItem 'CTGroup
|
||||
cItem d chatDir ciStatus content quotedMember_ file =
|
||||
CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toGroupQuote quoteRow quotedMember_, file}
|
||||
badItem = Left $ SEBadChatItem itemId
|
||||
ciMeta :: CIContent d -> CIStatus d -> CIMeta d
|
||||
ciMeta content status = mkCIMeta itemId content itemText status sharedMsgId itemDeleted (fromMaybe False itemEdited) tz currentTs itemTs createdAt
|
||||
|
||||
toGroupChatItemList :: TimeZone -> UTCTime -> Int64 -> MaybeGroupChatItemRow -> [CChatItem 'CTGroup]
|
||||
toGroupChatItemList tz currentTs userContactId ((Just itemId, Just itemTs, Just itemContent, Just itemText, Just itemStatus, sharedMsgId, Just itemDeleted, itemEdited, Just createdAt) :. memberRow_ :. quoteRow :. quotedMemberRow_) =
|
||||
either (const []) (: []) $ toGroupChatItem tz currentTs userContactId ((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt) :. memberRow_ :. quoteRow :. quotedMemberRow_)
|
||||
toGroupChatItemList tz currentTs userContactId (((Just itemId, Just itemTs, Just itemContent, Just itemText, Just itemStatus, sharedMsgId, Just itemDeleted, itemEdited, Just createdAt) :. fileRow) :. memberRow_ :. quoteRow :. quotedMemberRow_) =
|
||||
either (const []) (: []) $ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt) :. fileRow) :. memberRow_ :. quoteRow :. quotedMemberRow_)
|
||||
toGroupChatItemList _ _ _ _ = []
|
||||
|
||||
getSMPServers :: MonadUnliftIO m => SQLiteStore -> User -> m [SMPServer]
|
||||
|
||||
+52
-26
@@ -156,54 +156,69 @@ responseToView testView = \case
|
||||
testViewChat :: AChat -> [StyledString]
|
||||
testViewChat (AChat _ Chat {chatItems}) = [sShow $ map toChatView chatItems]
|
||||
where
|
||||
toChatView :: CChatItem c -> ((Int, Text), Maybe (Int, Text))
|
||||
toChatView (CChatItem dir ChatItem {meta, quotedItem}) =
|
||||
((msgDirectionInt $ toMsgDirection dir, itemText meta),) $ case quotedItem of
|
||||
Nothing -> Nothing
|
||||
Just CIQuote {chatDir = quoteDir, content} ->
|
||||
Just (msgDirectionInt $ quoteMsgDirection quoteDir, msgContentText content)
|
||||
toChatView :: CChatItem c -> ((Int, Text), Maybe (Int, Text), Maybe String)
|
||||
toChatView (CChatItem dir ChatItem {meta, quotedItem, file}) =
|
||||
((msgDirectionInt $ toMsgDirection dir, itemText meta), qItem, fPath)
|
||||
where
|
||||
qItem = case quotedItem of
|
||||
Nothing -> Nothing
|
||||
Just CIQuote {chatDir = quoteDir, content} ->
|
||||
Just (msgDirectionInt $ quoteMsgDirection quoteDir, msgContentText content)
|
||||
fPath = case file of
|
||||
Just CIFile {filePath = Just fp} -> Just fp
|
||||
_ -> Nothing
|
||||
viewErrorsSummary :: [a] -> StyledString -> [StyledString]
|
||||
viewErrorsSummary summary s = [ttyError (T.pack . show $ length summary) <> s <> " (run with -c option to show each error)" | not (null summary)]
|
||||
|
||||
viewChatItem :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> [StyledString]
|
||||
viewChatItem chat ChatItem {chatDir, meta, content, quotedItem} = case chat of
|
||||
viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} = case chat of
|
||||
DirectChat c -> case chatDir of
|
||||
CIDirectSnd -> case content of
|
||||
CISndMsgContent mc -> viewSentMessage to quote mc meta
|
||||
CISndMsgContent mc -> withSndFile to $ sndMsg to quote mc
|
||||
CISndDeleted _ -> []
|
||||
CISndFileInvitation fId fPath -> viewSentFileInvitation to fId fPath meta
|
||||
where
|
||||
to = ttyToContact' c
|
||||
CIDirectRcv -> case content of
|
||||
CIRcvMsgContent mc -> viewReceivedMessage from quote meta mc
|
||||
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
|
||||
CIRcvDeleted _ -> []
|
||||
CIRcvFileInvitation ft -> viewReceivedFileInvitation from meta ft
|
||||
where
|
||||
from = ttyFromContact' c
|
||||
where
|
||||
quote = maybe [] (directQuote chatDir) quotedItem
|
||||
GroupChat g -> case chatDir of
|
||||
CIGroupSnd -> case content of
|
||||
CISndMsgContent mc -> viewSentMessage to quote mc meta
|
||||
CISndMsgContent mc -> withSndFile to $ sndMsg to quote mc
|
||||
CISndDeleted _ -> []
|
||||
CISndFileInvitation fId fPath -> viewSentFileInvitation to fId fPath meta
|
||||
where
|
||||
to = ttyToGroup g
|
||||
CIGroupRcv m -> case content of
|
||||
CIRcvMsgContent mc -> viewReceivedMessage from quote meta mc
|
||||
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
|
||||
CIRcvDeleted _ -> []
|
||||
CIRcvFileInvitation ft -> viewReceivedFileInvitation from meta ft
|
||||
where
|
||||
from = ttyFromGroup' g m
|
||||
where
|
||||
quote = maybe [] (groupQuote g) quotedItem
|
||||
_ -> []
|
||||
where
|
||||
sndMsg to quote mc = case (msgContentText mc, file) of
|
||||
("", Just _) -> []
|
||||
_ -> viewSentMessage to quote mc meta
|
||||
withSndFile to l = case file of
|
||||
-- TODO pass CIFile
|
||||
Just CIFile {fileId, filePath = Just fPath} -> l <> viewSentFileInvitation to fileId fPath meta
|
||||
_ -> l
|
||||
rcvMsg from quote mc = case (msgContentText mc, file) of
|
||||
("", Just _) -> []
|
||||
_ -> viewReceivedMessage from quote mc meta
|
||||
withRcvFile from l = case file of
|
||||
Just f -> l <> viewReceivedFileInvitation from f meta
|
||||
_ -> l
|
||||
|
||||
viewItemUpdate :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> [StyledString]
|
||||
viewItemUpdate chat ChatItem {chatDir, meta, content, quotedItem} = case chat of
|
||||
DirectChat Contact {localDisplayName = c} -> case chatDir of
|
||||
CIDirectRcv -> case content of
|
||||
CIRcvMsgContent mc -> viewReceivedMessage from quote meta mc
|
||||
CIRcvMsgContent mc -> viewReceivedMessage from quote mc meta
|
||||
_ -> []
|
||||
where
|
||||
from = ttyFromContactEdited c
|
||||
@@ -211,7 +226,7 @@ viewItemUpdate chat ChatItem {chatDir, meta, content, quotedItem} = case chat of
|
||||
CIDirectSnd -> ["message updated"]
|
||||
GroupChat g -> case chatDir of
|
||||
CIGroupRcv GroupMember {localDisplayName = m} -> case content of
|
||||
CIRcvMsgContent mc -> viewReceivedMessage from quote meta mc
|
||||
CIRcvMsgContent mc -> viewReceivedMessage from quote mc meta
|
||||
_ -> []
|
||||
where
|
||||
from = ttyFromGroupEdited g m
|
||||
@@ -223,13 +238,13 @@ viewItemDelete :: ChatInfo c -> ChatItem c d -> ChatItem c' d' -> [StyledString]
|
||||
viewItemDelete chat ChatItem {chatDir, meta, content = deletedContent} ChatItem {content = toContent} = case chat of
|
||||
DirectChat Contact {localDisplayName = c} -> case (chatDir, deletedContent, toContent) of
|
||||
(CIDirectRcv, CIRcvMsgContent mc, CIRcvDeleted mode) -> case mode of
|
||||
CIDMBroadcast -> viewReceivedMessage (ttyFromContactDeleted c) [] meta mc
|
||||
CIDMBroadcast -> viewReceivedMessage (ttyFromContactDeleted c) [] mc meta
|
||||
CIDMInternal -> ["message deleted"]
|
||||
(CIDirectSnd, _, _) -> ["message deleted"]
|
||||
_ -> []
|
||||
GroupChat g -> case (chatDir, deletedContent, toContent) of
|
||||
(CIGroupRcv GroupMember {localDisplayName = m}, CIRcvMsgContent mc, CIRcvDeleted mode) -> case mode of
|
||||
CIDMBroadcast -> viewReceivedMessage (ttyFromGroupDeleted g m) [] meta mc
|
||||
CIDMBroadcast -> viewReceivedMessage (ttyFromGroupDeleted g m) [] mc meta
|
||||
CIDMInternal -> ["message deleted"]
|
||||
(CIGroupSnd, _, _) -> ["message deleted"]
|
||||
_ -> []
|
||||
@@ -434,8 +449,8 @@ viewContactUpdated
|
||||
where
|
||||
fullNameUpdate = if T.null fullName' || fullName' == n' then " removed full name" else " updated full name: " <> plain fullName'
|
||||
|
||||
viewReceivedMessage :: StyledString -> [StyledString] -> CIMeta d -> MsgContent -> [StyledString]
|
||||
viewReceivedMessage from quote meta = receivedWithTime_ from quote meta . ttyMsgContent
|
||||
viewReceivedMessage :: StyledString -> [StyledString] -> MsgContent -> CIMeta d -> [StyledString]
|
||||
viewReceivedMessage from quote mc meta = receivedWithTime_ from quote meta (ttyMsgContent mc)
|
||||
|
||||
receivedWithTime_ :: StyledString -> [StyledString] -> CIMeta d -> [StyledString] -> [StyledString]
|
||||
receivedWithTime_ from quote CIMeta {localItemTs, createdAt} styledMsg = do
|
||||
@@ -454,7 +469,7 @@ receivedWithTime_ from quote CIMeta {localItemTs, createdAt} styledMsg = do
|
||||
in styleTime $ formatTime defaultTimeLocale format localTime
|
||||
|
||||
viewSentMessage :: StyledString -> [StyledString] -> MsgContent -> CIMeta d -> [StyledString]
|
||||
viewSentMessage to quote mc = sentWithTime_ . prependFirst to $ quote <> prependFirst indent (ttyMsgContent mc)
|
||||
viewSentMessage to quote mc = sentWithTime_ (prependFirst to $ quote <> prependFirst indent (ttyMsgContent mc))
|
||||
where
|
||||
indent = if null quote then "" else " "
|
||||
|
||||
@@ -501,11 +516,22 @@ sendingFile_ status ft@SndFileTransfer {recipientDisplayName = c} =
|
||||
sndFile :: SndFileTransfer -> StyledString
|
||||
sndFile SndFileTransfer {fileId, fileName} = fileTransferStr fileId fileName
|
||||
|
||||
viewReceivedFileInvitation :: StyledString -> CIMeta d -> RcvFileTransfer -> [StyledString]
|
||||
viewReceivedFileInvitation from meta ft = receivedWithTime_ from [] meta (receivedFileInvitation_ ft)
|
||||
viewReceivedFileInvitation :: StyledString -> CIFile d -> CIMeta d -> [StyledString]
|
||||
viewReceivedFileInvitation from file meta = receivedWithTime_ from [] meta (receivedFileInvitation_ file)
|
||||
|
||||
receivedFileInvitation_ :: RcvFileTransfer -> [StyledString]
|
||||
receivedFileInvitation_ RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName, fileSize}} =
|
||||
receivedFileInvitation_ :: CIFile d -> [StyledString]
|
||||
receivedFileInvitation_ CIFile {fileId, fileName, fileSize} =
|
||||
[ "sends file " <> ttyFilePath fileName <> " (" <> humanReadableSize fileSize <> " / " <> sShow fileSize <> " bytes)",
|
||||
-- below is printed for auto-accepted files as well; auto-accept is disabled in terminal though so in reality it never happens
|
||||
"use " <> highlight ("/fr " <> show fileId <> " [<dir>/ | <path>]") <> " to receive it"
|
||||
]
|
||||
|
||||
-- TODO remove
|
||||
viewReceivedFileInvitation' :: StyledString -> RcvFileTransfer -> CIMeta d -> [StyledString]
|
||||
viewReceivedFileInvitation' from RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName, fileSize}} meta = receivedWithTime_ from [] meta (receivedFileInvitation_' fileId fileName fileSize)
|
||||
|
||||
receivedFileInvitation_' :: Int64 -> String -> Integer -> [StyledString]
|
||||
receivedFileInvitation_' fileId fileName fileSize =
|
||||
[ "sends file " <> ttyFilePath fileName <> " (" <> humanReadableSize fileSize <> " / " <> sShow fileSize <> " bytes)",
|
||||
"use " <> highlight ("/fr " <> show fileId <> " [<dir>/ | <path>]") <> " to receive it"
|
||||
]
|
||||
|
||||
Reference in New Issue
Block a user