mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-06-28 20:29:53 +00:00
core: sending messages with files (#507)
Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
This commit is contained in:
parent
150b4196ea
commit
13f84f2a96
14 changed files with 670 additions and 297 deletions
2
.github/CODEOWNERS
vendored
2
.github/CODEOWNERS
vendored
|
@ -1 +1 @@
|
||||||
* @epoberezkin @efim-poberezkin
|
* @epoberezkin @jr-simplex
|
||||||
|
|
|
@ -34,7 +34,7 @@ library
|
||||||
Simplex.Chat.Migrations.M20220302_profile_images
|
Simplex.Chat.Migrations.M20220302_profile_images
|
||||||
Simplex.Chat.Migrations.M20220304_msg_quotes
|
Simplex.Chat.Migrations.M20220304_msg_quotes
|
||||||
Simplex.Chat.Migrations.M20220321_chat_item_edited
|
Simplex.Chat.Migrations.M20220321_chat_item_edited
|
||||||
Simplex.Chat.Migrations.M20220404_files_cancelled
|
Simplex.Chat.Migrations.M20220404_files_status_fields
|
||||||
Simplex.Chat.Mobile
|
Simplex.Chat.Mobile
|
||||||
Simplex.Chat.Options
|
Simplex.Chat.Options
|
||||||
Simplex.Chat.Protocol
|
Simplex.Chat.Protocol
|
||||||
|
|
|
@ -174,49 +174,84 @@ processChatCommand = \case
|
||||||
CTGroup -> CRApiChat . AChat SCTGroup <$> withStore (\st -> getGroupChat st user cId pagination)
|
CTGroup -> CRApiChat . AChat SCTGroup <$> withStore (\st -> getGroupChat st user cId pagination)
|
||||||
CTContactRequest -> pure $ chatCmdError "not implemented"
|
CTContactRequest -> pure $ chatCmdError "not implemented"
|
||||||
APIGetChatItems _pagination -> pure $ chatCmdError "not implemented"
|
APIGetChatItems _pagination -> pure $ chatCmdError "not implemented"
|
||||||
APISendMessage cType chatId _file mc -> withUser $ \user@User {userId} -> withChatLock $ case cType of
|
APISendMessage cType chatId file_ quotedItemId_ mc -> withUser $ \user@User {userId} -> withChatLock $ case cType of
|
||||||
-- TODO send message with file attachment; initiate file transfer
|
|
||||||
CTDirect -> do
|
CTDirect -> do
|
||||||
ct <- withStore $ \st -> getContact st userId chatId
|
ct@Contact {localDisplayName = c} <- withStore $ \st -> getContact st userId chatId
|
||||||
sendNewMsg user ct (MCSimple (ExtMsgContent mc Nothing)) mc Nothing
|
(fileInvitation_, ciFile_) <- unzipMaybe <$> setupSndFileTransfer ct
|
||||||
CTGroup -> do
|
(msgContainer, quotedItem_) <- prepareMsg fileInvitation_
|
||||||
group@(Group GroupInfo {membership} _) <- withStore $ \st -> getGroup st user chatId
|
msg <- sendDirectContactMessage ct (XMsgNew msgContainer)
|
||||||
unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved
|
ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc) ciFile_ quotedItem_
|
||||||
sendNewGroupMsg user group (MCSimple (ExtMsgContent mc Nothing)) mc Nothing
|
setActive $ ActiveC c
|
||||||
CTContactRequest -> pure $ chatCmdError "not supported"
|
pure . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci
|
||||||
APISendMessageQuote cType chatId quotedItemId _file mc -> withUser $ \user@User {userId} -> withChatLock $ case cType of
|
where
|
||||||
-- TODO send message with file attachment; initiate file transfer
|
setupSndFileTransfer :: Contact -> m (Maybe (FileInvitation, CIFile 'MDSnd))
|
||||||
CTDirect -> do
|
setupSndFileTransfer ct = case file_ of
|
||||||
(ct, qci) <- withStore $ \st -> (,) <$> getContact st userId chatId <*> getDirectChatItem st userId chatId quotedItemId
|
Nothing -> pure Nothing
|
||||||
case qci of
|
Just file -> do
|
||||||
CChatItem _ ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, content = ciContent, formattedText} -> do
|
(fileSize, chSize) <- checkSndFile file
|
||||||
case ciContent of
|
(agentConnId, fileConnReq) <- withAgent (`createConnection` SCMInvitation)
|
||||||
CISndMsgContent qmc -> send_ CIQDirectSnd True qmc
|
let fileName = takeFileName file
|
||||||
CIRcvMsgContent qmc -> send_ CIQDirectRcv False qmc
|
fileInvitation = FileInvitation {fileName, fileSize, fileConnReq = Just fileConnReq}
|
||||||
_ -> throwChatError CEInvalidQuote
|
fileId <- withStore $ \st -> createSndFileTransfer st userId ct file fileInvitation agentConnId chSize
|
||||||
|
let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus = CIFSSndStored}
|
||||||
|
pure $ Just (fileInvitation, ciFile)
|
||||||
|
prepareMsg :: Maybe FileInvitation -> m (MsgContainer, Maybe (CIQuote 'CTDirect))
|
||||||
|
prepareMsg fileInvitation_ = case quotedItemId_ of
|
||||||
|
Nothing -> pure (MCSimple (ExtMsgContent mc fileInvitation_), Nothing)
|
||||||
|
Just quotedItemId -> do
|
||||||
|
CChatItem _ ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, content = ciContent, formattedText} <-
|
||||||
|
withStore $ \st -> getDirectChatItem st userId chatId quotedItemId
|
||||||
|
(qmc, qd, sent) <- liftEither $ quoteData ciContent
|
||||||
|
let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Nothing}
|
||||||
|
quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText}
|
||||||
|
pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fileInvitation_), Just quotedItem)
|
||||||
where
|
where
|
||||||
send_ :: CIQDirection 'CTDirect -> Bool -> MsgContent -> m ChatResponse
|
quoteData :: CIContent d -> Either ChatError (MsgContent, CIQDirection 'CTDirect, Bool)
|
||||||
send_ chatDir sent qmc =
|
quoteData (CISndMsgContent qmc) = Right (qmc, CIQDirectSnd, True)
|
||||||
let quotedItem = CIQuote {chatDir, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText}
|
quoteData (CIRcvMsgContent qmc) = Right (qmc, CIQDirectRcv, False)
|
||||||
msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Nothing}
|
quoteData _ = Left $ ChatError CEInvalidQuote
|
||||||
in sendNewMsg user ct (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc Nothing)) mc (Just quotedItem)
|
|
||||||
CTGroup -> do
|
CTGroup -> do
|
||||||
group@(Group GroupInfo {membership} _) <- withStore $ \st -> getGroup st user chatId
|
Group gInfo@GroupInfo {membership, localDisplayName = gName} ms <- withStore $ \st -> getGroup st user chatId
|
||||||
unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved
|
unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved
|
||||||
qci <- withStore $ \st -> getGroupChatItem st user chatId quotedItemId
|
(fileInvitation_, ciFile_) <- unzipMaybe <$> setupSndFileTransfer gInfo
|
||||||
case qci of
|
(msgContainer, quotedItem_) <- prepareMsg fileInvitation_ membership
|
||||||
CChatItem _ ChatItem {chatDir, meta = CIMeta {itemTs, itemSharedMsgId}, content = ciContent, formattedText} -> do
|
msg <- sendGroupMessage gInfo ms (XMsgNew msgContainer)
|
||||||
case (ciContent, chatDir) of
|
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_
|
||||||
(CISndMsgContent qmc, _) -> send_ CIQGroupSnd True membership qmc
|
setActive $ ActiveG gName
|
||||||
(CIRcvMsgContent qmc, CIGroupRcv m) -> send_ (CIQGroupRcv $ Just m) False m qmc
|
pure . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci
|
||||||
_ -> throwChatError CEInvalidQuote
|
where
|
||||||
|
setupSndFileTransfer :: GroupInfo -> m (Maybe (FileInvitation, CIFile 'MDSnd))
|
||||||
|
setupSndFileTransfer gInfo = case file_ of
|
||||||
|
Nothing -> pure Nothing
|
||||||
|
Just file -> do
|
||||||
|
(fileSize, chSize) <- checkSndFile file
|
||||||
|
let fileName = takeFileName file
|
||||||
|
fileInvitation = FileInvitation {fileName, fileSize, fileConnReq = Nothing}
|
||||||
|
fileId <- withStore $ \st -> createSndGroupFileTransferV2 st userId gInfo file fileInvitation chSize
|
||||||
|
let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus = CIFSSndStored}
|
||||||
|
pure $ Just (fileInvitation, ciFile)
|
||||||
|
prepareMsg :: Maybe FileInvitation -> GroupMember -> m (MsgContainer, Maybe (CIQuote 'CTGroup))
|
||||||
|
prepareMsg fileInvitation_ membership = case quotedItemId_ of
|
||||||
|
Nothing -> pure (MCSimple (ExtMsgContent mc fileInvitation_), Nothing)
|
||||||
|
Just quotedItemId -> do
|
||||||
|
CChatItem _ ChatItem {chatDir, meta = CIMeta {itemTs, itemSharedMsgId}, content = ciContent, formattedText} <-
|
||||||
|
withStore $ \st -> getGroupChatItem st user chatId quotedItemId
|
||||||
|
(qmc, qd, sent, GroupMember {memberId}) <- liftEither $ quoteData ciContent chatDir membership
|
||||||
|
let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Just memberId}
|
||||||
|
quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText}
|
||||||
|
pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fileInvitation_), Just quotedItem)
|
||||||
where
|
where
|
||||||
send_ :: CIQDirection 'CTGroup -> Bool -> GroupMember -> MsgContent -> m ChatResponse
|
quoteData :: CIContent d -> CIDirection 'CTGroup d -> GroupMember -> Either ChatError (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember)
|
||||||
send_ qd sent GroupMember {memberId} content =
|
quoteData (CISndMsgContent qmc) CIGroupSnd membership' = Right (qmc, CIQGroupSnd, True, membership')
|
||||||
let quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content, formattedText}
|
quoteData (CIRcvMsgContent qmc) (CIGroupRcv m) _ = Right (qmc, CIQGroupRcv $ Just m, False, m)
|
||||||
msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Just memberId}
|
quoteData _ _ _ = Left $ ChatError CEInvalidQuote
|
||||||
in sendNewGroupMsg user group (MCQuote QuotedMsg {msgRef, content} (ExtMsgContent mc Nothing)) mc (Just quotedItem)
|
|
||||||
CTContactRequest -> pure $ chatCmdError "not supported"
|
CTContactRequest -> pure $ chatCmdError "not supported"
|
||||||
|
where
|
||||||
|
unzipMaybe :: Maybe (a, b) -> (Maybe a, Maybe b)
|
||||||
|
unzipMaybe t = (fst <$> t, snd <$> t)
|
||||||
|
-- TODO discontinue
|
||||||
|
APISendMessageQuote cType chatId quotedItemId mc ->
|
||||||
|
processChatCommand $ APISendMessage cType chatId Nothing (Just quotedItemId) mc
|
||||||
APIUpdateChatItem cType chatId itemId mc -> withUser $ \user@User {userId} -> withChatLock $ case cType of
|
APIUpdateChatItem cType chatId itemId mc -> withUser $ \user@User {userId} -> withChatLock $ case cType of
|
||||||
CTDirect -> do
|
CTDirect -> do
|
||||||
(ct@Contact {contactId, localDisplayName = c}, ci) <- withStore $ \st -> (,) <$> getContact st userId chatId <*> getDirectChatItem st userId chatId itemId
|
(ct@Contact {contactId, localDisplayName = c}, ci) <- withStore $ \st -> (,) <$> getContact st userId chatId <*> getDirectChatItem st userId chatId itemId
|
||||||
|
@ -352,21 +387,25 @@ processChatCommand = \case
|
||||||
SendMessage cName msg -> withUser $ \User {userId} -> do
|
SendMessage cName msg -> withUser $ \User {userId} -> do
|
||||||
contactId <- withStore $ \st -> getContactIdByName st userId cName
|
contactId <- withStore $ \st -> getContactIdByName st userId cName
|
||||||
let mc = MCText $ safeDecodeUtf8 msg
|
let mc = MCText $ safeDecodeUtf8 msg
|
||||||
processChatCommand $ APISendMessage CTDirect contactId Nothing mc
|
processChatCommand $ APISendMessage CTDirect contactId Nothing Nothing mc
|
||||||
SendMessageBroadcast msg -> withUser $ \user -> do
|
SendMessageBroadcast msg -> withUser $ \user -> do
|
||||||
contacts <- withStore (`getUserContacts` user)
|
contacts <- withStore (`getUserContacts` user)
|
||||||
withChatLock . procCmd $ do
|
withChatLock . procCmd $ do
|
||||||
let mc = MCText $ safeDecodeUtf8 msg
|
let mc = MCText $ safeDecodeUtf8 msg
|
||||||
cts = filter isReady contacts
|
cts = filter isReady contacts
|
||||||
forM_ cts $ \ct ->
|
forM_ cts $ \ct ->
|
||||||
void (sendDirectChatItem user ct (XMsgNew $ MCSimple (ExtMsgContent mc Nothing)) (CISndMsgContent mc) Nothing)
|
void
|
||||||
|
( do
|
||||||
|
sndMsg <- sendDirectContactMessage ct (XMsgNew $ MCSimple (ExtMsgContent mc Nothing))
|
||||||
|
saveSndChatItem user (CDDirectSnd ct) sndMsg (CISndMsgContent mc) Nothing Nothing
|
||||||
|
)
|
||||||
`catchError` (toView . CRChatError)
|
`catchError` (toView . CRChatError)
|
||||||
CRBroadcastSent mc (length cts) <$> liftIO getZonedTime
|
CRBroadcastSent mc (length cts) <$> liftIO getZonedTime
|
||||||
SendMessageQuote cName (AMsgDirection msgDir) quotedMsg msg -> withUser $ \User {userId} -> do
|
SendMessageQuote cName (AMsgDirection msgDir) quotedMsg msg -> withUser $ \User {userId} -> do
|
||||||
contactId <- withStore $ \st -> getContactIdByName st userId cName
|
contactId <- withStore $ \st -> getContactIdByName st userId cName
|
||||||
quotedItemId <- withStore $ \st -> getDirectChatItemIdByText st userId contactId msgDir (safeDecodeUtf8 quotedMsg)
|
quotedItemId <- withStore $ \st -> getDirectChatItemIdByText st userId contactId msgDir (safeDecodeUtf8 quotedMsg)
|
||||||
let mc = MCText $ safeDecodeUtf8 msg
|
let mc = MCText $ safeDecodeUtf8 msg
|
||||||
processChatCommand $ APISendMessageQuote CTDirect contactId quotedItemId Nothing mc
|
processChatCommand $ APISendMessage CTDirect contactId Nothing (Just quotedItemId) mc
|
||||||
DeleteMessage cName deletedMsg -> withUser $ \User {userId} -> do
|
DeleteMessage cName deletedMsg -> withUser $ \User {userId} -> do
|
||||||
contactId <- withStore $ \st -> getContactIdByName st userId cName
|
contactId <- withStore $ \st -> getContactIdByName st userId cName
|
||||||
deletedItemId <- withStore $ \st -> getDirectChatItemIdByText st userId contactId SMDSnd (safeDecodeUtf8 deletedMsg)
|
deletedItemId <- withStore $ \st -> getDirectChatItemIdByText st userId contactId SMDSnd (safeDecodeUtf8 deletedMsg)
|
||||||
|
@ -450,12 +489,12 @@ processChatCommand = \case
|
||||||
SendGroupMessage gName msg -> withUser $ \user -> do
|
SendGroupMessage gName msg -> withUser $ \user -> do
|
||||||
groupId <- withStore $ \st -> getGroupIdByName st user gName
|
groupId <- withStore $ \st -> getGroupIdByName st user gName
|
||||||
let mc = MCText $ safeDecodeUtf8 msg
|
let mc = MCText $ safeDecodeUtf8 msg
|
||||||
processChatCommand $ APISendMessage CTGroup groupId Nothing mc
|
processChatCommand $ APISendMessage CTGroup groupId Nothing Nothing mc
|
||||||
SendGroupMessageQuote gName cName quotedMsg msg -> withUser $ \user -> do
|
SendGroupMessageQuote gName cName quotedMsg msg -> withUser $ \user -> do
|
||||||
groupId <- withStore $ \st -> getGroupIdByName st user gName
|
groupId <- withStore $ \st -> getGroupIdByName st user gName
|
||||||
quotedItemId <- withStore $ \st -> getGroupChatItemIdByText st user groupId cName (safeDecodeUtf8 quotedMsg)
|
quotedItemId <- withStore $ \st -> getGroupChatItemIdByText st user groupId cName (safeDecodeUtf8 quotedMsg)
|
||||||
let mc = MCText $ safeDecodeUtf8 msg
|
let mc = MCText $ safeDecodeUtf8 msg
|
||||||
processChatCommand $ APISendMessageQuote CTGroup groupId quotedItemId Nothing mc
|
processChatCommand $ APISendMessage CTGroup groupId Nothing (Just quotedItemId) mc
|
||||||
DeleteGroupMessage gName deletedMsg -> withUser $ \user@User {localDisplayName} -> do
|
DeleteGroupMessage gName deletedMsg -> withUser $ \user@User {localDisplayName} -> do
|
||||||
groupId <- withStore $ \st -> getGroupIdByName st user gName
|
groupId <- withStore $ \st -> getGroupIdByName st user gName
|
||||||
deletedItemId <- withStore $ \st -> getGroupChatItemIdByText st user groupId (Just localDisplayName) (safeDecodeUtf8 deletedMsg)
|
deletedItemId <- withStore $ \st -> getGroupChatItemIdByText st user groupId (Just localDisplayName) (safeDecodeUtf8 deletedMsg)
|
||||||
|
@ -466,110 +505,88 @@ processChatCommand = \case
|
||||||
let mc = MCText $ safeDecodeUtf8 msg
|
let mc = MCText $ safeDecodeUtf8 msg
|
||||||
processChatCommand $ APIUpdateChatItem CTGroup groupId editedItemId mc
|
processChatCommand $ APIUpdateChatItem CTGroup groupId editedItemId mc
|
||||||
-- old file protocol
|
-- old file protocol
|
||||||
|
-- SendFile cName f -> withUser $ \User {userId} -> do
|
||||||
|
-- contactId <- withStore $ \st -> getContactIdByName st userId cName
|
||||||
|
-- processChatCommand $ APISendMessage CTDirect contactId (Just f) Nothing (MCText "")
|
||||||
|
-- TODO replace with code above when switching from XFile
|
||||||
SendFile cName f -> withUser $ \user@User {userId} -> withChatLock $ do
|
SendFile cName f -> withUser $ \user@User {userId} -> withChatLock $ do
|
||||||
(fileSize, chSize) <- checkSndFile f
|
(fileSize, chSize) <- checkSndFile f
|
||||||
contact <- withStore $ \st -> getContactByName st userId cName
|
contact <- withStore $ \st -> getContactByName st userId cName
|
||||||
(agentConnId, fileConnReq) <- withAgent (`createConnection` SCMInvitation)
|
(agentConnId, fileConnReq) <- withAgent (`createConnection` SCMInvitation)
|
||||||
let fileInv = FileInvitation {fileName = takeFileName f, fileSize, fileConnReq = Just fileConnReq}
|
let fileName = takeFileName f
|
||||||
SndFileTransfer {fileId} <- withStore $ \st ->
|
fileInv = FileInvitation {fileName = takeFileName f, fileSize, fileConnReq = Just fileConnReq}
|
||||||
|
fileId <- withStore $ \st ->
|
||||||
createSndFileTransfer st userId contact f fileInv agentConnId chSize
|
createSndFileTransfer st userId contact f fileInv agentConnId chSize
|
||||||
ci <- sendDirectChatItem user contact (XFile fileInv) (CISndFileInvitation fileId f) Nothing
|
msg <- sendDirectContactMessage contact (XFile fileInv)
|
||||||
|
let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just f, fileStatus = CIFSSndStored}
|
||||||
|
ci <- saveSndChatItem user (CDDirectSnd contact) msg (CISndMsgContent $ MCText "") (Just ciFile) Nothing
|
||||||
withStore $ \st -> updateFileTransferChatItemId st fileId $ chatItemId' ci
|
withStore $ \st -> updateFileTransferChatItemId st fileId $ chatItemId' ci
|
||||||
setActive $ ActiveC cName
|
setActive $ ActiveC cName
|
||||||
pure . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat contact) ci
|
pure . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat contact) ci
|
||||||
-- new file protocol
|
-- new file protocol (not used for direct files)
|
||||||
SendFileInv cName f -> withUser $ \user@User {userId} -> withChatLock $ do
|
SendFileInv cName f -> withUser $ \user@User {userId} -> withChatLock $ do
|
||||||
|
ct <- withStore $ \st -> getContactByName st userId cName
|
||||||
(fileSize, chSize) <- checkSndFile f
|
(fileSize, chSize) <- checkSndFile f
|
||||||
contact <- withStore $ \st -> getContactByName st userId cName
|
let fileName = takeFileName f
|
||||||
let fileInv = FileInvitation {fileName = takeFileName f, fileSize, fileConnReq = Nothing}
|
fileInvitation = FileInvitation {fileName, fileSize, fileConnReq = Nothing}
|
||||||
fileId <- withStore $ \st -> createSndFileTransferV2 st userId contact f fileInv chSize
|
fileId <- withStore $ \st -> createSndFileTransferV2 st userId ct f fileInvitation chSize
|
||||||
ci <- sendDirectChatItem user contact (XFile fileInv) (CISndFileInvitation fileId f) Nothing
|
let mc = MCText ""
|
||||||
withStore $ \st -> updateFileTransferChatItemId st fileId $ chatItemId' ci
|
ciFile = Just $ CIFile {fileId, fileName, fileSize, filePath = Just f, fileStatus = CIFSSndStored}
|
||||||
|
msg <- sendDirectContactMessage ct (XMsgNew (MCSimple (ExtMsgContent mc (Just fileInvitation))))
|
||||||
|
ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc) ciFile Nothing
|
||||||
setActive $ ActiveC cName
|
setActive $ ActiveC cName
|
||||||
pure . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat contact) ci
|
pure . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci
|
||||||
-- old file protocol
|
-- old file protocol
|
||||||
|
-- TODO discontinue
|
||||||
SendGroupFile gName f -> withUser $ \user@User {userId} -> withChatLock $ do
|
SendGroupFile gName f -> withUser $ \user@User {userId} -> withChatLock $ do
|
||||||
(fileSize, chSize) <- checkSndFile f
|
|
||||||
Group gInfo@GroupInfo {groupId, membership} members <- withStore $ \st -> getGroupByName st user gName
|
Group gInfo@GroupInfo {groupId, membership} members <- withStore $ \st -> getGroupByName st user gName
|
||||||
unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved
|
unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved
|
||||||
|
(fileSize, chSize) <- checkSndFile f
|
||||||
let fileName = takeFileName f
|
let fileName = takeFileName f
|
||||||
ms <- forM (filter memberActive members) $ \m -> do
|
ms <- forM (filter memberActive members) $ \m -> do
|
||||||
(connId, fileConnReq) <- withAgent (`createConnection` SCMInvitation)
|
(connId, fileConnReq) <- withAgent (`createConnection` SCMInvitation)
|
||||||
pure (m, connId, FileInvitation {fileName, fileSize, fileConnReq = Just fileConnReq})
|
pure (m, connId, FileInvitation {fileName, fileSize, fileConnReq = Just fileConnReq})
|
||||||
fileId <- withStore $ \st -> createSndGroupFileTransfer st userId gInfo ms f fileSize chSize
|
fileId <- withStore $ \st -> createSndGroupFileTransfer st userId gInfo ms f fileSize chSize
|
||||||
-- TODO sendGroupChatItem - same file invitation to all
|
forM_ ms $ \(m, _, fileInvitation) ->
|
||||||
forM_ ms $ \(m, _, fileInv) ->
|
traverse (\conn -> sendDirectMessage conn (XFile fileInvitation) (GroupId groupId)) $ memberConn m
|
||||||
traverse (\conn -> sendDirectMessage conn (XFile fileInv) (GroupId groupId)) $ memberConn m
|
|
||||||
setActive $ ActiveG gName
|
setActive $ ActiveG gName
|
||||||
-- this is a hack as we have multiple direct messages instead of one per group
|
-- this is a hack as we have multiple direct messages instead of one per group
|
||||||
let msg = SndMessage {msgId = 0, sharedMsgId = SharedMsgId "", msgBody = ""}
|
let msg = SndMessage {msgId = 0, sharedMsgId = SharedMsgId "", msgBody = ""}
|
||||||
ciContent = CISndFileInvitation fileId f
|
ciFile = Just $ CIFile {fileId, fileName, fileSize, filePath = Just f, fileStatus = CIFSSndStored}
|
||||||
cItem@ChatItem {meta = CIMeta {itemId}} <- saveSndChatItem user (CDGroupSnd gInfo) msg ciContent Nothing
|
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndMsgContent $ MCText "") ciFile Nothing
|
||||||
withStore $ \st -> updateFileTransferChatItemId st fileId itemId
|
|
||||||
pure . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) cItem
|
|
||||||
-- new file protocol
|
|
||||||
SendGroupFileInv gName f -> withUser $ \user@User {userId} -> withChatLock $ do
|
|
||||||
(fileSize, chSize) <- checkSndFile f
|
|
||||||
g@(Group gInfo@GroupInfo {membership} _) <- withStore $ \st -> getGroupByName st user gName
|
|
||||||
unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved
|
|
||||||
let fileInv = FileInvitation {fileName = takeFileName f, fileSize, fileConnReq = Nothing}
|
|
||||||
fileId <- withStore $ \st -> createSndGroupFileTransferV2 st userId gInfo f fileInv chSize
|
|
||||||
ci <- sendGroupChatItem user g (XFile fileInv) (CISndFileInvitation fileId f) Nothing
|
|
||||||
withStore $ \st -> updateFileTransferChatItemId st fileId $ chatItemId' ci
|
|
||||||
setActive $ ActiveG gName
|
|
||||||
pure . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci
|
pure . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci
|
||||||
ReceiveFile fileId filePath_ -> withUser $ \user@User {userId} -> do
|
-- new file protocol
|
||||||
ft@RcvFileTransfer {fileInvitation = FileInvitation {fileName, fileConnReq}, fileStatus, senderDisplayName, grpMemberId} <- withStore $ \st -> getRcvFileTransfer st userId fileId
|
SendGroupFileInv gName f -> withUser $ \user -> do
|
||||||
unless (fileStatus == RFSNew) . throwChatError $ CEFileAlreadyReceiving fileName
|
groupId <- withStore $ \st -> getGroupIdByName st user gName
|
||||||
case fileConnReq of
|
processChatCommand $ APISendMessage CTGroup groupId (Just f) Nothing (MCText "")
|
||||||
-- old file protocol
|
ReceiveFile fileId filePath_ -> withUser $ \user@User {userId} ->
|
||||||
Just connReq ->
|
withChatLock . procCmd $ do
|
||||||
withChatLock . procCmd $ do
|
ft <- withStore $ \st -> getRcvFileTransfer st userId fileId
|
||||||
tryError (withAgent $ \a -> joinConnection a connReq . directMessage $ XFileAcpt fileName) >>= \case
|
(CRRcvFileAccepted ft <$> acceptFileReceive user ft filePath_) `catchError` processError ft
|
||||||
Right agentConnId -> do
|
where
|
||||||
filePath <- getRcvFilePath fileId filePath_ fileName
|
processError ft = \case
|
||||||
withStore $ \st -> acceptRcvFileTransfer st userId fileId agentConnId filePath
|
ChatErrorAgent (SMP SMP.AUTH) -> pure $ CRRcvFileAcceptedSndCancelled ft
|
||||||
pure $ CRRcvFileAccepted ft filePath
|
ChatErrorAgent (CONN DUPLICATE) -> pure $ CRRcvFileAcceptedSndCancelled ft
|
||||||
Left (ChatErrorAgent (SMP SMP.AUTH)) -> pure $ CRRcvFileAcceptedSndCancelled ft
|
e -> throwError e
|
||||||
Left (ChatErrorAgent (CONN DUPLICATE)) -> pure $ CRRcvFileAcceptedSndCancelled ft
|
|
||||||
Left e -> throwError e
|
|
||||||
-- new file protocol
|
|
||||||
Nothing ->
|
|
||||||
case grpMemberId of
|
|
||||||
Nothing ->
|
|
||||||
withChatLock . procCmd $ do
|
|
||||||
ct <- withStore $ \st -> getContactByName st userId senderDisplayName
|
|
||||||
acceptFileV2 $ \sharedMsgId fileInvConnReq -> sendDirectContactMessage ct $ XFileAcptInv sharedMsgId fileInvConnReq fileName
|
|
||||||
Just memId ->
|
|
||||||
withChatLock . procCmd $ do
|
|
||||||
(GroupInfo {groupId}, GroupMember {activeConn}) <- withStore $ \st -> getGroupAndMember st user memId
|
|
||||||
case activeConn of
|
|
||||||
Just conn ->
|
|
||||||
acceptFileV2 $ \sharedMsgId fileInvConnReq -> sendDirectMessage conn (XFileAcptInv sharedMsgId fileInvConnReq fileName) (GroupId groupId)
|
|
||||||
_ -> throwChatError $ CEFileInternal "member connection not active" -- should not happen
|
|
||||||
where
|
|
||||||
acceptFileV2 :: (SharedMsgId -> ConnReqInvitation -> m SndMessage) -> m ChatResponse
|
|
||||||
acceptFileV2 sendXFileAcptInv = do
|
|
||||||
sharedMsgId <- withStore $ \st -> getSharedMsgIdByFileId st userId fileId
|
|
||||||
(agentConnId, fileInvConnReq) <- withAgent (`createConnection` SCMInvitation)
|
|
||||||
filePath <- getRcvFilePath fileId filePath_ fileName
|
|
||||||
withStore $ \st -> acceptRcvFileTransfer st userId fileId agentConnId filePath
|
|
||||||
void $ sendXFileAcptInv sharedMsgId fileInvConnReq
|
|
||||||
pure $ CRRcvFileAccepted ft filePath
|
|
||||||
CancelFile fileId -> withUser $ \User {userId} -> do
|
CancelFile fileId -> withUser $ \User {userId} -> do
|
||||||
ft' <- withStore (\st -> getFileTransfer st userId fileId)
|
ft' <- withStore (\st -> getFileTransfer st userId fileId)
|
||||||
withChatLock . procCmd $ do
|
withChatLock . procCmd $ do
|
||||||
unless (fileTransferCancelled ft') $
|
|
||||||
withStore $ \st -> updateFileCancelled st userId fileId
|
|
||||||
case ft' of
|
case ft' of
|
||||||
FTSnd ftm [] -> do
|
|
||||||
pure $ CRSndGroupFileCancelled ftm []
|
|
||||||
FTSnd ftm fts -> do
|
FTSnd ftm fts -> do
|
||||||
|
cancelFileTransfer userId ft' CIFSSndCancelled
|
||||||
forM_ fts $ \ft -> cancelSndFileTransfer ft
|
forM_ fts $ \ft -> cancelSndFileTransfer ft
|
||||||
pure $ CRSndGroupFileCancelled ftm fts
|
pure $ CRSndGroupFileCancelled ftm fts
|
||||||
FTRcv ft -> do
|
FTRcv ft -> do
|
||||||
|
cancelFileTransfer userId ft' CIFSRcvCancelled
|
||||||
cancelRcvFileTransfer ft
|
cancelRcvFileTransfer ft
|
||||||
pure $ CRRcvFileCancelled ft
|
pure $ CRRcvFileCancelled ft
|
||||||
|
where
|
||||||
|
cancelFileTransfer :: MsgDirectionI d => UserId -> FileTransfer -> CIFileStatus d -> m ()
|
||||||
|
cancelFileTransfer userId ft ciFileStatus =
|
||||||
|
unless (fileTransferCancelled ft) $
|
||||||
|
withStore $ \st -> do
|
||||||
|
updateFileCancelled st userId fileId
|
||||||
|
updateCIFileStatus st userId fileId ciFileStatus
|
||||||
FileStatus fileId ->
|
FileStatus fileId ->
|
||||||
CRFileTransferStatus <$> withUser (\User {userId} -> withStore $ \st -> getFileTransferProgress st userId fileId)
|
CRFileTransferStatus <$> withUser (\User {userId} -> withStore $ \st -> getFileTransferProgress st userId fileId)
|
||||||
ShowProfile -> withUser $ \User {profile} -> pure $ CRUserProfile profile
|
ShowProfile -> withUser $ \User {profile} -> pure $ CRUserProfile profile
|
||||||
|
@ -609,14 +626,6 @@ processChatCommand = \case
|
||||||
connId <- withAgent $ \a -> joinConnection a cReq $ directMessage (XContact profile $ Just xContactId)
|
connId <- withAgent $ \a -> joinConnection a cReq $ directMessage (XContact profile $ Just xContactId)
|
||||||
withStore $ \st -> createConnReqConnection st userId connId cReqHash xContactId
|
withStore $ \st -> createConnReqConnection st userId connId cReqHash xContactId
|
||||||
pure CRSentInvitation
|
pure CRSentInvitation
|
||||||
sendNewMsg user ct@Contact {localDisplayName = c} msgContainer mc quotedItem = do
|
|
||||||
ci <- sendDirectChatItem user ct (XMsgNew msgContainer) (CISndMsgContent mc) quotedItem
|
|
||||||
setActive $ ActiveC c
|
|
||||||
pure . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci
|
|
||||||
sendNewGroupMsg user g@(Group gInfo@GroupInfo {localDisplayName = gName} _) msgContainer mc quotedItem = do
|
|
||||||
ci <- sendGroupChatItem user g (XMsgNew msgContainer) (CISndMsgContent mc) quotedItem
|
|
||||||
setActive $ ActiveG gName
|
|
||||||
pure . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci
|
|
||||||
contactMember :: Contact -> [GroupMember] -> Maybe GroupMember
|
contactMember :: Contact -> [GroupMember] -> Maybe GroupMember
|
||||||
contactMember Contact {contactId} =
|
contactMember Contact {contactId} =
|
||||||
find $ \GroupMember {memberContactId = cId, memberStatus = s} ->
|
find $ \GroupMember {memberContactId = cId, memberStatus = s} ->
|
||||||
|
@ -641,17 +650,52 @@ processChatCommand = \case
|
||||||
isReady ct =
|
isReady ct =
|
||||||
let s = connStatus $ activeConn (ct :: Contact)
|
let s = connStatus $ activeConn (ct :: Contact)
|
||||||
in s == ConnReady || s == ConnSndReady
|
in s == ConnReady || s == ConnSndReady
|
||||||
getRcvFilePath :: Int64 -> Maybe FilePath -> String -> m FilePath
|
|
||||||
getRcvFilePath fileId filePath fileName = case filePath of
|
acceptFileReceive :: forall m. ChatMonad m => User -> RcvFileTransfer -> Maybe FilePath -> m FilePath
|
||||||
|
acceptFileReceive user@User {userId} RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName = fName, fileConnReq}, fileStatus, senderDisplayName, grpMemberId} filePath_ = do
|
||||||
|
unless (fileStatus == RFSNew) . throwChatError $ CEFileAlreadyReceiving fName
|
||||||
|
case fileConnReq of
|
||||||
|
-- old file protocol
|
||||||
|
Just connReq ->
|
||||||
|
tryError (withAgent $ \a -> joinConnection a connReq . directMessage $ XFileAcpt fName) >>= \case
|
||||||
|
Right agentConnId -> do
|
||||||
|
filePath <- getRcvFilePath filePath_ fName
|
||||||
|
withStore $ \st -> acceptRcvFileTransfer st userId fileId agentConnId filePath
|
||||||
|
pure filePath
|
||||||
|
Left e -> throwError e
|
||||||
|
-- new file protocol
|
||||||
|
Nothing ->
|
||||||
|
case grpMemberId of
|
||||||
|
Nothing -> do
|
||||||
|
ct <- withStore $ \st -> getContactByName st userId senderDisplayName
|
||||||
|
acceptFileV2 $ \sharedMsgId fileInvConnReq -> sendDirectContactMessage ct $ XFileAcptInv sharedMsgId fileInvConnReq fName
|
||||||
|
Just memId -> do
|
||||||
|
(GroupInfo {groupId}, GroupMember {activeConn}) <- withStore $ \st -> getGroupAndMember st user memId
|
||||||
|
case activeConn of
|
||||||
|
Just conn ->
|
||||||
|
acceptFileV2 $ \sharedMsgId fileInvConnReq -> sendDirectMessage conn (XFileAcptInv sharedMsgId fileInvConnReq fName) (GroupId groupId)
|
||||||
|
_ -> throwChatError $ CEFileInternal "member connection not active" -- should not happen
|
||||||
|
where
|
||||||
|
acceptFileV2 :: (SharedMsgId -> ConnReqInvitation -> m SndMessage) -> m FilePath
|
||||||
|
acceptFileV2 sendXFileAcptInv = do
|
||||||
|
sharedMsgId <- withStore $ \st -> getSharedMsgIdByFileId st userId fileId
|
||||||
|
(agentConnId, fileInvConnReq) <- withAgent (`createConnection` SCMInvitation)
|
||||||
|
filePath <- getRcvFilePath filePath_ fName
|
||||||
|
withStore $ \st -> acceptRcvFileTransfer st userId fileId agentConnId filePath
|
||||||
|
void $ sendXFileAcptInv sharedMsgId fileInvConnReq
|
||||||
|
pure filePath
|
||||||
|
where
|
||||||
|
getRcvFilePath :: Maybe FilePath -> String -> m FilePath
|
||||||
|
getRcvFilePath fPath_ fn = case fPath_ of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
dir <- (`combine` "Downloads") <$> getHomeDirectory
|
dir <- (`combine` "Downloads") <$> getHomeDirectory
|
||||||
ifM (doesDirectoryExist dir) (pure dir) getTemporaryDirectory
|
ifM (doesDirectoryExist dir) (pure dir) getTemporaryDirectory
|
||||||
>>= (`uniqueCombine` fileName)
|
>>= (`uniqueCombine` fn)
|
||||||
>>= createEmptyFile
|
>>= createEmptyFile
|
||||||
Just fPath ->
|
Just fPath ->
|
||||||
ifM
|
ifM
|
||||||
(doesDirectoryExist fPath)
|
(doesDirectoryExist fPath)
|
||||||
(fPath `uniqueCombine` fileName >>= createEmptyFile)
|
(fPath `uniqueCombine` fn >>= createEmptyFile)
|
||||||
$ ifM
|
$ ifM
|
||||||
(doesFileExist fPath)
|
(doesFileExist fPath)
|
||||||
(throwChatError $ CEFileAlreadyExists fPath)
|
(throwChatError $ CEFileAlreadyExists fPath)
|
||||||
|
@ -664,14 +708,14 @@ processChatCommand = \case
|
||||||
h <- getFileHandle fileId fPath rcvFiles AppendMode
|
h <- getFileHandle fileId fPath rcvFiles AppendMode
|
||||||
liftIO $ B.hPut h "" >> hFlush h
|
liftIO $ B.hPut h "" >> hFlush h
|
||||||
pure fPath
|
pure fPath
|
||||||
uniqueCombine :: FilePath -> String -> m FilePath
|
uniqueCombine :: FilePath -> String -> m FilePath
|
||||||
uniqueCombine filePath fileName = tryCombine (0 :: Int)
|
uniqueCombine filePath fileName = tryCombine (0 :: Int)
|
||||||
where
|
where
|
||||||
tryCombine n =
|
tryCombine n =
|
||||||
let (name, ext) = splitExtensions fileName
|
let (name, ext) = splitExtensions fileName
|
||||||
suffix = if n == 0 then "" else "_" <> show n
|
suffix = if n == 0 then "" else "_" <> show n
|
||||||
f = filePath `combine` (name <> suffix <> ext)
|
f = filePath `combine` (name <> suffix <> ext)
|
||||||
in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f)
|
in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f)
|
||||||
|
|
||||||
acceptContactRequest :: ChatMonad m => User -> UserContactRequest -> m Contact
|
acceptContactRequest :: ChatMonad m => User -> UserContactRequest -> m Contact
|
||||||
acceptContactRequest User {userId, profile} UserContactRequest {agentInvitationId = AgentInvId invId, localDisplayName = cName, profileId, profile = p, xContactId} = do
|
acceptContactRequest User {userId, profile} UserContactRequest {agentInvitationId = AgentInvId invId, localDisplayName = cName, profileId, profile = p, xContactId} = do
|
||||||
|
@ -827,7 +871,8 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
|
||||||
XMsgNew mc -> newContentMessage ct mc msg msgMeta
|
XMsgNew mc -> newContentMessage ct mc msg msgMeta
|
||||||
XMsgUpdate sharedMsgId mContent -> messageUpdate ct sharedMsgId mContent msg msgMeta
|
XMsgUpdate sharedMsgId mContent -> messageUpdate ct sharedMsgId mContent msg msgMeta
|
||||||
XMsgDel sharedMsgId -> messageDelete ct sharedMsgId msg msgMeta
|
XMsgDel sharedMsgId -> messageDelete ct sharedMsgId msg msgMeta
|
||||||
XFile fInv -> processFileInvitation ct fInv msg msgMeta
|
-- TODO discontinue XFile
|
||||||
|
XFile fInv -> processFileInvitation' ct fInv msg msgMeta
|
||||||
XFileAcptInv sharedMsgId fileConnReq fName -> xFileAcptInv ct sharedMsgId fileConnReq fName msgMeta
|
XFileAcptInv sharedMsgId fileConnReq fName -> xFileAcptInv ct sharedMsgId fileConnReq fName msgMeta
|
||||||
XInfo p -> xInfo ct p
|
XInfo p -> xInfo ct p
|
||||||
XGrpInv gInv -> processGroupInvitation ct gInv
|
XGrpInv gInv -> processGroupInvitation ct gInv
|
||||||
|
@ -969,7 +1014,8 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
|
||||||
XMsgNew mc -> newGroupContentMessage gInfo m mc msg msgMeta
|
XMsgNew mc -> newGroupContentMessage gInfo m mc msg msgMeta
|
||||||
XMsgUpdate sharedMsgId mContent -> groupMessageUpdate gInfo m sharedMsgId mContent msg
|
XMsgUpdate sharedMsgId mContent -> groupMessageUpdate gInfo m sharedMsgId mContent msg
|
||||||
XMsgDel sharedMsgId -> groupMessageDelete gInfo m sharedMsgId msg
|
XMsgDel sharedMsgId -> groupMessageDelete gInfo m sharedMsgId msg
|
||||||
XFile fInv -> processGroupFileInvitation gInfo m fInv msg msgMeta
|
-- TODO discontinue XFile
|
||||||
|
XFile fInv -> processGroupFileInvitation' gInfo m fInv msg msgMeta
|
||||||
XFileAcptInv sharedMsgId fileConnReq fName -> xFileAcptInvGroup gInfo m sharedMsgId fileConnReq fName msgMeta
|
XFileAcptInv sharedMsgId fileConnReq fName -> xFileAcptInvGroup gInfo m sharedMsgId fileConnReq fName msgMeta
|
||||||
XGrpMemNew memInfo -> xGrpMemNew gInfo m memInfo
|
XGrpMemNew memInfo -> xGrpMemNew gInfo m memInfo
|
||||||
XGrpMemIntro memInfo -> xGrpMemIntro conn gInfo m memInfo
|
XGrpMemIntro memInfo -> xGrpMemIntro conn gInfo m memInfo
|
||||||
|
@ -1056,6 +1102,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
|
||||||
appendFileChunk ft chunkNo chunk
|
appendFileChunk ft chunkNo chunk
|
||||||
withStore $ \st -> do
|
withStore $ \st -> do
|
||||||
updateRcvFileStatus st ft FSComplete
|
updateRcvFileStatus st ft FSComplete
|
||||||
|
updateCIFileStatus st userId fileId CIFSRcvComplete
|
||||||
deleteRcvFileChunks st ft
|
deleteRcvFileChunks st ft
|
||||||
toView $ CRRcvFileComplete ft
|
toView $ CRRcvFileComplete ft
|
||||||
closeFileHandle fileId rcvFiles
|
closeFileHandle fileId rcvFiles
|
||||||
|
@ -1148,13 +1195,24 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
|
||||||
|
|
||||||
newContentMessage :: Contact -> MsgContainer -> RcvMessage -> MsgMeta -> m ()
|
newContentMessage :: Contact -> MsgContainer -> RcvMessage -> MsgMeta -> m ()
|
||||||
newContentMessage ct@Contact {localDisplayName = c} mc msg msgMeta = do
|
newContentMessage ct@Contact {localDisplayName = c} mc msg msgMeta = do
|
||||||
let content = mcContent mc
|
let (ExtMsgContent content fileInvitation_) = mcExtMsgContent mc
|
||||||
ci@ChatItem {formattedText} <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta (CIRcvMsgContent content)
|
ciFile_ <- processFileInvitation fileInvitation_ $
|
||||||
|
\fi chSize -> withStore $ \st -> createRcvFileTransfer st userId ct fi chSize
|
||||||
|
ci@ChatItem {formattedText} <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta (CIRcvMsgContent content) ciFile_
|
||||||
toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
|
toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
|
||||||
checkIntegrity msgMeta $ toView . CRMsgIntegrityError
|
checkIntegrity msgMeta $ toView . CRMsgIntegrityError
|
||||||
showMsgToast (c <> "> ") content formattedText
|
showMsgToast (c <> "> ") content formattedText
|
||||||
setActive $ ActiveC c
|
setActive $ ActiveC c
|
||||||
|
|
||||||
|
processFileInvitation :: Maybe FileInvitation -> (FileInvitation -> Integer -> m RcvFileTransfer) -> m (Maybe (CIFile 'MDRcv))
|
||||||
|
processFileInvitation fileInvitation_ createRcvFileTransferF = case fileInvitation_ of
|
||||||
|
Nothing -> pure Nothing
|
||||||
|
Just fileInvitation@FileInvitation {fileName, fileSize} -> do
|
||||||
|
chSize <- asks $ fileChunkSize . config
|
||||||
|
RcvFileTransfer {fileId} <- createRcvFileTransferF fileInvitation chSize
|
||||||
|
let ciFile = CIFile {fileId, fileName, fileSize, filePath = Nothing, fileStatus = CIFSRcvInvitation}
|
||||||
|
pure $ Just ciFile
|
||||||
|
|
||||||
messageUpdate :: Contact -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> m ()
|
messageUpdate :: Contact -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> m ()
|
||||||
messageUpdate ct@Contact {contactId} sharedMsgId mc RcvMessage {msgId} msgMeta = do
|
messageUpdate ct@Contact {contactId} sharedMsgId mc RcvMessage {msgId} msgMeta = do
|
||||||
CChatItem msgDir ChatItem {meta = CIMeta {itemId}} <- withStore $ \st -> getDirectChatItemBySharedMsgId st userId contactId sharedMsgId
|
CChatItem msgDir ChatItem {meta = CIMeta {itemId}} <- withStore $ \st -> getDirectChatItemBySharedMsgId st userId contactId sharedMsgId
|
||||||
|
@ -1181,8 +1239,10 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
|
||||||
|
|
||||||
newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> MsgMeta -> m ()
|
newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> MsgMeta -> m ()
|
||||||
newGroupContentMessage gInfo m@GroupMember {localDisplayName = c} mc msg msgMeta = do
|
newGroupContentMessage gInfo m@GroupMember {localDisplayName = c} mc msg msgMeta = do
|
||||||
let content = mcContent mc
|
let (ExtMsgContent content fileInvitation_) = mcExtMsgContent mc
|
||||||
ci@ChatItem {formattedText} <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvMsgContent content)
|
ciFile_ <- processFileInvitation fileInvitation_ $
|
||||||
|
\fi chSize -> withStore $ \st -> createRcvGroupFileTransfer st userId m fi chSize
|
||||||
|
ci@ChatItem {formattedText} <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvMsgContent content) ciFile_
|
||||||
groupMsgToView gInfo ci msgMeta
|
groupMsgToView gInfo ci msgMeta
|
||||||
let g = groupName' gInfo
|
let g = groupName' gInfo
|
||||||
showMsgToast ("#" <> g <> " " <> c <> "> ") content formattedText
|
showMsgToast ("#" <> g <> " " <> c <> "> ") content formattedText
|
||||||
|
@ -1212,24 +1272,26 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
|
||||||
else messageError "x.msg.del: group member attempted to delete a message of another member"
|
else messageError "x.msg.del: group member attempted to delete a message of another member"
|
||||||
(SMDSnd, _) -> messageError "x.msg.del: group member attempted invalid message delete"
|
(SMDSnd, _) -> messageError "x.msg.del: group member attempted invalid message delete"
|
||||||
|
|
||||||
processFileInvitation :: Contact -> FileInvitation -> RcvMessage -> MsgMeta -> m ()
|
-- TODO remove once XFile is discontinued
|
||||||
processFileInvitation ct@Contact {localDisplayName = c} fInv msg msgMeta = do
|
processFileInvitation' :: Contact -> FileInvitation -> RcvMessage -> MsgMeta -> m ()
|
||||||
|
processFileInvitation' ct@Contact {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg msgMeta = do
|
||||||
-- TODO chunk size has to be sent as part of invitation
|
-- TODO chunk size has to be sent as part of invitation
|
||||||
chSize <- asks $ fileChunkSize . config
|
chSize <- asks $ fileChunkSize . config
|
||||||
ft@RcvFileTransfer {fileId} <- withStore $ \st -> createRcvFileTransfer st userId ct fInv chSize
|
RcvFileTransfer {fileId} <- withStore $ \st -> createRcvFileTransfer st userId ct fInv chSize
|
||||||
ci <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta (CIRcvFileInvitation ft)
|
let ciFile = Just $ CIFile {fileId, fileName, fileSize, filePath = Nothing, fileStatus = CIFSRcvInvitation}
|
||||||
withStore $ \st -> updateFileTransferChatItemId st fileId $ chatItemId' ci
|
ci <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta (CIRcvMsgContent $ MCText "") ciFile
|
||||||
toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
|
toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
|
||||||
checkIntegrity msgMeta $ toView . CRMsgIntegrityError
|
checkIntegrity msgMeta $ toView . CRMsgIntegrityError
|
||||||
showToast (c <> "> ") "wants to send a file"
|
showToast (c <> "> ") "wants to send a file"
|
||||||
setActive $ ActiveC c
|
setActive $ ActiveC c
|
||||||
|
|
||||||
processGroupFileInvitation :: GroupInfo -> GroupMember -> FileInvitation -> RcvMessage -> MsgMeta -> m ()
|
-- TODO remove once XFile is discontinued
|
||||||
processGroupFileInvitation gInfo m@GroupMember {localDisplayName = c} fInv msg msgMeta = do
|
processGroupFileInvitation' :: GroupInfo -> GroupMember -> FileInvitation -> RcvMessage -> MsgMeta -> m ()
|
||||||
|
processGroupFileInvitation' gInfo m@GroupMember {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg msgMeta = do
|
||||||
chSize <- asks $ fileChunkSize . config
|
chSize <- asks $ fileChunkSize . config
|
||||||
ft@RcvFileTransfer {fileId} <- withStore $ \st -> createRcvGroupFileTransfer st userId m fInv chSize
|
RcvFileTransfer {fileId} <- withStore $ \st -> createRcvGroupFileTransfer st userId m fInv chSize
|
||||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvFileInvitation ft)
|
let ciFile = Just $ CIFile {fileId, fileName, fileSize, filePath = Nothing, fileStatus = CIFSRcvInvitation}
|
||||||
withStore $ \st -> updateFileTransferChatItemId st fileId $ chatItemId' ci
|
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvMsgContent $ MCText "") ciFile
|
||||||
groupMsgToView gInfo ci msgMeta
|
groupMsgToView gInfo ci msgMeta
|
||||||
let g = groupName' gInfo
|
let g = groupName' gInfo
|
||||||
showToast ("#" <> g <> " " <> c <> "> ") "wants to send a file"
|
showToast ("#" <> g <> " " <> c <> "> ") "wants to send a file"
|
||||||
|
@ -1610,35 +1672,27 @@ saveRcvMSG Connection {connId} connOrGroupId agentMsgMeta msgBody = do
|
||||||
rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta}
|
rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta}
|
||||||
withStore $ \st -> createNewMessageAndRcvMsgDelivery st connOrGroupId newMsg sharedMsgId_ rcvMsgDelivery
|
withStore $ \st -> createNewMessageAndRcvMsgDelivery st connOrGroupId newMsg sharedMsgId_ rcvMsgDelivery
|
||||||
|
|
||||||
sendDirectChatItem :: ChatMonad m => User -> Contact -> ChatMsgEvent -> CIContent 'MDSnd -> Maybe (CIQuote 'CTDirect) -> m (ChatItem 'CTDirect 'MDSnd)
|
saveSndChatItem :: ChatMonad m => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIFile 'MDSnd) -> Maybe (CIQuote c) -> m (ChatItem c 'MDSnd)
|
||||||
sendDirectChatItem user ct chatMsgEvent ciContent quotedItem = do
|
saveSndChatItem user cd msg@SndMessage {sharedMsgId} content ciFile quotedItem = do
|
||||||
msg <- sendDirectContactMessage ct chatMsgEvent
|
|
||||||
saveSndChatItem user (CDDirectSnd ct) msg ciContent quotedItem
|
|
||||||
|
|
||||||
sendGroupChatItem :: ChatMonad m => User -> Group -> ChatMsgEvent -> CIContent 'MDSnd -> Maybe (CIQuote 'CTGroup) -> m (ChatItem 'CTGroup 'MDSnd)
|
|
||||||
sendGroupChatItem user (Group g ms) chatMsgEvent ciContent quotedItem = do
|
|
||||||
msg <- sendGroupMessage g ms chatMsgEvent
|
|
||||||
saveSndChatItem user (CDGroupSnd g) msg ciContent quotedItem
|
|
||||||
|
|
||||||
saveSndChatItem :: ChatMonad m => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> m (ChatItem c 'MDSnd)
|
|
||||||
saveSndChatItem user cd msg@SndMessage {sharedMsgId} content quotedItem = do
|
|
||||||
createdAt <- liftIO getCurrentTime
|
createdAt <- liftIO getCurrentTime
|
||||||
ciId <- withStore $ \st -> createNewSndChatItem st user cd msg content quotedItem createdAt
|
ciId <- withStore $ \st -> createNewSndChatItem st user cd msg content quotedItem createdAt
|
||||||
liftIO $ mkChatItem cd ciId content quotedItem (Just sharedMsgId) createdAt createdAt
|
forM_ ciFile $ \CIFile {fileId} -> withStore $ \st -> updateFileTransferChatItemId st fileId ciId
|
||||||
|
liftIO $ mkChatItem cd ciId content ciFile quotedItem (Just sharedMsgId) createdAt createdAt
|
||||||
|
|
||||||
saveRcvChatItem :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> MsgMeta -> CIContent 'MDRcv -> m (ChatItem c 'MDRcv)
|
saveRcvChatItem :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> MsgMeta -> CIContent 'MDRcv -> Maybe (CIFile 'MDRcv) -> m (ChatItem c 'MDRcv)
|
||||||
saveRcvChatItem user cd msg@RcvMessage {sharedMsgId_} MsgMeta {broker = (_, brokerTs)} content = do
|
saveRcvChatItem user cd msg@RcvMessage {sharedMsgId_} MsgMeta {broker = (_, brokerTs)} content ciFile = do
|
||||||
createdAt <- liftIO getCurrentTime
|
createdAt <- liftIO getCurrentTime
|
||||||
(ciId, quotedItem) <- withStore $ \st -> createNewRcvChatItem st user cd msg content brokerTs createdAt -- createNewChatItem st user cd $ mkNewChatItem content msg brokerTs createdAt
|
(ciId, quotedItem) <- withStore $ \st -> createNewRcvChatItem st user cd msg content brokerTs createdAt
|
||||||
liftIO $ mkChatItem cd ciId content quotedItem sharedMsgId_ brokerTs createdAt
|
forM_ ciFile $ \CIFile {fileId} -> withStore $ \st -> updateFileTransferChatItemId st fileId ciId
|
||||||
|
liftIO $ mkChatItem cd ciId content ciFile quotedItem sharedMsgId_ brokerTs createdAt
|
||||||
|
|
||||||
mkChatItem :: MsgDirectionI d => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIQuote c) -> Maybe SharedMsgId -> ChatItemTs -> UTCTime -> IO (ChatItem c d)
|
mkChatItem :: MsgDirectionI d => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> ChatItemTs -> UTCTime -> IO (ChatItem c d)
|
||||||
mkChatItem cd ciId content quotedItem sharedMsgId itemTs createdAt = do
|
mkChatItem cd ciId content file quotedItem sharedMsgId itemTs createdAt = do
|
||||||
tz <- getCurrentTimeZone
|
tz <- getCurrentTimeZone
|
||||||
currentTs <- liftIO getCurrentTime
|
currentTs <- liftIO getCurrentTime
|
||||||
let itemText = ciContentToText content
|
let itemText = ciContentToText content
|
||||||
meta = mkCIMeta ciId content itemText ciStatusNew sharedMsgId False False tz currentTs itemTs createdAt
|
meta = mkCIMeta ciId content itemText ciStatusNew sharedMsgId False False tz currentTs itemTs createdAt
|
||||||
pure ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, file = Nothing}
|
pure ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, file}
|
||||||
|
|
||||||
allowAgentConnection :: ChatMonad m => Connection -> ConfirmationId -> ChatMsgEvent -> m ()
|
allowAgentConnection :: ChatMonad m => Connection -> ConfirmationId -> ChatMsgEvent -> m ()
|
||||||
allowAgentConnection conn confId msg = do
|
allowAgentConnection conn confId msg = do
|
||||||
|
@ -1755,8 +1809,8 @@ chatCommandP =
|
||||||
<|> "/_get chats" $> APIGetChats
|
<|> "/_get chats" $> APIGetChats
|
||||||
<|> "/_get chat " *> (APIGetChat <$> chatTypeP <*> A.decimal <* A.space <*> chatPaginationP)
|
<|> "/_get chat " *> (APIGetChat <$> chatTypeP <*> A.decimal <* A.space <*> chatPaginationP)
|
||||||
<|> "/_get items count=" *> (APIGetChatItems <$> A.decimal)
|
<|> "/_get items count=" *> (APIGetChatItems <$> A.decimal)
|
||||||
<|> "/_send " *> (APISendMessage <$> chatTypeP <*> A.decimal <*> optional filePathTagged <* A.space <*> msgContentP)
|
<|> "/_send " *> (APISendMessage <$> chatTypeP <*> A.decimal <*> optional filePathTagged <*> optional quotedItemIdTagged <* A.space <*> msgContentP)
|
||||||
<|> "/_send_quote " *> (APISendMessageQuote <$> chatTypeP <*> A.decimal <* A.space <*> A.decimal <*> optional filePathTagged <* A.space <*> msgContentP)
|
<|> "/_send_quote " *> (APISendMessageQuote <$> chatTypeP <*> A.decimal <* A.space <*> A.decimal <* A.space <*> msgContentP)
|
||||||
<|> "/_update item " *> (APIUpdateChatItem <$> chatTypeP <*> A.decimal <* A.space <*> A.decimal <* A.space <*> msgContentP)
|
<|> "/_update item " *> (APIUpdateChatItem <$> chatTypeP <*> A.decimal <* A.space <*> A.decimal <* A.space <*> msgContentP)
|
||||||
<|> "/_delete item " *> (APIDeleteChatItem <$> chatTypeP <*> A.decimal <* A.space <*> A.decimal <* A.space <*> ciDeleteMode)
|
<|> "/_delete item " *> (APIDeleteChatItem <$> chatTypeP <*> A.decimal <* A.space <*> A.decimal <* A.space <*> ciDeleteMode)
|
||||||
<|> "/_read chat " *> (APIChatRead <$> chatTypeP <*> A.decimal <* A.space <*> ((,) <$> ("from=" *> A.decimal) <* A.space <*> ("to=" *> A.decimal)))
|
<|> "/_read chat " *> (APIChatRead <$> chatTypeP <*> A.decimal <* A.space <*> ((,) <$> ("from=" *> A.decimal) <* A.space <*> ("to=" *> A.decimal)))
|
||||||
|
@ -1853,6 +1907,7 @@ chatCommandP =
|
||||||
pure $ if B.null n then name else safeDecodeUtf8 n
|
pure $ if B.null n then name else safeDecodeUtf8 n
|
||||||
filePath = T.unpack . safeDecodeUtf8 <$> A.takeByteString
|
filePath = T.unpack . safeDecodeUtf8 <$> A.takeByteString
|
||||||
filePathTagged = " file " *> (T.unpack . safeDecodeUtf8 <$> A.takeTill (== ' '))
|
filePathTagged = " file " *> (T.unpack . safeDecodeUtf8 <$> A.takeTill (== ' '))
|
||||||
|
quotedItemIdTagged = " quoted " *> A.decimal
|
||||||
memberRole =
|
memberRole =
|
||||||
(" owner" $> GROwner)
|
(" owner" $> GROwner)
|
||||||
<|> (" admin" $> GRAdmin)
|
<|> (" admin" $> GRAdmin)
|
||||||
|
|
|
@ -94,8 +94,8 @@ data ChatCommand
|
||||||
| APIGetChats
|
| APIGetChats
|
||||||
| APIGetChat ChatType Int64 ChatPagination
|
| APIGetChat ChatType Int64 ChatPagination
|
||||||
| APIGetChatItems Int
|
| APIGetChatItems Int
|
||||||
| APISendMessage ChatType Int64 (Maybe FilePath) MsgContent
|
| APISendMessage ChatType Int64 (Maybe FilePath) (Maybe ChatItemId) MsgContent
|
||||||
| APISendMessageQuote ChatType Int64 ChatItemId (Maybe FilePath) MsgContent
|
| APISendMessageQuote ChatType Int64 ChatItemId MsgContent -- TODO discontinue
|
||||||
| APIUpdateChatItem ChatType Int64 ChatItemId MsgContent
|
| APIUpdateChatItem ChatType Int64 ChatItemId MsgContent
|
||||||
| APIDeleteChatItem ChatType Int64 ChatItemId CIDeleteMode
|
| APIDeleteChatItem ChatType Int64 ChatItemId CIDeleteMode
|
||||||
| APIChatRead ChatType Int64 (ChatItemId, ChatItemId)
|
| 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 qualified Data.ByteString.Lazy.Char8 as LB
|
||||||
import Data.Int (Int64)
|
import Data.Int (Int64)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as T
|
|
||||||
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
|
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
|
||||||
import Data.Time.Clock (UTCTime, diffUTCTime, nominalDay)
|
import Data.Time.Clock (UTCTime, diffUTCTime, nominalDay)
|
||||||
import Data.Time.LocalTime (TimeZone, ZonedTime, utcToZonedTime)
|
import Data.Time.LocalTime (TimeZone, ZonedTime, utcToZonedTime)
|
||||||
|
@ -80,11 +79,11 @@ data ChatItem (c :: ChatType) (d :: MsgDirection) = ChatItem
|
||||||
content :: CIContent d,
|
content :: CIContent d,
|
||||||
formattedText :: Maybe MarkdownList,
|
formattedText :: Maybe MarkdownList,
|
||||||
quotedItem :: Maybe (CIQuote c),
|
quotedItem :: Maybe (CIQuote c),
|
||||||
file :: Maybe CIFile
|
file :: Maybe (CIFile d)
|
||||||
}
|
}
|
||||||
deriving (Show, Generic)
|
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}
|
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
|
||||||
toEncoding = J.genericToEncoding 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}
|
data JSONAnyChatItem c d = JSONAnyChatItem {chatInfo :: ChatInfo c, chatItem :: ChatItem c d}
|
||||||
deriving (Generic)
|
deriving (Generic)
|
||||||
|
|
||||||
instance ToJSON (JSONAnyChatItem c d) where
|
instance MsgDirectionI d => ToJSON (JSONAnyChatItem c d) where
|
||||||
toJSON = J.genericToJSON J.defaultOptions
|
toJSON = J.genericToJSON J.defaultOptions
|
||||||
toEncoding = J.genericToEncoding J.defaultOptions
|
toEncoding = J.genericToEncoding J.defaultOptions
|
||||||
|
|
||||||
|
@ -266,16 +265,63 @@ quoteMsgDirection = \case
|
||||||
CIQGroupSnd -> MDSnd
|
CIQGroupSnd -> MDSnd
|
||||||
CIQGroupRcv _ -> MDRcv
|
CIQGroupRcv _ -> MDRcv
|
||||||
|
|
||||||
data CIFile = CIFile
|
data CIFile (d :: MsgDirection) = CIFile
|
||||||
{ file :: FilePath, -- local file path
|
{ fileId :: Int64,
|
||||||
loaded :: Bool
|
fileName :: String,
|
||||||
|
fileSize :: Integer,
|
||||||
|
filePath :: Maybe FilePath, -- local file path
|
||||||
|
fileStatus :: CIFileStatus d
|
||||||
}
|
}
|
||||||
deriving (Show, Generic)
|
deriving (Show, Generic)
|
||||||
|
|
||||||
instance ToJSON CIFile where
|
instance MsgDirectionI d => ToJSON (CIFile d) where
|
||||||
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
|
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
|
||||||
toEncoding = J.genericToEncoding 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
|
data CIStatus (d :: MsgDirection) where
|
||||||
CISSndNew :: CIStatus 'MDSnd
|
CISSndNew :: CIStatus 'MDSnd
|
||||||
CISSndSent :: CIStatus 'MDSnd
|
CISSndSent :: CIStatus 'MDSnd
|
||||||
|
@ -377,8 +423,6 @@ data CIContent (d :: MsgDirection) where
|
||||||
CIRcvMsgContent :: MsgContent -> CIContent 'MDRcv
|
CIRcvMsgContent :: MsgContent -> CIContent 'MDRcv
|
||||||
CISndDeleted :: CIDeleteMode -> CIContent 'MDSnd
|
CISndDeleted :: CIDeleteMode -> CIContent 'MDSnd
|
||||||
CIRcvDeleted :: CIDeleteMode -> CIContent 'MDRcv
|
CIRcvDeleted :: CIDeleteMode -> CIContent 'MDRcv
|
||||||
CISndFileInvitation :: FileTransferId -> FilePath -> CIContent 'MDSnd
|
|
||||||
CIRcvFileInvitation :: RcvFileTransfer -> CIContent 'MDRcv
|
|
||||||
|
|
||||||
deriving instance Show (CIContent d)
|
deriving instance Show (CIContent d)
|
||||||
|
|
||||||
|
@ -388,8 +432,6 @@ ciContentToText = \case
|
||||||
CIRcvMsgContent mc -> msgContentText mc
|
CIRcvMsgContent mc -> msgContentText mc
|
||||||
CISndDeleted cidm -> ciDeleteModeToText cidm
|
CISndDeleted cidm -> ciDeleteModeToText cidm
|
||||||
CIRcvDeleted 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_ :: SMsgDirection d -> CIDeleteMode -> CIContent d
|
||||||
msgDirToDeletedContent_ msgDir mode = case msgDir of
|
msgDirToDeletedContent_ msgDir mode = case msgDir of
|
||||||
|
@ -422,8 +464,6 @@ data JSONCIContent
|
||||||
| JCIRcvMsgContent {msgContent :: MsgContent}
|
| JCIRcvMsgContent {msgContent :: MsgContent}
|
||||||
| JCISndDeleted {deleteMode :: CIDeleteMode}
|
| JCISndDeleted {deleteMode :: CIDeleteMode}
|
||||||
| JCIRcvDeleted {deleteMode :: CIDeleteMode}
|
| JCIRcvDeleted {deleteMode :: CIDeleteMode}
|
||||||
| JCISndFileInvitation {fileId :: FileTransferId, filePath :: FilePath}
|
|
||||||
| JCIRcvFileInvitation {rcvFileTransfer :: RcvFileTransfer}
|
|
||||||
deriving (Generic)
|
deriving (Generic)
|
||||||
|
|
||||||
instance FromJSON JSONCIContent where
|
instance FromJSON JSONCIContent where
|
||||||
|
@ -439,8 +479,6 @@ jsonCIContent = \case
|
||||||
CIRcvMsgContent mc -> JCIRcvMsgContent mc
|
CIRcvMsgContent mc -> JCIRcvMsgContent mc
|
||||||
CISndDeleted cidm -> JCISndDeleted cidm
|
CISndDeleted cidm -> JCISndDeleted cidm
|
||||||
CIRcvDeleted cidm -> JCIRcvDeleted cidm
|
CIRcvDeleted cidm -> JCIRcvDeleted cidm
|
||||||
CISndFileInvitation fId fPath -> JCISndFileInvitation fId fPath
|
|
||||||
CIRcvFileInvitation ft -> JCIRcvFileInvitation ft
|
|
||||||
|
|
||||||
aciContentJSON :: JSONCIContent -> ACIContent
|
aciContentJSON :: JSONCIContent -> ACIContent
|
||||||
aciContentJSON = \case
|
aciContentJSON = \case
|
||||||
|
@ -448,8 +486,6 @@ aciContentJSON = \case
|
||||||
JCIRcvMsgContent mc -> ACIContent SMDRcv $ CIRcvMsgContent mc
|
JCIRcvMsgContent mc -> ACIContent SMDRcv $ CIRcvMsgContent mc
|
||||||
JCISndDeleted cidm -> ACIContent SMDSnd $ CISndDeleted cidm
|
JCISndDeleted cidm -> ACIContent SMDSnd $ CISndDeleted cidm
|
||||||
JCIRcvDeleted cidm -> ACIContent SMDRcv $ CIRcvDeleted cidm
|
JCIRcvDeleted cidm -> ACIContent SMDRcv $ CIRcvDeleted cidm
|
||||||
JCISndFileInvitation fId fPath -> ACIContent SMDSnd $ CISndFileInvitation fId fPath
|
|
||||||
JCIRcvFileInvitation ft -> ACIContent SMDRcv $ CIRcvFileInvitation ft
|
|
||||||
|
|
||||||
-- platform independent
|
-- platform independent
|
||||||
data DBJSONCIContent
|
data DBJSONCIContent
|
||||||
|
@ -457,8 +493,6 @@ data DBJSONCIContent
|
||||||
| DBJCIRcvMsgContent {msgContent :: MsgContent}
|
| DBJCIRcvMsgContent {msgContent :: MsgContent}
|
||||||
| DBJCISndDeleted {deleteMode :: CIDeleteMode}
|
| DBJCISndDeleted {deleteMode :: CIDeleteMode}
|
||||||
| DBJCIRcvDeleted {deleteMode :: CIDeleteMode}
|
| DBJCIRcvDeleted {deleteMode :: CIDeleteMode}
|
||||||
| DBJCISndFileInvitation {fileId :: FileTransferId, filePath :: FilePath}
|
|
||||||
| DBJCIRcvFileInvitation {rcvFileTransfer :: RcvFileTransfer}
|
|
||||||
deriving (Generic)
|
deriving (Generic)
|
||||||
|
|
||||||
instance FromJSON DBJSONCIContent where
|
instance FromJSON DBJSONCIContent where
|
||||||
|
@ -474,8 +508,6 @@ dbJsonCIContent = \case
|
||||||
CIRcvMsgContent mc -> DBJCIRcvMsgContent mc
|
CIRcvMsgContent mc -> DBJCIRcvMsgContent mc
|
||||||
CISndDeleted cidm -> DBJCISndDeleted cidm
|
CISndDeleted cidm -> DBJCISndDeleted cidm
|
||||||
CIRcvDeleted cidm -> DBJCIRcvDeleted cidm
|
CIRcvDeleted cidm -> DBJCIRcvDeleted cidm
|
||||||
CISndFileInvitation fId fPath -> DBJCISndFileInvitation fId fPath
|
|
||||||
CIRcvFileInvitation ft -> DBJCIRcvFileInvitation ft
|
|
||||||
|
|
||||||
aciContentDBJSON :: DBJSONCIContent -> ACIContent
|
aciContentDBJSON :: DBJSONCIContent -> ACIContent
|
||||||
aciContentDBJSON = \case
|
aciContentDBJSON = \case
|
||||||
|
@ -483,8 +515,6 @@ aciContentDBJSON = \case
|
||||||
DBJCIRcvMsgContent mc -> ACIContent SMDRcv $ CIRcvMsgContent mc
|
DBJCIRcvMsgContent mc -> ACIContent SMDRcv $ CIRcvMsgContent mc
|
||||||
DBJCISndDeleted cidm -> ACIContent SMDSnd $ CISndDeleted cidm
|
DBJCISndDeleted cidm -> ACIContent SMDSnd $ CISndDeleted cidm
|
||||||
DBJCIRcvDeleted cidm -> ACIContent SMDRcv $ CIRcvDeleted 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
|
data SChatType (c :: ChatType) where
|
||||||
SCTDirect :: SChatType 'CTDirect
|
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
|
|
||||||
|]
|
|
19
src/Simplex/Chat/Migrations/M20220404_files_status_fields.hs
Normal file
19
src/Simplex/Chat/Migrations/M20220404_files_status_fields.hs
Normal file
|
@ -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,
|
chunk_size INTEGER NOT NULL,
|
||||||
created_at TEXT NOT NULL DEFAULT (datetime('now')),
|
created_at TEXT NOT NULL DEFAULT (datetime('now')),
|
||||||
user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE
|
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 (
|
CREATE TABLE snd_files (
|
||||||
file_id INTEGER NOT NULL REFERENCES files ON DELETE CASCADE,
|
file_id INTEGER NOT NULL REFERENCES files ON DELETE CASCADE,
|
||||||
connection_id INTEGER NOT NULL REFERENCES connections ON DELETE CASCADE,
|
connection_id INTEGER NOT NULL REFERENCES connections ON DELETE CASCADE,
|
||||||
|
|
|
@ -112,7 +112,7 @@ data ChatMsgEvent
|
||||||
| XMsgUpdate SharedMsgId MsgContent
|
| XMsgUpdate SharedMsgId MsgContent
|
||||||
| XMsgDel SharedMsgId
|
| XMsgDel SharedMsgId
|
||||||
| XMsgDeleted
|
| XMsgDeleted
|
||||||
| XFile FileInvitation
|
| XFile FileInvitation -- TODO discontinue
|
||||||
| XFileAcpt String -- old file protocol
|
| XFileAcpt String -- old file protocol
|
||||||
| XFileAcptInv SharedMsgId ConnReqInvitation String -- new file protocol
|
| XFileAcptInv SharedMsgId ConnReqInvitation String -- new file protocol
|
||||||
| XInfo Profile
|
| XInfo Profile
|
||||||
|
@ -176,11 +176,11 @@ data MsgContainer
|
||||||
| MCForward ExtMsgContent
|
| MCForward ExtMsgContent
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
mcContent :: MsgContainer -> MsgContent
|
mcExtMsgContent :: MsgContainer -> ExtMsgContent
|
||||||
mcContent = \case
|
mcExtMsgContent = \case
|
||||||
MCSimple (ExtMsgContent c _) -> c
|
MCSimple c -> c
|
||||||
MCQuote _ (ExtMsgContent c _) -> c
|
MCQuote _ c -> c
|
||||||
MCForward (ExtMsgContent c _) -> c
|
MCForward c -> c
|
||||||
|
|
||||||
data LinkPreview = LinkPreview {uri :: Text, title :: Text, description :: Text, image :: ImageData}
|
data LinkPreview = LinkPreview {uri :: Text, title :: Text, description :: Text, image :: ImageData}
|
||||||
deriving (Eq, Show, Generic)
|
deriving (Eq, Show, Generic)
|
||||||
|
|
|
@ -95,6 +95,7 @@ module Simplex.Chat.Store
|
||||||
createSndGroupFileTransferV2,
|
createSndGroupFileTransferV2,
|
||||||
createSndGroupFileTransferV2Connection,
|
createSndGroupFileTransferV2Connection,
|
||||||
updateFileCancelled,
|
updateFileCancelled,
|
||||||
|
updateCIFileStatus,
|
||||||
getSharedMsgIdByFileId,
|
getSharedMsgIdByFileId,
|
||||||
getFileIdBySharedMsgId,
|
getFileIdBySharedMsgId,
|
||||||
getGroupFileIdBySharedMsgId,
|
getGroupFileIdBySharedMsgId,
|
||||||
|
@ -188,7 +189,7 @@ import Simplex.Chat.Migrations.M20220301_smp_servers
|
||||||
import Simplex.Chat.Migrations.M20220302_profile_images
|
import Simplex.Chat.Migrations.M20220302_profile_images
|
||||||
import Simplex.Chat.Migrations.M20220304_msg_quotes
|
import Simplex.Chat.Migrations.M20220304_msg_quotes
|
||||||
import Simplex.Chat.Migrations.M20220321_chat_item_edited
|
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.Protocol
|
||||||
import Simplex.Chat.Types
|
import Simplex.Chat.Types
|
||||||
import Simplex.Chat.Util (eitherToMaybe)
|
import Simplex.Chat.Util (eitherToMaybe)
|
||||||
|
@ -213,7 +214,7 @@ schemaMigrations =
|
||||||
("20220302_profile_images", m20220302_profile_images),
|
("20220302_profile_images", m20220302_profile_images),
|
||||||
("20220304_msg_quotes", m20220304_msg_quotes),
|
("20220304_msg_quotes", m20220304_msg_quotes),
|
||||||
("20220321_chat_item_edited", m20220321_chat_item_edited),
|
("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
|
-- | 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}
|
in Just Contact {contactId, localDisplayName, profile, activeConn, viaGroup, createdAt}
|
||||||
toContact' _ = Nothing
|
toContact' _ = Nothing
|
||||||
|
|
||||||
createSndFileTransfer :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> FilePath -> FileInvitation -> ConnId -> Integer -> m SndFileTransfer
|
createSndFileTransfer :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> FilePath -> FileInvitation -> ConnId -> Integer -> m Int64
|
||||||
createSndFileTransfer st userId Contact {contactId, localDisplayName = recipientDisplayName} filePath FileInvitation {fileName, fileSize} acId chunkSize =
|
createSndFileTransfer st userId Contact {contactId} filePath FileInvitation {fileName, fileSize} acId chunkSize =
|
||||||
liftIO . withTransaction st $ \db -> do
|
liftIO . withTransaction st $ \db -> do
|
||||||
currentTs <- getCurrentTime
|
currentTs <- getCurrentTime
|
||||||
DB.execute
|
DB.execute
|
||||||
db
|
db
|
||||||
"INSERT INTO files (user_id, contact_id, file_name, file_path, file_size, chunk_size, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
|
"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, currentTs, currentTs)
|
(userId, contactId, fileName, filePath, fileSize, chunkSize, CIFSSndStored, currentTs, currentTs)
|
||||||
fileId <- insertedRowId db
|
fileId <- insertedRowId db
|
||||||
Connection {connId} <- createSndFileConnection_ db userId fileId acId
|
Connection {connId} <- createSndFileConnection_ db userId fileId acId
|
||||||
let fileStatus = FSNew
|
let fileStatus = FSNew
|
||||||
|
@ -1798,7 +1799,7 @@ createSndFileTransfer st userId Contact {contactId, localDisplayName = recipient
|
||||||
db
|
db
|
||||||
"INSERT INTO snd_files (file_id, file_status, connection_id, created_at, updated_at) VALUES (?,?,?,?,?)"
|
"INSERT INTO snd_files (file_id, file_status, connection_id, created_at, updated_at) VALUES (?,?,?,?,?)"
|
||||||
(fileId, fileStatus, connId, currentTs, currentTs)
|
(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 :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> FilePath -> FileInvitation -> Integer -> m Int64
|
||||||
createSndFileTransferV2 st userId Contact {contactId} filePath FileInvitation {fileName, fileSize} chunkSize =
|
createSndFileTransferV2 st userId Contact {contactId} filePath FileInvitation {fileName, fileSize} chunkSize =
|
||||||
|
@ -1806,8 +1807,8 @@ createSndFileTransferV2 st userId Contact {contactId} filePath FileInvitation {f
|
||||||
currentTs <- getCurrentTime
|
currentTs <- getCurrentTime
|
||||||
DB.execute
|
DB.execute
|
||||||
db
|
db
|
||||||
"INSERT INTO files (user_id, contact_id, file_name, file_path, file_size, chunk_size, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
|
"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, currentTs, currentTs)
|
(userId, contactId, fileName, filePath, fileSize, chunkSize, CIFSSndStored, currentTs, currentTs)
|
||||||
insertedRowId db
|
insertedRowId db
|
||||||
|
|
||||||
createSndFileTransferV2Connection :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> ConnId -> m ()
|
createSndFileTransferV2Connection :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> ConnId -> m ()
|
||||||
|
@ -1827,8 +1828,8 @@ createSndGroupFileTransfer st userId GroupInfo {groupId} ms filePath fileSize ch
|
||||||
currentTs <- getCurrentTime
|
currentTs <- getCurrentTime
|
||||||
DB.execute
|
DB.execute
|
||||||
db
|
db
|
||||||
"INSERT INTO files (user_id, group_id, file_name, file_path, file_size, chunk_size, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
|
"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, currentTs, currentTs)
|
(userId, groupId, fileName, filePath, fileSize, chunkSize, CIFSSndStored, currentTs, currentTs)
|
||||||
fileId <- insertedRowId db
|
fileId <- insertedRowId db
|
||||||
forM_ ms $ \(GroupMember {groupMemberId}, agentConnId, _) -> do
|
forM_ ms $ \(GroupMember {groupMemberId}, agentConnId, _) -> do
|
||||||
Connection {connId} <- createSndFileConnection_ db userId fileId agentConnId
|
Connection {connId} <- createSndFileConnection_ db userId fileId agentConnId
|
||||||
|
@ -1844,8 +1845,8 @@ createSndGroupFileTransferV2 st userId GroupInfo {groupId} filePath FileInvitati
|
||||||
currentTs <- getCurrentTime
|
currentTs <- getCurrentTime
|
||||||
DB.execute
|
DB.execute
|
||||||
db
|
db
|
||||||
"INSERT INTO files (user_id, group_id, file_name, file_path, file_size, chunk_size, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
|
"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, currentTs, currentTs)
|
(userId, groupId, fileName, filePath, fileSize, chunkSize, CIFSSndStored, currentTs, currentTs)
|
||||||
insertedRowId db
|
insertedRowId db
|
||||||
|
|
||||||
createSndGroupFileTransferV2Connection :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> ConnId -> GroupMember -> m ()
|
createSndGroupFileTransferV2Connection :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> ConnId -> GroupMember -> m ()
|
||||||
|
@ -1864,6 +1865,12 @@ updateFileCancelled st userId fileId =
|
||||||
currentTs <- getCurrentTime
|
currentTs <- getCurrentTime
|
||||||
DB.execute db "UPDATE files SET cancelled = 1, updated_at = ? WHERE user_id = ? AND file_id = ?" (currentTs, userId, fileId)
|
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 :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> m SharedMsgId
|
||||||
getSharedMsgIdByFileId st userId fileId =
|
getSharedMsgIdByFileId st userId fileId =
|
||||||
liftIOEither . withTransaction st $ \db ->
|
liftIOEither . withTransaction st $ \db ->
|
||||||
|
@ -1975,8 +1982,8 @@ createRcvFileTransfer st userId Contact {contactId, localDisplayName = c} f@File
|
||||||
currentTs <- getCurrentTime
|
currentTs <- getCurrentTime
|
||||||
DB.execute
|
DB.execute
|
||||||
db
|
db
|
||||||
"INSERT INTO files (user_id, contact_id, file_name, file_size, chunk_size, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
|
"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, currentTs, currentTs)
|
(userId, contactId, fileName, fileSize, chunkSize, CIFSRcvInvitation, currentTs, currentTs)
|
||||||
fileId <- insertedRowId db
|
fileId <- insertedRowId db
|
||||||
DB.execute
|
DB.execute
|
||||||
db
|
db
|
||||||
|
@ -2052,8 +2059,8 @@ acceptRcvFileTransfer st userId fileId agentConnId filePath =
|
||||||
currentTs <- getCurrentTime
|
currentTs <- getCurrentTime
|
||||||
DB.execute
|
DB.execute
|
||||||
db
|
db
|
||||||
"UPDATE files SET file_path = ?, updated_at = ? WHERE user_id = ? AND file_id = ?"
|
"UPDATE files SET file_path = ?, ci_file_status = ?, updated_at = ? WHERE user_id = ? AND file_id = ?"
|
||||||
(filePath, currentTs, userId, fileId)
|
(filePath, CIFSRcvTransfer, currentTs, userId, fileId)
|
||||||
DB.execute
|
DB.execute
|
||||||
db
|
db
|
||||||
"UPDATE rcv_files SET file_status = ?, updated_at = ? WHERE file_id = ?"
|
"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),
|
COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0),
|
||||||
-- ChatItem
|
-- 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,
|
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
|
-- DirectQuote
|
||||||
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent
|
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent
|
||||||
FROM contacts ct
|
FROM contacts ct
|
||||||
|
@ -2525,6 +2534,7 @@ getDirectChatPreviews_ db User {userId} = do
|
||||||
) MaxIds ON MaxIds.contact_id = ct.contact_id
|
) MaxIds ON MaxIds.contact_id = ct.contact_id
|
||||||
LEFT JOIN chat_items i ON i.contact_id = MaxIds.contact_id
|
LEFT JOIN chat_items i ON i.contact_id = MaxIds.contact_id
|
||||||
AND i.chat_item_id = MaxIds.MaxId
|
AND i.chat_item_id = MaxIds.MaxId
|
||||||
|
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
|
||||||
LEFT JOIN (
|
LEFT JOIN (
|
||||||
SELECT contact_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
SELECT contact_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||||
FROM chat_items
|
FROM chat_items
|
||||||
|
@ -2574,6 +2584,8 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
|
||||||
COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0),
|
COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0),
|
||||||
-- ChatItem
|
-- 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,
|
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
|
-- Maybe GroupMember - sender
|
||||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
|
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,
|
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
|
) MaxIds ON MaxIds.group_id = g.group_id
|
||||||
LEFT JOIN chat_items i ON i.group_id = MaxIds.group_id
|
LEFT JOIN chat_items i ON i.group_id = MaxIds.group_id
|
||||||
AND i.chat_item_id = MaxIds.MaxId
|
AND i.chat_item_id = MaxIds.MaxId
|
||||||
|
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
|
||||||
LEFT JOIN (
|
LEFT JOIN (
|
||||||
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||||
FROM chat_items
|
FROM chat_items
|
||||||
|
@ -2667,9 +2680,12 @@ getDirectChatLast_ db User {userId} contactId count = do
|
||||||
SELECT
|
SELECT
|
||||||
-- ChatItem
|
-- 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,
|
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
|
-- DirectQuote
|
||||||
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent
|
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent
|
||||||
FROM chat_items i
|
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
|
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
|
WHERE i.user_id = ? AND i.contact_id = ? AND i.item_deleted != 1
|
||||||
ORDER BY i.chat_item_id DESC
|
ORDER BY i.chat_item_id DESC
|
||||||
|
@ -2695,9 +2711,12 @@ getDirectChatAfter_ db User {userId} contactId afterChatItemId count = do
|
||||||
SELECT
|
SELECT
|
||||||
-- ChatItem
|
-- 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,
|
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
|
-- DirectQuote
|
||||||
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent
|
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent
|
||||||
FROM chat_items i
|
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
|
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
|
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
|
ORDER BY i.chat_item_id ASC
|
||||||
|
@ -2723,9 +2742,12 @@ getDirectChatBefore_ db User {userId} contactId beforeChatItemId count = do
|
||||||
SELECT
|
SELECT
|
||||||
-- ChatItem
|
-- 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,
|
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
|
-- DirectQuote
|
||||||
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent
|
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent
|
||||||
FROM chat_items i
|
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
|
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
|
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
|
ORDER BY i.chat_item_id DESC
|
||||||
|
@ -2823,6 +2845,8 @@ getGroupChatLast_ db user@User {userId, userContactId} groupId count = do
|
||||||
SELECT
|
SELECT
|
||||||
-- ChatItem
|
-- 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,
|
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
|
-- GroupMember
|
||||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
|
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,
|
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,
|
rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id,
|
||||||
rp.display_name, rp.full_name, rp.image
|
rp.display_name, rp.full_name, rp.image
|
||||||
FROM chat_items i
|
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 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 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
|
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
|
SELECT
|
||||||
-- ChatItem
|
-- 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,
|
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
|
-- GroupMember
|
||||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
|
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,
|
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,
|
rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id,
|
||||||
rp.display_name, rp.full_name, rp.image
|
rp.display_name, rp.full_name, rp.image
|
||||||
FROM chat_items i
|
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 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 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
|
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
|
SELECT
|
||||||
-- ChatItem
|
-- 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,
|
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
|
-- GroupMember
|
||||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
|
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,
|
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,
|
rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id,
|
||||||
rp.display_name, rp.full_name, rp.image
|
rp.display_name, rp.full_name, rp.image
|
||||||
FROM chat_items i
|
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 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 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
|
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
|
SELECT
|
||||||
-- ChatItem
|
-- 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,
|
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
|
-- DirectQuote
|
||||||
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent
|
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent
|
||||||
FROM chat_items i
|
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
|
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 = ?
|
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
|
SELECT
|
||||||
-- ChatItem
|
-- 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,
|
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
|
-- GroupMember
|
||||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
|
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,
|
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,
|
rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id,
|
||||||
rp.display_name, rp.full_name, rp.image
|
rp.display_name, rp.full_name, rp.image
|
||||||
FROM chat_items i
|
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 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 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
|
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 :: ChatStatsRow -> ChatStats
|
||||||
toChatStats (unreadCount, minUnreadItemId) = ChatStats {unreadCount, minUnreadItemId}
|
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 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 :: QuoteRow -> Maybe (CIQuote 'CTDirect)
|
||||||
toDirectQuote qr@(_, _, _, _, quotedSent) = toQuote qr $ direction <$> quotedSent
|
toDirectQuote qr@(_, _, _, _, quotedSent) = toQuote qr $ direction <$> quotedSent
|
||||||
where
|
where
|
||||||
|
@ -3383,22 +3414,33 @@ toQuote (quotedItemId, quotedSharedMsgId, quotedSentAt, quotedMsgContent, _) dir
|
||||||
CIQuote <$> dir <*> pure quotedItemId <*> pure quotedSharedMsgId <*> quotedSentAt <*> quotedMsgContent <*> (parseMaybeMarkdownList . msgContentText <$> quotedMsgContent)
|
CIQuote <$> dir <*> pure quotedItemId <*> pure quotedSharedMsgId <*> quotedSentAt <*> quotedMsgContent <*> (parseMaybeMarkdownList . msgContentText <$> quotedMsgContent)
|
||||||
|
|
||||||
toDirectChatItem :: TimeZone -> UTCTime -> ChatItemRow :. QuoteRow -> Either StoreError (CChatItem 'CTDirect)
|
toDirectChatItem :: TimeZone -> UTCTime -> ChatItemRow :. QuoteRow -> Either StoreError (CChatItem 'CTDirect)
|
||||||
toDirectChatItem tz currentTs ((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt) :. quoteRow) =
|
toDirectChatItem tz currentTs (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_)) :. quoteRow) =
|
||||||
case (itemContent, itemStatus) of
|
case (itemContent, itemStatus, fileStatus_) of
|
||||||
(ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus) -> Right $ cItem SMDSnd CIDirectSnd ciStatus ciContent
|
(ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, Just (AFS SMDSnd fileStatus)) ->
|
||||||
(ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus) -> Right $ cItem SMDRcv CIDirectRcv ciStatus ciContent
|
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
|
_ -> badItem
|
||||||
where
|
where
|
||||||
cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTDirect d -> CIStatus d -> CIContent d -> CChatItem 'CTDirect
|
maybeCIFile :: CIFileStatus d -> Maybe (CIFile d)
|
||||||
cItem d chatDir ciStatus content =
|
maybeCIFile fileStatus =
|
||||||
CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toDirectQuote quoteRow, file = Nothing}
|
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
|
badItem = Left $ SEBadChatItem itemId
|
||||||
ciMeta :: CIContent d -> CIStatus d -> CIMeta d
|
ciMeta :: CIContent d -> CIStatus d -> CIMeta d
|
||||||
ciMeta content status = mkCIMeta itemId content itemText status sharedMsgId itemDeleted (fromMaybe False itemEdited) tz currentTs itemTs createdAt
|
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 :: 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) =
|
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) :. quoteRow)
|
either (const []) (: []) $ toDirectChatItem tz currentTs (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt) :. fileRow) :. quoteRow)
|
||||||
toDirectChatItemList _ _ _ = []
|
toDirectChatItemList _ _ _ = []
|
||||||
|
|
||||||
type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow
|
type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow
|
||||||
|
@ -3414,24 +3456,35 @@ toGroupQuote qr@(_, _, _, _, quotedSent) quotedMember_ = toQuote qr $ direction
|
||||||
direction _ _ = Nothing
|
direction _ _ = Nothing
|
||||||
|
|
||||||
toGroupChatItem :: TimeZone -> UTCTime -> Int64 -> ChatItemRow :. MaybeGroupMemberRow :. GroupQuoteRow -> Either StoreError (CChatItem 'CTGroup)
|
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 member_ = toMaybeGroupMember userContactId memberRow_
|
||||||
let quotedMember_ = toMaybeGroupMember userContactId quotedMemberRow_
|
let quotedMember_ = toMaybeGroupMember userContactId quotedMemberRow_
|
||||||
case (itemContent, itemStatus, member_) of
|
case (itemContent, itemStatus, member_, fileStatus_) of
|
||||||
(ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, _) -> Right $ cItem SMDSnd CIGroupSnd ciStatus ciContent quotedMember_
|
(ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, _, Just (AFS SMDSnd fileStatus)) ->
|
||||||
(ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus, Just member) -> Right $ cItem SMDRcv (CIGroupRcv member) ciStatus ciContent quotedMember_
|
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
|
_ -> badItem
|
||||||
where
|
where
|
||||||
cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTGroup d -> CIStatus d -> CIContent d -> Maybe GroupMember -> CChatItem 'CTGroup
|
maybeCIFile :: CIFileStatus d -> Maybe (CIFile d)
|
||||||
cItem d chatDir ciStatus content quotedMember_ =
|
maybeCIFile fileStatus =
|
||||||
CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toGroupQuote quoteRow quotedMember_, file = Nothing}
|
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
|
badItem = Left $ SEBadChatItem itemId
|
||||||
ciMeta :: CIContent d -> CIStatus d -> CIMeta d
|
ciMeta :: CIContent d -> CIStatus d -> CIMeta d
|
||||||
ciMeta content status = mkCIMeta itemId content itemText status sharedMsgId itemDeleted (fromMaybe False itemEdited) tz currentTs itemTs createdAt
|
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 :: 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_) =
|
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) :. memberRow_ :. quoteRow :. quotedMemberRow_)
|
either (const []) (: []) $ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt) :. fileRow) :. memberRow_ :. quoteRow :. quotedMemberRow_)
|
||||||
toGroupChatItemList _ _ _ _ = []
|
toGroupChatItemList _ _ _ _ = []
|
||||||
|
|
||||||
getSMPServers :: MonadUnliftIO m => SQLiteStore -> User -> m [SMPServer]
|
getSMPServers :: MonadUnliftIO m => SQLiteStore -> User -> m [SMPServer]
|
||||||
|
|
|
@ -156,54 +156,69 @@ responseToView testView = \case
|
||||||
testViewChat :: AChat -> [StyledString]
|
testViewChat :: AChat -> [StyledString]
|
||||||
testViewChat (AChat _ Chat {chatItems}) = [sShow $ map toChatView chatItems]
|
testViewChat (AChat _ Chat {chatItems}) = [sShow $ map toChatView chatItems]
|
||||||
where
|
where
|
||||||
toChatView :: CChatItem c -> ((Int, Text), Maybe (Int, Text))
|
toChatView :: CChatItem c -> ((Int, Text), Maybe (Int, Text), Maybe String)
|
||||||
toChatView (CChatItem dir ChatItem {meta, quotedItem}) =
|
toChatView (CChatItem dir ChatItem {meta, quotedItem, file}) =
|
||||||
((msgDirectionInt $ toMsgDirection dir, itemText meta),) $ case quotedItem of
|
((msgDirectionInt $ toMsgDirection dir, itemText meta), qItem, fPath)
|
||||||
Nothing -> Nothing
|
where
|
||||||
Just CIQuote {chatDir = quoteDir, content} ->
|
qItem = case quotedItem of
|
||||||
Just (msgDirectionInt $ quoteMsgDirection quoteDir, msgContentText content)
|
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 :: [a] -> StyledString -> [StyledString]
|
||||||
viewErrorsSummary summary s = [ttyError (T.pack . show $ length summary) <> s <> " (run with -c option to show each error)" | not (null summary)]
|
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 :: 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
|
DirectChat c -> case chatDir of
|
||||||
CIDirectSnd -> case content of
|
CIDirectSnd -> case content of
|
||||||
CISndMsgContent mc -> viewSentMessage to quote mc meta
|
CISndMsgContent mc -> withSndFile to $ sndMsg to quote mc
|
||||||
CISndDeleted _ -> []
|
CISndDeleted _ -> []
|
||||||
CISndFileInvitation fId fPath -> viewSentFileInvitation to fId fPath meta
|
|
||||||
where
|
where
|
||||||
to = ttyToContact' c
|
to = ttyToContact' c
|
||||||
CIDirectRcv -> case content of
|
CIDirectRcv -> case content of
|
||||||
CIRcvMsgContent mc -> viewReceivedMessage from quote meta mc
|
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
|
||||||
CIRcvDeleted _ -> []
|
CIRcvDeleted _ -> []
|
||||||
CIRcvFileInvitation ft -> viewReceivedFileInvitation from meta ft
|
|
||||||
where
|
where
|
||||||
from = ttyFromContact' c
|
from = ttyFromContact' c
|
||||||
where
|
where
|
||||||
quote = maybe [] (directQuote chatDir) quotedItem
|
quote = maybe [] (directQuote chatDir) quotedItem
|
||||||
GroupChat g -> case chatDir of
|
GroupChat g -> case chatDir of
|
||||||
CIGroupSnd -> case content of
|
CIGroupSnd -> case content of
|
||||||
CISndMsgContent mc -> viewSentMessage to quote mc meta
|
CISndMsgContent mc -> withSndFile to $ sndMsg to quote mc
|
||||||
CISndDeleted _ -> []
|
CISndDeleted _ -> []
|
||||||
CISndFileInvitation fId fPath -> viewSentFileInvitation to fId fPath meta
|
|
||||||
where
|
where
|
||||||
to = ttyToGroup g
|
to = ttyToGroup g
|
||||||
CIGroupRcv m -> case content of
|
CIGroupRcv m -> case content of
|
||||||
CIRcvMsgContent mc -> viewReceivedMessage from quote meta mc
|
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
|
||||||
CIRcvDeleted _ -> []
|
CIRcvDeleted _ -> []
|
||||||
CIRcvFileInvitation ft -> viewReceivedFileInvitation from meta ft
|
|
||||||
where
|
where
|
||||||
from = ttyFromGroup' g m
|
from = ttyFromGroup' g m
|
||||||
where
|
where
|
||||||
quote = maybe [] (groupQuote g) quotedItem
|
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 :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> [StyledString]
|
||||||
viewItemUpdate chat ChatItem {chatDir, meta, content, quotedItem} = case chat of
|
viewItemUpdate chat ChatItem {chatDir, meta, content, quotedItem} = case chat of
|
||||||
DirectChat Contact {localDisplayName = c} -> case chatDir of
|
DirectChat Contact {localDisplayName = c} -> case chatDir of
|
||||||
CIDirectRcv -> case content of
|
CIDirectRcv -> case content of
|
||||||
CIRcvMsgContent mc -> viewReceivedMessage from quote meta mc
|
CIRcvMsgContent mc -> viewReceivedMessage from quote mc meta
|
||||||
_ -> []
|
_ -> []
|
||||||
where
|
where
|
||||||
from = ttyFromContactEdited c
|
from = ttyFromContactEdited c
|
||||||
|
@ -211,7 +226,7 @@ viewItemUpdate chat ChatItem {chatDir, meta, content, quotedItem} = case chat of
|
||||||
CIDirectSnd -> ["message updated"]
|
CIDirectSnd -> ["message updated"]
|
||||||
GroupChat g -> case chatDir of
|
GroupChat g -> case chatDir of
|
||||||
CIGroupRcv GroupMember {localDisplayName = m} -> case content of
|
CIGroupRcv GroupMember {localDisplayName = m} -> case content of
|
||||||
CIRcvMsgContent mc -> viewReceivedMessage from quote meta mc
|
CIRcvMsgContent mc -> viewReceivedMessage from quote mc meta
|
||||||
_ -> []
|
_ -> []
|
||||||
where
|
where
|
||||||
from = ttyFromGroupEdited g m
|
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
|
viewItemDelete chat ChatItem {chatDir, meta, content = deletedContent} ChatItem {content = toContent} = case chat of
|
||||||
DirectChat Contact {localDisplayName = c} -> case (chatDir, deletedContent, toContent) of
|
DirectChat Contact {localDisplayName = c} -> case (chatDir, deletedContent, toContent) of
|
||||||
(CIDirectRcv, CIRcvMsgContent mc, CIRcvDeleted mode) -> case mode of
|
(CIDirectRcv, CIRcvMsgContent mc, CIRcvDeleted mode) -> case mode of
|
||||||
CIDMBroadcast -> viewReceivedMessage (ttyFromContactDeleted c) [] meta mc
|
CIDMBroadcast -> viewReceivedMessage (ttyFromContactDeleted c) [] mc meta
|
||||||
CIDMInternal -> ["message deleted"]
|
CIDMInternal -> ["message deleted"]
|
||||||
(CIDirectSnd, _, _) -> ["message deleted"]
|
(CIDirectSnd, _, _) -> ["message deleted"]
|
||||||
_ -> []
|
_ -> []
|
||||||
GroupChat g -> case (chatDir, deletedContent, toContent) of
|
GroupChat g -> case (chatDir, deletedContent, toContent) of
|
||||||
(CIGroupRcv GroupMember {localDisplayName = m}, CIRcvMsgContent mc, CIRcvDeleted mode) -> case mode 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"]
|
CIDMInternal -> ["message deleted"]
|
||||||
(CIGroupSnd, _, _) -> ["message deleted"]
|
(CIGroupSnd, _, _) -> ["message deleted"]
|
||||||
_ -> []
|
_ -> []
|
||||||
|
@ -434,8 +449,8 @@ viewContactUpdated
|
||||||
where
|
where
|
||||||
fullNameUpdate = if T.null fullName' || fullName' == n' then " removed full name" else " updated full name: " <> plain fullName'
|
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 :: StyledString -> [StyledString] -> MsgContent -> CIMeta d -> [StyledString]
|
||||||
viewReceivedMessage from quote meta = receivedWithTime_ from quote meta . ttyMsgContent
|
viewReceivedMessage from quote mc meta = receivedWithTime_ from quote meta (ttyMsgContent mc)
|
||||||
|
|
||||||
receivedWithTime_ :: StyledString -> [StyledString] -> CIMeta d -> [StyledString] -> [StyledString]
|
receivedWithTime_ :: StyledString -> [StyledString] -> CIMeta d -> [StyledString] -> [StyledString]
|
||||||
receivedWithTime_ from quote CIMeta {localItemTs, createdAt} styledMsg = do
|
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
|
in styleTime $ formatTime defaultTimeLocale format localTime
|
||||||
|
|
||||||
viewSentMessage :: StyledString -> [StyledString] -> MsgContent -> CIMeta d -> [StyledString]
|
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
|
where
|
||||||
indent = if null quote then "" else " "
|
indent = if null quote then "" else " "
|
||||||
|
|
||||||
|
@ -501,11 +516,22 @@ sendingFile_ status ft@SndFileTransfer {recipientDisplayName = c} =
|
||||||
sndFile :: SndFileTransfer -> StyledString
|
sndFile :: SndFileTransfer -> StyledString
|
||||||
sndFile SndFileTransfer {fileId, fileName} = fileTransferStr fileId fileName
|
sndFile SndFileTransfer {fileId, fileName} = fileTransferStr fileId fileName
|
||||||
|
|
||||||
viewReceivedFileInvitation :: StyledString -> CIMeta d -> RcvFileTransfer -> [StyledString]
|
viewReceivedFileInvitation :: StyledString -> CIFile d -> CIMeta d -> [StyledString]
|
||||||
viewReceivedFileInvitation from meta ft = receivedWithTime_ from [] meta (receivedFileInvitation_ ft)
|
viewReceivedFileInvitation from file meta = receivedWithTime_ from [] meta (receivedFileInvitation_ file)
|
||||||
|
|
||||||
receivedFileInvitation_ :: RcvFileTransfer -> [StyledString]
|
receivedFileInvitation_ :: CIFile d -> [StyledString]
|
||||||
receivedFileInvitation_ RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName, fileSize}} =
|
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)",
|
[ "sends file " <> ttyFilePath fileName <> " (" <> humanReadableSize fileSize <> " / " <> sShow fileSize <> " bytes)",
|
||||||
"use " <> highlight ("/fr " <> show fileId <> " [<dir>/ | <path>]") <> " to receive it"
|
"use " <> highlight ("/fr " <> show fileId <> " [<dir>/ | <path>]") <> " to receive it"
|
||||||
]
|
]
|
||||||
|
|
|
@ -125,6 +125,7 @@ testChatN ps test = withTmpFiles $ do
|
||||||
test tcs
|
test tcs
|
||||||
concurrentlyN_ $ map (<// 100000) tcs
|
concurrentlyN_ $ map (<// 100000) tcs
|
||||||
where
|
where
|
||||||
|
getTestCCs :: [(Profile, FilePath)] -> [TestCC] -> IO [TestCC]
|
||||||
getTestCCs [] tcs = pure tcs
|
getTestCCs [] tcs = pure tcs
|
||||||
getTestCCs ((p, db) : envs') tcs = (:) <$> virtualSimplexChat db p <*> getTestCCs envs' tcs
|
getTestCCs ((p, db) : envs') tcs = (:) <$> virtualSimplexChat db p <*> getTestCCs envs' tcs
|
||||||
|
|
||||||
|
|
|
@ -63,6 +63,12 @@ chatTests = do
|
||||||
it "sender cancelled file transfer" testFileSndCancelV2
|
it "sender cancelled file transfer" testFileSndCancelV2
|
||||||
it "recipient cancelled file transfer" testFileRcvCancelV2
|
it "recipient cancelled file transfer" testFileRcvCancelV2
|
||||||
it "send and receive file to group" testGroupFileTransferV2
|
it "send and receive file to group" testGroupFileTransferV2
|
||||||
|
describe "messages with files" $ do
|
||||||
|
it "send and receive message with file" testMessageWithFile
|
||||||
|
it "send and receive image" testSendImage
|
||||||
|
it "send and receive image with text and quote" testSendImageWithTextAndQuote
|
||||||
|
it "send and receive image to group" testGroupSendImage
|
||||||
|
it "send and receive image with text and quote to group" testGroupSendImageWithTextAndQuote
|
||||||
describe "user contact link" $ do
|
describe "user contact link" $ do
|
||||||
it "create and connect via contact link" testUserContactLink
|
it "create and connect via contact link" testUserContactLink
|
||||||
it "auto accept contact requests" testUserContactLinkAutoAccept
|
it "auto accept contact requests" testUserContactLinkAutoAccept
|
||||||
|
@ -239,7 +245,7 @@ testDirectMessageDelete =
|
||||||
alice #$> ("/_get chat @2 count=100", chat, [])
|
alice #$> ("/_get chat @2 count=100", chat, [])
|
||||||
|
|
||||||
alice #$> ("/_update item @2 1 text updating deleted message", id, "cannot update this item")
|
alice #$> ("/_update item @2 1 text updating deleted message", id, "cannot update this item")
|
||||||
alice #$> ("/_send_quote @2 1 text quoting deleted message", id, "cannot reply to this message")
|
alice #$> ("/_send @2 quoted 1 text quoting deleted message", id, "cannot reply to this message")
|
||||||
|
|
||||||
bob #$> ("/_update item @2 2 text hey alice", id, "message updated")
|
bob #$> ("/_update item @2 2 text hey alice", id, "message updated")
|
||||||
alice <# "bob> [edited] hey alice"
|
alice <# "bob> [edited] hey alice"
|
||||||
|
@ -829,7 +835,7 @@ testGroupMessageDelete =
|
||||||
cath #$> ("/_get chat #1 count=100", chat, [(0, "hello!")])
|
cath #$> ("/_get chat #1 count=100", chat, [(0, "hello!")])
|
||||||
|
|
||||||
alice #$> ("/_update item #1 1 text updating deleted message", id, "cannot update this item")
|
alice #$> ("/_update item #1 1 text updating deleted message", id, "cannot update this item")
|
||||||
alice #$> ("/_send_quote #1 1 text quoting deleted message", id, "cannot reply to this message")
|
alice #$> ("/_send #1 quoted 1 text quoting deleted message", id, "cannot reply to this message")
|
||||||
|
|
||||||
threadDelay 1000000
|
threadDelay 1000000
|
||||||
-- msg id 2
|
-- msg id 2
|
||||||
|
@ -1206,6 +1212,192 @@ testGroupFileTransferV2 =
|
||||||
cath <## "completed receiving file 1 (test.jpg) from alice"
|
cath <## "completed receiving file 1 (test.jpg) from alice"
|
||||||
]
|
]
|
||||||
|
|
||||||
|
testMessageWithFile :: IO ()
|
||||||
|
testMessageWithFile =
|
||||||
|
testChat2 aliceProfile bobProfile $
|
||||||
|
\alice bob -> do
|
||||||
|
connectUsers alice bob
|
||||||
|
alice ##> "/_send @2 file ./tests/fixtures/test.jpg text hi, sending a file"
|
||||||
|
alice <# "@bob hi, sending a file"
|
||||||
|
alice <# "/f @bob ./tests/fixtures/test.jpg"
|
||||||
|
alice <## "use /fc 1 to cancel sending"
|
||||||
|
bob <# "alice> hi, sending a file"
|
||||||
|
bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
|
||||||
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
||||||
|
bob ##> "/fr 1 ./tests/tmp"
|
||||||
|
bob <## "saving file 1 from alice to ./tests/tmp/test.jpg"
|
||||||
|
concurrently_
|
||||||
|
(bob <## "started receiving file 1 (test.jpg) from alice")
|
||||||
|
(alice <## "started sending file 1 (test.jpg) to bob")
|
||||||
|
concurrently_
|
||||||
|
(bob <## "completed receiving file 1 (test.jpg) from alice")
|
||||||
|
(alice <## "completed sending file 1 (test.jpg) to bob")
|
||||||
|
src <- B.readFile "./tests/fixtures/test.jpg"
|
||||||
|
dest <- B.readFile "./tests/tmp/test.jpg"
|
||||||
|
dest `shouldBe` src
|
||||||
|
alice #$> ("/_get chat @2 count=100", chatF, [((1, "hi, sending a file"), Just "./tests/fixtures/test.jpg")])
|
||||||
|
bob #$> ("/_get chat @2 count=100", chatF, [((0, "hi, sending a file"), Just "./tests/tmp/test.jpg")])
|
||||||
|
|
||||||
|
testSendImage :: IO ()
|
||||||
|
testSendImage =
|
||||||
|
testChat2 aliceProfile bobProfile $
|
||||||
|
\alice bob -> do
|
||||||
|
connectUsers alice bob
|
||||||
|
alice ##> "/_send @2 file ./tests/fixtures/test.jpg json {\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}"
|
||||||
|
alice <# "/f @bob ./tests/fixtures/test.jpg"
|
||||||
|
alice <## "use /fc 1 to cancel sending"
|
||||||
|
bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
|
||||||
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
||||||
|
bob ##> "/fr 1 ./tests/tmp"
|
||||||
|
bob <## "saving file 1 from alice to ./tests/tmp/test.jpg"
|
||||||
|
concurrently_
|
||||||
|
(bob <## "started receiving file 1 (test.jpg) from alice")
|
||||||
|
(alice <## "started sending file 1 (test.jpg) to bob")
|
||||||
|
concurrently_
|
||||||
|
(bob <## "completed receiving file 1 (test.jpg) from alice")
|
||||||
|
(alice <## "completed sending file 1 (test.jpg) to bob")
|
||||||
|
src <- B.readFile "./tests/fixtures/test.jpg"
|
||||||
|
dest <- B.readFile "./tests/tmp/test.jpg"
|
||||||
|
dest `shouldBe` src
|
||||||
|
alice #$> ("/_get chat @2 count=100", chatF, [((1, ""), Just "./tests/fixtures/test.jpg")])
|
||||||
|
bob #$> ("/_get chat @2 count=100", chatF, [((0, ""), Just "./tests/tmp/test.jpg")])
|
||||||
|
|
||||||
|
testSendImageWithTextAndQuote :: IO ()
|
||||||
|
testSendImageWithTextAndQuote =
|
||||||
|
testChat2 aliceProfile bobProfile $
|
||||||
|
\alice bob -> do
|
||||||
|
connectUsers alice bob
|
||||||
|
bob #> "@alice hi alice"
|
||||||
|
alice <# "bob> hi alice"
|
||||||
|
alice ##> "/_send @2 file ./tests/fixtures/test.jpg quoted 1 json {\"text\":\"hey bob\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}"
|
||||||
|
alice <# "@bob > hi alice"
|
||||||
|
alice <## " hey bob"
|
||||||
|
alice <# "/f @bob ./tests/fixtures/test.jpg"
|
||||||
|
alice <## "use /fc 1 to cancel sending"
|
||||||
|
bob <# "alice> > hi alice"
|
||||||
|
bob <## " hey bob"
|
||||||
|
bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
|
||||||
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
||||||
|
bob ##> "/fr 1 ./tests/tmp"
|
||||||
|
bob <## "saving file 1 from alice to ./tests/tmp/test.jpg"
|
||||||
|
concurrently_
|
||||||
|
(bob <## "started receiving file 1 (test.jpg) from alice")
|
||||||
|
(alice <## "started sending file 1 (test.jpg) to bob")
|
||||||
|
concurrently_
|
||||||
|
(bob <## "completed receiving file 1 (test.jpg) from alice")
|
||||||
|
(alice <## "completed sending file 1 (test.jpg) to bob")
|
||||||
|
src <- B.readFile "./tests/fixtures/test.jpg"
|
||||||
|
dest <- B.readFile "./tests/tmp/test.jpg"
|
||||||
|
dest `shouldBe` src
|
||||||
|
alice #$> ("/_get chat @2 count=100", chat'', [((0, "hi alice"), Nothing, Nothing), ((1, "hey bob"), Just (0, "hi alice"), Just "./tests/fixtures/test.jpg")])
|
||||||
|
alice #$$> ("/_get chats", [("@bob", "hey bob")])
|
||||||
|
bob #$> ("/_get chat @2 count=100", chat'', [((1, "hi alice"), Nothing, Nothing), ((0, "hey bob"), Just (1, "hi alice"), Just "./tests/tmp/test.jpg")])
|
||||||
|
bob #$$> ("/_get chats", [("@alice", "hey bob")])
|
||||||
|
|
||||||
|
testGroupSendImage :: IO ()
|
||||||
|
testGroupSendImage =
|
||||||
|
testChat3 aliceProfile bobProfile cathProfile $
|
||||||
|
\alice bob cath -> do
|
||||||
|
createGroup3 "team" alice bob cath
|
||||||
|
alice ##> "/_send #1 file ./tests/fixtures/test.jpg json {\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}"
|
||||||
|
alice <# "/f #team ./tests/fixtures/test.jpg"
|
||||||
|
alice <## "use /fc 1 to cancel sending"
|
||||||
|
concurrentlyN_
|
||||||
|
[ do
|
||||||
|
bob <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
|
||||||
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it",
|
||||||
|
do
|
||||||
|
cath <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
|
||||||
|
cath <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
||||||
|
]
|
||||||
|
bob ##> "/fr 1 ./tests/tmp/"
|
||||||
|
bob <## "saving file 1 from alice to ./tests/tmp/test.jpg"
|
||||||
|
concurrentlyN_
|
||||||
|
[ do
|
||||||
|
alice <## "started sending file 1 (test.jpg) to bob"
|
||||||
|
alice <## "completed sending file 1 (test.jpg) to bob",
|
||||||
|
do
|
||||||
|
bob <## "started receiving file 1 (test.jpg) from alice"
|
||||||
|
bob <## "completed receiving file 1 (test.jpg) from alice"
|
||||||
|
]
|
||||||
|
cath ##> "/fr 1 ./tests/tmp/"
|
||||||
|
cath <## "saving file 1 from alice to ./tests/tmp/test_1.jpg"
|
||||||
|
concurrentlyN_
|
||||||
|
[ do
|
||||||
|
alice <## "started sending file 1 (test.jpg) to cath"
|
||||||
|
alice <## "completed sending file 1 (test.jpg) to cath",
|
||||||
|
do
|
||||||
|
cath <## "started receiving file 1 (test.jpg) from alice"
|
||||||
|
cath <## "completed receiving file 1 (test.jpg) from alice"
|
||||||
|
]
|
||||||
|
src <- B.readFile "./tests/fixtures/test.jpg"
|
||||||
|
dest <- B.readFile "./tests/tmp/test.jpg"
|
||||||
|
dest `shouldBe` src
|
||||||
|
dest2 <- B.readFile "./tests/tmp/test_1.jpg"
|
||||||
|
dest2 `shouldBe` src
|
||||||
|
alice #$> ("/_get chat #1 count=100", chatF, [((1, ""), Just "./tests/fixtures/test.jpg")])
|
||||||
|
bob #$> ("/_get chat #1 count=100", chatF, [((0, ""), Just "./tests/tmp/test.jpg")])
|
||||||
|
cath #$> ("/_get chat #1 count=100", chatF, [((0, ""), Just "./tests/tmp/test_1.jpg")])
|
||||||
|
|
||||||
|
testGroupSendImageWithTextAndQuote :: IO ()
|
||||||
|
testGroupSendImageWithTextAndQuote =
|
||||||
|
testChat3 aliceProfile bobProfile cathProfile $
|
||||||
|
\alice bob cath -> do
|
||||||
|
createGroup3 "team" alice bob cath
|
||||||
|
bob #> "#team hi team"
|
||||||
|
concurrently_
|
||||||
|
(alice <# "#team bob> hi team")
|
||||||
|
(cath <# "#team bob> hi team")
|
||||||
|
threadDelay 1000000
|
||||||
|
alice ##> "/_send #1 file ./tests/fixtures/test.jpg quoted 1 json {\"text\":\"hey bob\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}"
|
||||||
|
alice <# "#team > bob hi team"
|
||||||
|
alice <## " hey bob"
|
||||||
|
alice <# "/f #team ./tests/fixtures/test.jpg"
|
||||||
|
alice <## "use /fc 1 to cancel sending"
|
||||||
|
concurrentlyN_
|
||||||
|
[ do
|
||||||
|
bob <# "#team alice> > bob hi team"
|
||||||
|
bob <## " hey bob"
|
||||||
|
bob <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
|
||||||
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it",
|
||||||
|
do
|
||||||
|
cath <# "#team alice> > bob hi team"
|
||||||
|
cath <## " hey bob"
|
||||||
|
cath <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
|
||||||
|
cath <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
||||||
|
]
|
||||||
|
bob ##> "/fr 1 ./tests/tmp/"
|
||||||
|
bob <## "saving file 1 from alice to ./tests/tmp/test.jpg"
|
||||||
|
concurrentlyN_
|
||||||
|
[ do
|
||||||
|
alice <## "started sending file 1 (test.jpg) to bob"
|
||||||
|
alice <## "completed sending file 1 (test.jpg) to bob",
|
||||||
|
do
|
||||||
|
bob <## "started receiving file 1 (test.jpg) from alice"
|
||||||
|
bob <## "completed receiving file 1 (test.jpg) from alice"
|
||||||
|
]
|
||||||
|
cath ##> "/fr 1 ./tests/tmp/"
|
||||||
|
cath <## "saving file 1 from alice to ./tests/tmp/test_1.jpg"
|
||||||
|
concurrentlyN_
|
||||||
|
[ do
|
||||||
|
alice <## "started sending file 1 (test.jpg) to cath"
|
||||||
|
alice <## "completed sending file 1 (test.jpg) to cath",
|
||||||
|
do
|
||||||
|
cath <## "started receiving file 1 (test.jpg) from alice"
|
||||||
|
cath <## "completed receiving file 1 (test.jpg) from alice"
|
||||||
|
]
|
||||||
|
src <- B.readFile "./tests/fixtures/test.jpg"
|
||||||
|
dest <- B.readFile "./tests/tmp/test.jpg"
|
||||||
|
dest `shouldBe` src
|
||||||
|
dest2 <- B.readFile "./tests/tmp/test_1.jpg"
|
||||||
|
dest2 `shouldBe` src
|
||||||
|
alice #$> ("/_get chat #1 count=100", chat'', [((0, "hi team"), Nothing, Nothing), ((1, "hey bob"), Just (0, "hi team"), Just "./tests/fixtures/test.jpg")])
|
||||||
|
alice #$$> ("/_get chats", [("#team", "hey bob"), ("@bob", ""), ("@cath", "")])
|
||||||
|
bob #$> ("/_get chat #1 count=100", chat'', [((1, "hi team"), Nothing, Nothing), ((0, "hey bob"), Just (1, "hi team"), Just "./tests/tmp/test.jpg")])
|
||||||
|
bob #$$> ("/_get chats", [("#team", "hey bob"), ("@alice", ""), ("@cath", "")])
|
||||||
|
cath #$> ("/_get chat #1 count=100", chat'', [((0, "hi team"), Nothing, Nothing), ((0, "hey bob"), Just (0, "hi team"), Just "./tests/tmp/test_1.jpg")])
|
||||||
|
cath #$$> ("/_get chats", [("#team", "hey bob"), ("@alice", ""), ("@bob", "")])
|
||||||
|
|
||||||
testUserContactLink :: IO ()
|
testUserContactLink :: IO ()
|
||||||
testUserContactLink = testChat3 aliceProfile bobProfile cathProfile $
|
testUserContactLink = testChat3 aliceProfile bobProfile cathProfile $
|
||||||
\alice bob cath -> do
|
\alice bob cath -> do
|
||||||
|
@ -1567,10 +1759,16 @@ cc #$> (cmd, f, res) = do
|
||||||
(f <$> getTermLine cc) `shouldReturn` res
|
(f <$> getTermLine cc) `shouldReturn` res
|
||||||
|
|
||||||
chat :: String -> [(Int, String)]
|
chat :: String -> [(Int, String)]
|
||||||
chat = map fst . chat'
|
chat = map (\(a, _, _) -> a) . chat''
|
||||||
|
|
||||||
chat' :: String -> [((Int, String), Maybe (Int, String))]
|
chat' :: String -> [((Int, String), Maybe (Int, String))]
|
||||||
chat' = read
|
chat' = map (\(a, b, _) -> (a, b)) . chat''
|
||||||
|
|
||||||
|
chatF :: String -> [((Int, String), Maybe String)]
|
||||||
|
chatF = map (\(a, _, c) -> (a, c)) . chat''
|
||||||
|
|
||||||
|
chat'' :: String -> [((Int, String), Maybe (Int, String), Maybe String)]
|
||||||
|
chat'' = read
|
||||||
|
|
||||||
(#$$>) :: TestCC -> (String, [(String, String)]) -> Expectation
|
(#$$>) :: TestCC -> (String, [(String, String)]) -> Expectation
|
||||||
cc #$$> (cmd, res) = do
|
cc #$$> (cmd, res) = do
|
||||||
|
|
|
@ -96,8 +96,11 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
||||||
"{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"https://simplex.chat\",\"type\":\"link\",\"preview\":{\"description\":\"SimpleX Chat\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA\",\"title\":\"SimpleX Chat\",\"uri\":\"https://simplex.chat\"}}}}"
|
"{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"https://simplex.chat\",\"type\":\"link\",\"preview\":{\"description\":\"SimpleX Chat\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA\",\"title\":\"SimpleX Chat\",\"uri\":\"https://simplex.chat\"}}}}"
|
||||||
#==# XMsgNew (MCSimple (ExtMsgContent (MCLink "https://simplex.chat" $ LinkPreview {uri = "https://simplex.chat", title = "SimpleX Chat", description = "SimpleX Chat", image = ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA"}) Nothing))
|
#==# XMsgNew (MCSimple (ExtMsgContent (MCLink "https://simplex.chat" $ LinkPreview {uri = "https://simplex.chat", title = "SimpleX Chat", description = "SimpleX Chat", image = ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA"}) Nothing))
|
||||||
it "x.msg.new simple image" $
|
it "x.msg.new simple image" $
|
||||||
"{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"https://simplex.chat\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}"
|
"{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}"
|
||||||
#==# XMsgNew (MCSimple (ExtMsgContent (MCImage "https://simplex.chat" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=") Nothing))
|
#==# XMsgNew (MCSimple (ExtMsgContent (MCImage "" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=") Nothing))
|
||||||
|
it "x.msg.new simple image with text" $
|
||||||
|
"{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"here's an image\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}"
|
||||||
|
#==# XMsgNew (MCSimple (ExtMsgContent (MCImage "here's an image" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=") Nothing))
|
||||||
it "x.msg.new chat message " $
|
it "x.msg.new chat message " $
|
||||||
"{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
|
"{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
|
||||||
##==## (ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (ExtMsgContent (MCText "hello") Nothing))))
|
##==## (ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (ExtMsgContent (MCText "hello") Nothing))))
|
||||||
|
@ -120,10 +123,10 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
||||||
it "x.msg.new forward" $
|
it "x.msg.new forward" $
|
||||||
"{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true}}"
|
"{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true}}"
|
||||||
##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") Nothing))
|
##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") Nothing))
|
||||||
it "x.msg.new simple with file invitation" $
|
it "x.msg.new simple with file" $
|
||||||
"{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}"
|
"{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}"
|
||||||
#==# XMsgNew (MCSimple (ExtMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing})))
|
#==# XMsgNew (MCSimple (ExtMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing})))
|
||||||
it "x.msg.new quote with file invitation" $
|
it "x.msg.new quote with file" $
|
||||||
"{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}},\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}"
|
"{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}},\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}"
|
||||||
##==## ChatMessage
|
##==## ChatMessage
|
||||||
(Just $ SharedMsgId "\1\2\3\4")
|
(Just $ SharedMsgId "\1\2\3\4")
|
||||||
|
@ -139,7 +142,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
it "x.msg.new forward with file invitation" $
|
it "x.msg.new forward with file" $
|
||||||
"{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true,\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}"
|
"{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true,\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}"
|
||||||
##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing})))
|
##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing})))
|
||||||
it "x.msg.update" $
|
it "x.msg.update" $
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue