blade/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2024-12-17 17:20:21 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

core: only send voice messages without acceptance (#1444)

Browse Source 
* core: only send voice messages without acceptance

* remove some unnecessary changes

* update

* refactor receiveInlineMode
This commit is contained in:
Evgeny Poberezkin
2022-11-26 22:39:56 +00:00
committed by GitHub
parent ade8c97b16
commit 7f0355ec67
9 changed files with 98 additions and 58 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat.hs
+28 -22
View File
@@ -132,8 +132,9 @@ createChatDatabase filePrefix key yesToMigrations = do
pure ChatDatabase {chatStore, agentStore}
newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> Maybe (Notification -> IO ()) -> IO ChatController
newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, tbqSize, defaultServers} ChatOpts {smpServers, networkConfig, logConnections, logServerHosts} sendToast = do
let config = cfg {subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers}
newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, tbqSize, defaultServers, inlineFiles} ChatOpts {smpServers, networkConfig, logConnections, logServerHosts, allowInstantFiles} sendToast = do
let inlineFiles' = if allowInstantFiles then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False}
config = cfg {subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles'}
sendNotification = fromMaybe (const $ pure ()) sendToast
firstTime = dbNew chatStore
activeTo <- newTVarIO ActiveNone
@@ -305,7 +306,7 @@ processChatCommand = \case
where
setupSndFileTransfer :: Contact -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta))
setupSndFileTransfer ct = forM file_ $ \file -> do
(fileSize, chSize, fileInline) <- checkSndFile file 1
(fileSize, chSize, fileInline) <- checkSndFile mc file 1
(agentConnId_, fileConnReq) <-
if isJust fileInline
then pure (Nothing, Nothing)
@@ -351,7 +352,7 @@ processChatCommand = \case
where
setupSndFileTransfer :: GroupInfo -> Int -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta))
setupSndFileTransfer gInfo n = forM file_ $ \file -> do
(fileSize, chSize, fileInline) <- checkSndFile file $ fromIntegral n
(fileSize, chSize, fileInline) <- checkSndFile mc file $ fromIntegral n
let fileName = takeFileName file
fileInvitation = FileInvitation {fileName, fileSize, fileConnReq = Nothing, fileInline}
fileStatus = if fileInline == Just IFMSent then CIFSSndTransfer else CIFSSndStored
@@ -1160,18 +1161,18 @@ processChatCommand = \case
contactMember Contact {contactId} =
find $ \GroupMember {memberContactId = cId, memberStatus = s} ->
cId == Just contactId && s /= GSMemRemoved && s /= GSMemLeft
checkSndFile :: FilePath -> Integer -> m (Integer, Integer, Maybe InlineFileMode)
checkSndFile f n = do
checkSndFile :: MsgContent -> FilePath -> Integer -> m (Integer, Integer, Maybe InlineFileMode)
checkSndFile mc f n = do
fsFilePath <- toFSFilePath f
unlessM (doesFileExist fsFilePath) . throwChatError $ CEFileNotFound f
ChatConfig {fileChunkSize, inlineFiles} <- asks config
fileSize <- getFileSize fsFilePath
let chunks = - ((- fileSize) `div` fileChunkSize)
pure (fileSize, fileChunkSize, inlineFileMode inlineFiles chunks n)
inlineFileMode InlineFilesConfig {offerChunks, sendChunks, totalSendChunks} chunks n
pure (fileSize, fileChunkSize, inlineFileMode mc inlineFiles chunks n)
inlineFileMode mc InlineFilesConfig {offerChunks, sendChunks, totalSendChunks} chunks n
| chunks > offerChunks = Nothing
| chunks > sendChunks || chunks * n > totalSendChunks = Just IFMOffer
| otherwise = Just IFMSent
| chunks <= sendChunks && chunks * n <= totalSendChunks && isVoice mc = Just IFMSent
| otherwise = Just IFMOffer
updateProfile :: User -> Profile -> m ChatResponse
updateProfile user@User {profile = p@LocalProfile {profileId, localAlias}} p'@Profile {displayName}
| p' == fromLocalProfile p = pure CRUserProfileNoChange
@@ -2200,7 +2201,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
case featureProhibited forContact ct content of
Just f -> void $ newChatItem (CIRcvChatFeatureRejected f) Nothing
_ -> do
ciFile_ <- processFileInvitation fileInvitation_ $ \db -> createRcvFileTransfer db userId ct
ciFile_ <- processFileInvitation fileInvitation_ content $ \db -> createRcvFileTransfer db userId ct
ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) ciFile_
when (enableNtfs chatSettings) $ showMsgToast (c <> "> ") content formattedText
setActive $ ActiveC c
@@ -2210,10 +2211,10 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
pure ci
processFileInvitation :: Maybe FileInvitation -> (DB.Connection -> FileInvitation -> Maybe InlineFileMode -> Integer -> IO RcvFileTransfer) -> m (Maybe (CIFile 'MDRcv))
processFileInvitation fInv_ createRcvFT = forM fInv_ $ \fInv@FileInvitation {fileName, fileSize} -> do
processFileInvitation :: Maybe FileInvitation -> MsgContent -> (DB.Connection -> FileInvitation -> Maybe InlineFileMode -> Integer -> IO RcvFileTransfer) -> m (Maybe (CIFile 'MDRcv))
processFileInvitation fInv_ mc createRcvFT = forM fInv_ $ \fInv@FileInvitation {fileName, fileSize} -> do
chSize <- asks $ fileChunkSize . config
inline <- receiveInlineMode fInv chSize
inline <- receiveInlineMode fInv (Just mc) chSize
ft@RcvFileTransfer {fileId} <- withStore' $ \db -> createRcvFT db fInv inline chSize
(filePath, fileStatus) <- case inline of
Just IFMSent -> do
@@ -2265,7 +2266,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
case groupFeatureProhibited gInfo content of
Just f -> void $ newChatItem (CIRcvChatFeatureRejected f) Nothing
_ -> do
ciFile_ <- processFileInvitation fInv_ $ \db -> createRcvGroupFileTransfer db userId m
ciFile_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m
ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) ciFile_
let g = groupName' gInfo
when (enableNtfs chatSettings) $ showMsgToast ("#" <> g <> " " <> c <> "> ") content formattedText
@@ -2318,7 +2319,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
processFileInvitation' ct@Contact {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg msgMeta = do
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
chSize <- asks $ fileChunkSize . config
inline <- receiveInlineMode fInv chSize
inline <- receiveInlineMode fInv Nothing chSize
RcvFileTransfer {fileId} <- withStore' $ \db -> createRcvFileTransfer db userId ct fInv inline chSize
let ciFile = Just $ CIFile {fileId, fileName, fileSize, filePath = Nothing, fileStatus = CIFSRcvInvitation}
ci <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta (CIRcvMsgContent $ MCFile "") ciFile
@@ -2330,7 +2331,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
processGroupFileInvitation' :: GroupInfo -> GroupMember -> FileInvitation -> RcvMessage -> MsgMeta -> m ()
processGroupFileInvitation' gInfo m@GroupMember {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg msgMeta = do
chSize <- asks $ fileChunkSize . config
inline <- receiveInlineMode fInv chSize
inline <- receiveInlineMode fInv Nothing chSize
RcvFileTransfer {fileId} <- withStore' $ \db -> createRcvGroupFileTransfer db userId m fInv inline chSize
let ciFile = Just $ CIFile {fileId, fileName, fileSize, filePath = Nothing, fileStatus = CIFSRcvInvitation}
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvMsgContent $ MCFile "") ciFile
@@ -2339,11 +2340,13 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
showToast ("#" <> g <> " " <> c <> "> ") "wants to send a file"
setActive $ ActiveG g
receiveInlineMode :: FileInvitation -> Integer -> m (Maybe InlineFileMode)
receiveInlineMode FileInvitation {fileSize, fileInline} chSize = case fileInline of
inline@(Just _) -> do
rcvChunks <- asks $ receiveChunks . inlineFiles . config
pure $ if fileSize <= rcvChunks * chSize then inline else Nothing
receiveInlineMode :: FileInvitation -> Maybe MsgContent -> Integer -> m (Maybe InlineFileMode)
receiveInlineMode FileInvitation {fileSize, fileInline} mc_ chSize = case fileInline of
Just mode -> do
InlineFilesConfig {receiveChunks, receiveInstant} <- asks $ inlineFiles . config
pure $ if fileSize <= receiveChunks * chSize then inline' receiveInstant else Nothing
where
inline' receiveInstant = if mode == IFMOffer || (receiveInstant && maybe False isVoice mc_) then fileInline else Nothing
_ -> pure Nothing
xFileCancel :: Contact -> SharedMsgId -> MsgMeta -> m ()
@@ -2408,6 +2411,9 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
receiveInlineChunk ft chunk meta
receiveInlineChunk :: RcvFileTransfer -> FileChunk -> MsgMeta -> m ()
receiveInlineChunk RcvFileTransfer {fileId, fileStatus = RFSNew} FileChunk {chunkNo} _
| chunkNo == 1 = throwChatError $ CEFileLargeSentInline fileId
| otherwise = pure ()
receiveInlineChunk ft chunk meta = do
case chunk of
FileChunk {chunkNo} -> when (chunkNo == 1) $ startReceivingFile ft