diff --git a/cabal.project b/cabal.project index 1a6942e4b5..190c6e06e0 100644 --- a/cabal.project +++ b/cabal.project @@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: 1116aeeea1869e0de38e9faccea76b329b549804 + tag: 2e5433676eaa5de93ed1ea9726706b9633308477 source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 06875457b0..512638d454 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."1116aeeea1869e0de38e9faccea76b329b549804" = "07ynn7f70hfsdrirmhb9zd257bx90d29l5gjyhh50wd12gaqdm0w"; + "https://github.com/simplex-chat/simplexmq.git"."2e5433676eaa5de93ed1ea9726706b9633308477" = "0ichdf5vsdizqxqy8amx3f5grx5sghiv2gajd2w3l73vnr2rv3bd"; "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38"; "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d"; "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl"; diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 525dc6295f..2b0a55bb68 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -144,6 +144,7 @@ library Simplex.Chat.Migrations.M20240430_ui_theme Simplex.Chat.Migrations.M20240501_chat_deleted Simplex.Chat.Migrations.M20240510_chat_items_via_proxy + Simplex.Chat.Migrations.M20240515_rcv_files_user_approved_relays Simplex.Chat.Mobile Simplex.Chat.Mobile.File Simplex.Chat.Mobile.Shared diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index acdfe116ff..743cef932c 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -47,6 +47,7 @@ import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe, maybeToList) import Data.Ord (Down (..)) +import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeLatin1, encodeUtf8) @@ -90,8 +91,9 @@ import Simplex.FileTransfer.Client.Presets (defaultXFTPServers) import Simplex.FileTransfer.Description (FileDescriptionURI (..), ValidFileDescription) import qualified Simplex.FileTransfer.Description as FD import Simplex.FileTransfer.Protocol (FileParty (..), FilePartyI) +import qualified Simplex.FileTransfer.Transport as XFTP import Simplex.Messaging.Agent as Agent -import Simplex.Messaging.Agent.Client (AgentStatsKey (..), SubInfo (..), agentClientStore, getAgentWorkersDetails, getAgentWorkersSummary, temporaryAgentError, withLockMap) +import Simplex.Messaging.Agent.Client (AgentStatsKey (..), SubInfo (..), agentClientStore, getAgentWorkersDetails, getAgentWorkersSummary, ipAddressProtected, temporaryAgentError, withLockMap) import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), createAgentStore, defaultAgentConfig) import Simplex.Messaging.Agent.Lock (withLock) import Simplex.Messaging.Agent.Protocol @@ -109,7 +111,7 @@ import qualified Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (base64P) -import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), EntityId, ErrorType (..), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolTypeI, SProtocolType (..), SubscriptionMode (..), UserProtocol, userProtocol) +import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), EntityId, ErrorType (..), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth (..), ProtocolTypeI, SProtocolType (..), SubscriptionMode (..), UserProtocol, XFTPServer, userProtocol) import qualified Simplex.Messaging.Protocol as SMP import Simplex.Messaging.ServiceScheme (ServiceScheme (..)) import qualified Simplex.Messaging.TMap as TM @@ -427,7 +429,7 @@ startReceiveUserFiles user = do filesToReceive <- withStore' (`getRcvFilesToReceive` user) forM_ filesToReceive $ \ft -> flip catchChatError (toView . CRChatError (Just user)) $ - toView =<< receiveFile' user ft Nothing Nothing + toView =<< receiveFile' user ft False Nothing Nothing restoreCalls :: CM' () restoreCalls = do @@ -2055,17 +2057,17 @@ processChatCommand' vr = \case ForwardFile chatName fileId -> forwardFile chatName fileId SendFile ForwardImage chatName fileId -> forwardFile chatName fileId SendImage SendFileDescription _chatName _f -> pure $ chatCmdError Nothing "TODO" - ReceiveFile fileId encrypted_ rcvInline_ filePath_ -> withUser $ \_ -> + ReceiveFile fileId userApprovedRelays encrypted_ rcvInline_ filePath_ -> withUser $ \_ -> withFileLock "receiveFile" fileId . procCmd $ do (user, ft@RcvFileTransfer {fileStatus}) <- withStore (`getRcvFileTransferById` fileId) encrypt <- (`fromMaybe` encrypted_) <$> chatReadVar encryptLocalFiles ft' <- (if encrypt && fileStatus == RFSNew then setFileToEncrypt else pure) ft - receiveFile' user ft' rcvInline_ filePath_ - SetFileToReceive fileId encrypted_ -> withUser $ \_ -> do + receiveFile' user ft' userApprovedRelays rcvInline_ filePath_ + SetFileToReceive fileId userApprovedRelays encrypted_ -> withUser $ \_ -> do withFileLock "setFileToReceive" fileId . procCmd $ do encrypt <- (`fromMaybe` encrypted_) <$> chatReadVar encryptLocalFiles cfArgs <- if encrypt then Just <$> (atomically . CF.randomArgs =<< asks random) else pure Nothing - withStore' $ \db -> setRcvFileToReceive db fileId cfArgs + withStore' $ \db -> setRcvFileToReceive db fileId userApprovedRelays cfArgs ok_ CancelFile fileId -> withUser $ \user@User {userId} -> withFileLock "cancelFile" fileId . procCmd $ @@ -2105,13 +2107,8 @@ processChatCommand' vr = \case liftIO $ removeFile fsFilePath `catchAll_` pure () lift . forM_ agentRcvFileId $ \(AgentRcvFileId aFileId) -> withAgent' (`xftpDeleteRcvFile` aFileId) - ci <- withStore $ \db -> do - liftIO $ do - updateCIFileStatus db user fileId CIFSRcvInvitation - updateRcvFileStatus db fileId FSNew - updateRcvFileAgentId db fileId Nothing - lookupChatItemByFileId db vr user fileId - pure $ CRRcvFileCancelled user ci ftr + aci_ <- resetRcvCIFileStatus user fileId CIFSRcvInvitation + pure $ CRRcvFileCancelled user aci_ ftr FileStatus fileId -> withUser $ \user -> do withStore (\db -> lookupChatItemByFileId db vr user fileId) >>= \case Nothing -> do @@ -3052,9 +3049,9 @@ setFileToEncrypt ft@RcvFileTransfer {fileId} = do withStore' $ \db -> setFileCryptoArgs db fileId cfArgs pure (ft :: RcvFileTransfer) {cryptoArgs = Just cfArgs} -receiveFile' :: User -> RcvFileTransfer -> Maybe Bool -> Maybe FilePath -> CM ChatResponse -receiveFile' user ft rcvInline_ filePath_ = do - (CRRcvFileAccepted user <$> acceptFileReceive user ft rcvInline_ filePath_) `catchChatError` processError +receiveFile' :: User -> RcvFileTransfer -> Bool -> Maybe Bool -> Maybe FilePath -> CM ChatResponse +receiveFile' user ft userApprovedRelays rcvInline_ filePath_ = do + (CRRcvFileAccepted user <$> acceptFileReceive user ft userApprovedRelays rcvInline_ filePath_) `catchChatError` processError where processError = \case -- TODO AChatItem in Cancelled events @@ -3062,8 +3059,8 @@ receiveFile' user ft rcvInline_ filePath_ = do ChatErrorAgent (CONN DUPLICATE) _ -> pure $ CRRcvFileAcceptedSndCancelled user ft e -> throwError e -acceptFileReceive :: User -> RcvFileTransfer -> Maybe Bool -> Maybe FilePath -> CM AChatItem -acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = FileInvitation {fileName = fName, fileConnReq, fileInline, fileSize}, fileStatus, grpMemberId, cryptoArgs} rcvInline_ filePath_ = do +acceptFileReceive :: User -> RcvFileTransfer -> Bool -> Maybe Bool -> Maybe FilePath -> CM AChatItem +acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = FileInvitation {fileName = fName, fileConnReq, fileInline, fileSize}, fileStatus, grpMemberId, cryptoArgs} userApprovedRelays rcvInline_ filePath_ = do unless (fileStatus == RFSNew) $ case fileStatus of RFSCancelled _ -> throwChatError $ CEFileCancelled fName _ -> throwChatError $ CEFileAlreadyReceiving fName @@ -3077,15 +3074,16 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI filePath <- getRcvFilePath fileId filePath_ fName True withStore $ \db -> acceptRcvFileTransfer db vr user fileId connIds ConnJoined filePath subMode -- XFTP - (Just XFTPRcvFile {}, _) -> do + (Just XFTPRcvFile {userApprovedRelays = approvedBeforeReady}, _) -> do + let userApproved = approvedBeforeReady || userApprovedRelays filePath <- getRcvFilePath fileId filePath_ fName False (ci, rfd) <- withStore $ \db -> do -- marking file as accepted and reading description in the same transaction -- to prevent race condition with appending description - ci <- xftpAcceptRcvFT db vr user fileId filePath + ci <- xftpAcceptRcvFT db vr user fileId filePath userApproved rfd <- getRcvFileDescrByRcvFileId db fileId pure (ci, rfd) - receiveViaCompleteFD user fileId rfd cryptoArgs + receiveViaCompleteFD user fileId rfd userApproved cryptoArgs pure ci -- group & direct file protocol _ -> do @@ -3130,18 +3128,61 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI || (rcvInline_ == Just True && fileSize <= fileChunkSize * offerChunks) ) -receiveViaCompleteFD :: User -> FileTransferId -> RcvFileDescr -> Maybe CryptoFileArgs -> CM () -receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete} cfArgs = +receiveViaCompleteFD :: User -> FileTransferId -> RcvFileDescr -> Bool -> Maybe CryptoFileArgs -> CM () +receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete} userApprovedRelays cfArgs = when fileDescrComplete $ do rd <- parseFileDescription fileDescrText - aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) rd cfArgs - startReceivingFile user fileId - withStore' $ \db -> updateRcvFileAgentId db fileId (Just $ AgentRcvFileId aFileId) + if userApprovedRelays + then receive' rd True + else do + let srvs = fileServers rd + unknownSrvs <- getUnknownSrvs srvs + let approved = null unknownSrvs + ifM + ((approved ||) <$> ipProtectedForSrvs srvs) + (receive' rd approved) + (relaysNotApproved unknownSrvs) + where + receive' :: ValidFileDescription 'FRecipient -> Bool -> CM () + receive' rd approved = do + aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) rd cfArgs approved + startReceivingFile user fileId + withStore' $ \db -> updateRcvFileAgentId db fileId (Just $ AgentRcvFileId aFileId) + fileServers :: ValidFileDescription 'FRecipient -> [XFTPServer] + fileServers (FD.ValidFileDescription FD.FileDescription {chunks}) = + S.toList $ S.fromList $ concatMap (\FD.FileChunk {replicas} -> map (\FD.FileChunkReplica {server} -> server) replicas) chunks + getUnknownSrvs :: [XFTPServer] -> CM [XFTPServer] + getUnknownSrvs srvs = do + ChatConfig {defaultServers = DefaultAgentServers {xftp = defXftp}} <- asks config + storedSrvs <- map (\ServerCfg {server} -> protoServer server) <$> withStore' (`getProtocolServers` user) + let defXftp' = L.map protoServer defXftp + knownSrvs = fromMaybe defXftp' $ nonEmpty storedSrvs + pure $ filter (`notElem` knownSrvs) srvs + ipProtectedForSrvs :: [XFTPServer] -> CM Bool + ipProtectedForSrvs srvs = do + netCfg <- lift $ withAgent' getNetworkConfig + pure $ all (ipAddressProtected netCfg) srvs + relaysNotApproved :: [XFTPServer] -> CM () + relaysNotApproved unknownSrvs = do + aci_ <- resetRcvCIFileStatus user fileId CIFSRcvInvitation + forM_ aci_ $ \aci -> toView $ CRChatItemUpdated user aci + throwChatError $ CEFileNotApproved fileId unknownSrvs + +resetRcvCIFileStatus :: User -> FileTransferId -> CIFileStatus 'MDRcv -> CM (Maybe AChatItem) +resetRcvCIFileStatus user fileId ciFileStatus = do + vr <- chatVersionRange + withStore $ \db -> do + liftIO $ do + updateCIFileStatus db user fileId ciFileStatus + updateRcvFileStatus db fileId FSNew + updateRcvFileAgentId db fileId Nothing + lookupChatItemByFileId db vr user fileId receiveViaURI :: User -> FileDescriptionURI -> CryptoFile -> CM RcvFileTransfer receiveViaURI user@User {userId} FileDescriptionURI {description} cf@CryptoFile {cryptoArgs} = do fileId <- withStore $ \db -> createRcvStandaloneFileTransfer db userId cf fileSize chunkSize - aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) description cryptoArgs + -- currently the only use case is user migrating via their configured servers, so we pass approvedRelays = True + aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) description cryptoArgs True withStore $ \db -> do liftIO $ do updateRcvFileStatus db fileId FSConnected @@ -3811,6 +3852,10 @@ processAgentMsgRcvFile _corrId aFileId msg = do RFERR e | temporaryAgentError e -> throwChatError $ CEXFTPRcvFile fileId (AgentRcvFileId aFileId) e + | e == XFTP "" XFTP.NOT_APPROVED -> do + aci_ <- resetRcvCIFileStatus user fileId CIFSRcvAborted + agentXFTPDeleteRcvFile aFileId fileId + forM_ aci_ $ \aci -> toView $ CRChatItemUpdated user aci | otherwise -> do ci <- withStore $ \db -> do liftIO $ updateFileCancelled db user fileId CIFSRcvError @@ -4862,8 +4907,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = autoAcceptFile :: Maybe (RcvFileTransfer, CIFile 'MDRcv) -> CM () autoAcceptFile = mapM_ $ \(ft, CIFile {fileSize}) -> do + -- ! autoAcceptFileSize is only used in tests ChatConfig {autoAcceptFileSize = sz} <- asks config - when (sz > fileSize) $ receiveFile' user ft Nothing Nothing >>= toView + when (sz > fileSize) $ receiveFile' user ft False Nothing Nothing >>= toView messageFileDescription :: Contact -> SharedMsgId -> FileDescr -> CM () messageFileDescription ct@Contact {contactId} sharedMsgId fileDescr = do @@ -4889,7 +4935,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = ci <- withStore $ \db -> getAChatItemBySharedMsgId db user cd sharedMsgId toView $ CRRcvFileDescrReady user ci ft' rfd case (fileStatus, xftpRcvFile) of - (RFSAccepted _, Just XFTPRcvFile {}) -> receiveViaCompleteFD user fileId rfd cryptoArgs + (RFSAccepted _, Just XFTPRcvFile {userApprovedRelays}) -> receiveViaCompleteFD user fileId rfd userApprovedRelays cryptoArgs _ -> pure () processFileInvitation :: Maybe FileInvitation -> MsgContent -> (DB.Connection -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer) -> CM (Maybe (RcvFileTransfer, CIFile 'MDRcv)) @@ -7315,8 +7361,8 @@ chatCommandP = ("/fforward " <|> "/ff ") *> (ForwardFile <$> chatNameP' <* A.space <*> A.decimal), ("/image_forward " <|> "/imgf ") *> (ForwardImage <$> chatNameP' <* A.space <*> A.decimal), ("/fdescription " <|> "/fd") *> (SendFileDescription <$> chatNameP' <* A.space <*> filePath), - ("/freceive " <|> "/fr ") *> (ReceiveFile <$> A.decimal <*> optional (" encrypt=" *> onOffP) <*> optional (" inline=" *> onOffP) <*> optional (A.space *> filePath)), - "/_set_file_to_receive " *> (SetFileToReceive <$> A.decimal <*> optional (" encrypt=" *> onOffP)), + ("/freceive " <|> "/fr ") *> (ReceiveFile <$> A.decimal <*> (" approved_relays=" *> onOffP <|> pure False) <*> optional (" encrypt=" *> onOffP) <*> optional (" inline=" *> onOffP) <*> optional (A.space *> filePath)), + "/_set_file_to_receive " *> (SetFileToReceive <$> A.decimal <*> (" approved_relays=" *> onOffP <|> pure False) <*> optional (" encrypt=" *> onOffP)), ("/fcancel " <|> "/fc ") *> (CancelFile <$> A.decimal), ("/fstatus " <|> "/fs ") *> (FileStatus <$> A.decimal), "/_connect contact " *> (APIConnectContactViaAddress <$> A.decimal <*> incognitoOnOffP <* A.space <*> A.decimal), diff --git a/src/Simplex/Chat/AppSettings.hs b/src/Simplex/Chat/AppSettings.hs index 3d63cb2109..2b8b531dc3 100644 --- a/src/Simplex/Chat/AppSettings.hs +++ b/src/Simplex/Chat/AppSettings.hs @@ -29,6 +29,7 @@ data AppSettings = AppSettings { appPlatform :: Maybe AppPlatform, networkConfig :: Maybe NetworkConfig, privacyEncryptLocalFiles :: Maybe Bool, + privacyAskToApproveRelays :: Maybe Bool, privacyAcceptImages :: Maybe Bool, privacyLinkPreviews :: Maybe Bool, privacyShowChatPreviews :: Maybe Bool, @@ -61,6 +62,7 @@ defaultAppSettings = { appPlatform = Nothing, networkConfig = Just defaultNetworkConfig, privacyEncryptLocalFiles = Just True, + privacyAskToApproveRelays = Just True, privacyAcceptImages = Just True, privacyLinkPreviews = Just True, privacyShowChatPreviews = Just True, @@ -92,6 +94,7 @@ defaultParseAppSettings = { appPlatform = Nothing, networkConfig = Nothing, privacyEncryptLocalFiles = Nothing, + privacyAskToApproveRelays = Nothing, privacyAcceptImages = Nothing, privacyLinkPreviews = Nothing, privacyShowChatPreviews = Nothing, @@ -123,6 +126,7 @@ combineAppSettings platformDefaults storedSettings = { appPlatform = p appPlatform, networkConfig = p networkConfig, privacyEncryptLocalFiles = p privacyEncryptLocalFiles, + privacyAskToApproveRelays = p privacyAskToApproveRelays, privacyAcceptImages = p privacyAcceptImages, privacyLinkPreviews = p privacyLinkPreviews, privacyShowChatPreviews = p privacyShowChatPreviews, @@ -166,6 +170,7 @@ instance FromJSON AppSettings where appPlatform <- p "appPlatform" networkConfig <- p "networkConfig" privacyEncryptLocalFiles <- p "privacyEncryptLocalFiles" + privacyAskToApproveRelays <- p "privacyAskToApproveRelays" privacyAcceptImages <- p "privacyAcceptImages" privacyLinkPreviews <- p "privacyLinkPreviews" privacyShowChatPreviews <- p "privacyShowChatPreviews" @@ -194,6 +199,7 @@ instance FromJSON AppSettings where { appPlatform, networkConfig, privacyEncryptLocalFiles, + privacyAskToApproveRelays, privacyAcceptImages, privacyLinkPreviews, privacyShowChatPreviews, diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 267298f188..9ff903514f 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -81,7 +81,7 @@ import Simplex.Messaging.Crypto.Ratchet (PQEncryption) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfTknStatus) import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, parseAll, parseString, sumTypeJSON) -import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType (..), CorrId, NtfServer, ProtoServerWithAuth, ProtocolTypeI, QueueId, SMPMsgMeta (..), SProtocolType, SubscriptionMode (..), UserProtocol, XFTPServerWithAuth, userProtocol) +import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType (..), CorrId, NtfServer, ProtoServerWithAuth, ProtocolTypeI, QueueId, SMPMsgMeta (..), SProtocolType, SubscriptionMode (..), UserProtocol, XFTPServer, XFTPServerWithAuth, userProtocol) import Simplex.Messaging.TMap (TMap) import Simplex.Messaging.Transport (TLS, simplexMQVersion) import Simplex.Messaging.Transport.Client (TransportHost) @@ -458,8 +458,8 @@ data ChatCommand | ForwardFile ChatName FileTransferId | ForwardImage ChatName FileTransferId | SendFileDescription ChatName FilePath - | ReceiveFile {fileId :: FileTransferId, storeEncrypted :: Maybe Bool, fileInline :: Maybe Bool, filePath :: Maybe FilePath} - | SetFileToReceive {fileId :: FileTransferId, storeEncrypted :: Maybe Bool} + | ReceiveFile {fileId :: FileTransferId, userApprovedRelays :: Bool, storeEncrypted :: Maybe Bool, fileInline :: Maybe Bool, filePath :: Maybe FilePath} + | SetFileToReceive {fileId :: FileTransferId, userApprovedRelays :: Bool, storeEncrypted :: Maybe Bool} | CancelFile FileTransferId | FileStatus FileTransferId | ShowProfile -- UserId (not used in UI) @@ -1132,6 +1132,7 @@ data ChatErrorType | CEFileImageType {filePath :: FilePath} | CEFileImageSize {filePath :: FilePath} | CEFileNotReceived {fileId :: FileTransferId} + | CEFileNotApproved {fileId :: FileTransferId, unknownServers :: [XFTPServer]} | CEXFTPRcvFile {fileId :: FileTransferId, agentRcvFileId :: AgentRcvFileId, agentError :: AgentErrorType} | CEXFTPSndFile {fileId :: FileTransferId, agentSndFileId :: AgentSndFileId, agentError :: AgentErrorType} | CEFallbackToSMPProhibited {fileId :: FileTransferId} diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 83417efa59..449731b91c 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -539,6 +539,7 @@ data CIFileStatus (d :: MsgDirection) where CIFSRcvInvitation :: CIFileStatus 'MDRcv CIFSRcvAccepted :: CIFileStatus 'MDRcv CIFSRcvTransfer :: {rcvProgress :: Int64, rcvTotal :: Int64} -> CIFileStatus 'MDRcv + CIFSRcvAborted :: CIFileStatus 'MDRcv CIFSRcvComplete :: CIFileStatus 'MDRcv CIFSRcvCancelled :: CIFileStatus 'MDRcv CIFSRcvError :: CIFileStatus 'MDRcv @@ -558,6 +559,7 @@ ciFileEnded = \case CIFSRcvInvitation -> False CIFSRcvAccepted -> False CIFSRcvTransfer {} -> False + CIFSRcvAborted -> True CIFSRcvCancelled -> True CIFSRcvComplete -> True CIFSRcvError -> True @@ -573,6 +575,7 @@ ciFileLoaded = \case CIFSRcvInvitation -> False CIFSRcvAccepted -> False CIFSRcvTransfer {} -> False + CIFSRcvAborted -> False CIFSRcvCancelled -> False CIFSRcvComplete -> True CIFSRcvError -> False @@ -592,6 +595,7 @@ instance MsgDirectionI d => StrEncoding (CIFileStatus d) where CIFSRcvInvitation -> "rcv_invitation" CIFSRcvAccepted -> "rcv_accepted" CIFSRcvTransfer rcvd total -> strEncode (Str "rcv_transfer", rcvd, total) + CIFSRcvAborted -> "rcv_aborted" CIFSRcvComplete -> "rcv_complete" CIFSRcvCancelled -> "rcv_cancelled" CIFSRcvError -> "rcv_error" @@ -614,6 +618,7 @@ instance StrEncoding ACIFileStatus where "rcv_invitation" -> pure $ AFS SMDRcv CIFSRcvInvitation "rcv_accepted" -> pure $ AFS SMDRcv CIFSRcvAccepted "rcv_transfer" -> AFS SMDRcv <$> progress CIFSRcvTransfer + "rcv_aborted" -> pure $ AFS SMDRcv CIFSRcvAborted "rcv_complete" -> pure $ AFS SMDRcv CIFSRcvComplete "rcv_cancelled" -> pure $ AFS SMDRcv CIFSRcvCancelled "rcv_error" -> pure $ AFS SMDRcv CIFSRcvError @@ -631,6 +636,7 @@ data JSONCIFileStatus | JCIFSRcvInvitation | JCIFSRcvAccepted | JCIFSRcvTransfer {rcvProgress :: Int64, rcvTotal :: Int64} + | JCIFSRcvAborted | JCIFSRcvComplete | JCIFSRcvCancelled | JCIFSRcvError @@ -646,6 +652,7 @@ jsonCIFileStatus = \case CIFSRcvInvitation -> JCIFSRcvInvitation CIFSRcvAccepted -> JCIFSRcvAccepted CIFSRcvTransfer rcvd total -> JCIFSRcvTransfer rcvd total + CIFSRcvAborted -> JCIFSRcvAborted CIFSRcvComplete -> JCIFSRcvComplete CIFSRcvCancelled -> JCIFSRcvCancelled CIFSRcvError -> JCIFSRcvError @@ -661,6 +668,7 @@ aciFileStatusJSON = \case JCIFSRcvInvitation -> AFS SMDRcv CIFSRcvInvitation JCIFSRcvAccepted -> AFS SMDRcv CIFSRcvAccepted JCIFSRcvTransfer rcvd total -> AFS SMDRcv $ CIFSRcvTransfer rcvd total + JCIFSRcvAborted -> AFS SMDRcv CIFSRcvAborted JCIFSRcvComplete -> AFS SMDRcv CIFSRcvComplete JCIFSRcvCancelled -> AFS SMDRcv CIFSRcvCancelled JCIFSRcvError -> AFS SMDRcv CIFSRcvError diff --git a/src/Simplex/Chat/Migrations/M20240515_rcv_files_user_approved_relays.hs b/src/Simplex/Chat/Migrations/M20240515_rcv_files_user_approved_relays.hs new file mode 100644 index 0000000000..cd4f647685 --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20240515_rcv_files_user_approved_relays.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Migrations.M20240515_rcv_files_user_approved_relays where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20240515_rcv_files_user_approved_relays :: Query +m20240515_rcv_files_user_approved_relays = + [sql| +ALTER TABLE rcv_files ADD COLUMN user_approved_relays INTEGER NOT NULL DEFAULT 0; +|] + +down_m20240515_rcv_files_user_approved_relays :: Query +down_m20240515_rcv_files_user_approved_relays = + [sql| +ALTER TABLE rcv_files DROP COLUMN user_approved_relays; +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index 3ac9b9a98e..96d55badf9 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -229,7 +229,8 @@ CREATE TABLE rcv_files( REFERENCES xftp_file_descriptions ON DELETE SET NULL, agent_rcv_file_id BLOB NULL, agent_rcv_file_deleted INTEGER DEFAULT 0 CHECK(agent_rcv_file_deleted NOT NULL), - to_receive INTEGER + to_receive INTEGER, + user_approved_relays INTEGER NOT NULL DEFAULT 0 ); CREATE TABLE snd_file_chunks( file_id INTEGER NOT NULL, diff --git a/src/Simplex/Chat/Store/Files.hs b/src/Simplex/Chat/Store/Files.hs index 528290aa59..d70bbb8970 100644 --- a/src/Simplex/Chat/Store/Files.hs +++ b/src/Simplex/Chat/Store/Files.hs @@ -514,7 +514,7 @@ createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@File rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr let rfdId = (\RcvFileDescr {fileDescrId} -> fileDescrId) <$> rfd_ -- cryptoArgs = Nothing here, the decision to encrypt is made when receiving it - xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_ + xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False, userApprovedRelays = False}) <$> rfd_ fileProtocol = if isJust rfd_ then FPXFTP else FPSMP fileId <- liftIO $ do DB.execute @@ -535,7 +535,7 @@ createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localD rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr let rfdId = (\RcvFileDescr {fileDescrId} -> fileDescrId) <$> rfd_ -- cryptoArgs = Nothing here, the decision to encrypt is made when receiving it - xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_ + xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False, userApprovedRelays = False}) <$> rfd_ fileProtocol = if isJust rfd_ then FPXFTP else FPSMP fileId <- liftIO $ do DB.execute @@ -676,7 +676,9 @@ getRcvFileTransfer_ db userId fileId = do [sql| SELECT r.file_status, r.file_queue_info, r.group_member_id, f.file_name, f.file_size, f.chunk_size, f.cancelled, cs.local_display_name, m.local_display_name, - f.file_path, f.file_crypto_key, f.file_crypto_nonce, r.file_inline, r.rcv_file_inline, r.agent_rcv_file_id, r.agent_rcv_file_deleted, c.connection_id, c.agent_conn_id + f.file_path, f.file_crypto_key, f.file_crypto_nonce, r.file_inline, r.rcv_file_inline, + r.agent_rcv_file_id, r.agent_rcv_file_deleted, r.user_approved_relays, + c.connection_id, c.agent_conn_id FROM rcv_files r JOIN files f USING (file_id) LEFT JOIN connections c ON r.file_id = c.rcv_file_id @@ -690,9 +692,9 @@ getRcvFileTransfer_ db userId fileId = do where rcvFileTransfer :: Maybe RcvFileDescr -> - (FileStatus, Maybe ConnReqInvitation, Maybe Int64, String, Integer, Integer, Maybe Bool) :. (Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe InlineFileMode, Maybe InlineFileMode, Maybe AgentRcvFileId, Bool) :. (Maybe Int64, Maybe AgentConnId) -> + (FileStatus, Maybe ConnReqInvitation, Maybe Int64, String, Integer, Integer, Maybe Bool) :. (Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe InlineFileMode, Maybe InlineFileMode, Maybe AgentRcvFileId, Bool, Bool) :. (Maybe Int64, Maybe AgentConnId) -> ExceptT StoreError IO RcvFileTransfer - rcvFileTransfer rfd_ ((fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_) :. (contactName_, memberName_, filePath_, fileKey, fileNonce, fileInline, rcvFileInline, agentRcvFileId, agentRcvFileDeleted) :. (connId_, agentConnId_)) = + rcvFileTransfer rfd_ ((fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_) :. (contactName_, memberName_, filePath_, fileKey, fileNonce, fileInline, rcvFileInline, agentRcvFileId, agentRcvFileDeleted, userApprovedRelays) :. (connId_, agentConnId_)) = case contactName_ <|> memberName_ <|> standaloneName_ of Nothing -> throwError $ SERcvFileInvalid fileId Just name -> @@ -709,7 +711,7 @@ getRcvFileTransfer_ db userId fileId = do ft senderDisplayName fileStatus = let fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing} cryptoArgs = CFArgs <$> fileKey <*> fileNonce - xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId, agentRcvFileDeleted}) <$> rfd_ + xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId, agentRcvFileDeleted, userApprovedRelays}) <$> rfd_ in RcvFileTransfer {fileId, xftpRcvFile, fileInvitation, fileStatus, rcvFileInline, senderDisplayName, chunkSize, cancelled, grpMemberId, cryptoArgs} rfi = maybe (throwError $ SERcvFileInvalid fileId) pure =<< rfi_ rfi_ = case (filePath_, connId_, agentConnId_) of @@ -720,7 +722,7 @@ getRcvFileTransfer_ db userId fileId = do acceptRcvFileTransfer :: DB.Connection -> VersionRangeChat -> User -> Int64 -> (CommandId, ConnId) -> ConnStatus -> FilePath -> SubscriptionMode -> ExceptT StoreError IO AChatItem acceptRcvFileTransfer db vr user@User {userId} fileId (cmdId, acId) connStatus filePath subMode = ExceptT $ do currentTs <- getCurrentTime - acceptRcvFT_ db user fileId filePath Nothing currentTs + acceptRcvFT_ db user fileId filePath False Nothing currentTs DB.execute db "INSERT INTO connections (agent_conn_id, conn_status, conn_type, rcv_file_id, user_id, created_at, updated_at, to_subscribe) VALUES (?,?,?,?,?,?,?,?)" @@ -740,33 +742,40 @@ getContactByFileId db vr user@User {userId} fileId = do acceptRcvInlineFT :: DB.Connection -> VersionRangeChat -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem acceptRcvInlineFT db vr user fileId filePath = do - liftIO $ acceptRcvFT_ db user fileId filePath (Just IFMOffer) =<< getCurrentTime + liftIO $ acceptRcvFT_ db user fileId filePath False (Just IFMOffer) =<< getCurrentTime getChatItemByFileId db vr user fileId startRcvInlineFT :: DB.Connection -> User -> RcvFileTransfer -> FilePath -> Maybe InlineFileMode -> IO () startRcvInlineFT db user RcvFileTransfer {fileId} filePath rcvFileInline = - acceptRcvFT_ db user fileId filePath rcvFileInline =<< getCurrentTime + acceptRcvFT_ db user fileId filePath False rcvFileInline =<< getCurrentTime -xftpAcceptRcvFT :: DB.Connection -> VersionRangeChat -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem -xftpAcceptRcvFT db vr user fileId filePath = do - liftIO $ acceptRcvFT_ db user fileId filePath Nothing =<< getCurrentTime +xftpAcceptRcvFT :: DB.Connection -> VersionRangeChat -> User -> FileTransferId -> FilePath -> Bool -> ExceptT StoreError IO AChatItem +xftpAcceptRcvFT db vr user fileId filePath userApprovedRelays = do + liftIO $ acceptRcvFT_ db user fileId filePath userApprovedRelays Nothing =<< getCurrentTime getChatItemByFileId db vr user fileId -acceptRcvFT_ :: DB.Connection -> User -> FileTransferId -> FilePath -> Maybe InlineFileMode -> UTCTime -> IO () -acceptRcvFT_ db User {userId} fileId filePath rcvFileInline currentTs = do +acceptRcvFT_ :: DB.Connection -> User -> FileTransferId -> FilePath -> Bool -> Maybe InlineFileMode -> UTCTime -> IO () +acceptRcvFT_ db User {userId} fileId filePath userApprovedRelays rcvFileInline currentTs = do DB.execute db "UPDATE files SET file_path = ?, ci_file_status = ?, updated_at = ? WHERE user_id = ? AND file_id = ?" (filePath, CIFSRcvAccepted, currentTs, userId, fileId) DB.execute db - "UPDATE rcv_files SET rcv_file_inline = ?, file_status = ?, updated_at = ? WHERE file_id = ?" - (rcvFileInline, FSAccepted, currentTs, fileId) + "UPDATE rcv_files SET user_approved_relays = ?, rcv_file_inline = ?, file_status = ?, updated_at = ? WHERE file_id = ?" + (userApprovedRelays, rcvFileInline, FSAccepted, currentTs, fileId) -setRcvFileToReceive :: DB.Connection -> FileTransferId -> Maybe CryptoFileArgs -> IO () -setRcvFileToReceive db fileId cfArgs_ = do +setRcvFileToReceive :: DB.Connection -> FileTransferId -> Bool -> Maybe CryptoFileArgs -> IO () +setRcvFileToReceive db fileId userApprovedRelays cfArgs_ = do currentTs <- getCurrentTime - DB.execute db "UPDATE rcv_files SET to_receive = 1, updated_at = ? WHERE file_id = ?" (currentTs, fileId) + DB.execute + db + [sql| + UPDATE rcv_files + SET to_receive = 1, user_approved_relays = ?, updated_at = ? + WHERE file_id = ? + |] + (userApprovedRelays, currentTs, fileId) forM_ cfArgs_ $ \cfArgs -> setFileCryptoArgs_ db fileId cfArgs currentTs setFileCryptoArgs :: DB.Connection -> FileTransferId -> CryptoFileArgs -> IO () @@ -950,7 +959,7 @@ getFileTransferMeta_ db userId fileId = fileTransferMeta (fileName, fileSize, chunkSize, filePath, fileKey, fileNonce, fileInline, aSndFileId_, agentSndFileDeleted, privateSndFileDescr, cancelled_, xftpRedirectFor) = let cryptoArgs = CFArgs <$> fileKey <*> fileNonce xftpSndFile = (\fId -> XFTPSndFile {agentSndFileId = fId, privateSndFileDescr, agentSndFileDeleted, cryptoArgs}) <$> aSndFileId_ - in FileTransferMeta {fileId, xftpSndFile, xftpRedirectFor, fileName, fileSize, chunkSize, filePath, fileInline, cancelled = fromMaybe False cancelled_} + in FileTransferMeta {fileId, xftpSndFile, xftpRedirectFor, fileName, fileSize, chunkSize, filePath, fileInline, cancelled = fromMaybe False cancelled_} lookupFileTransferRedirectMeta :: DB.Connection -> User -> Int64 -> IO [FileTransferMeta] lookupFileTransferRedirectMeta db User {userId} fileId = do diff --git a/src/Simplex/Chat/Store/Migrations.hs b/src/Simplex/Chat/Store/Migrations.hs index ccc69d100e..a79a31f75d 100644 --- a/src/Simplex/Chat/Store/Migrations.hs +++ b/src/Simplex/Chat/Store/Migrations.hs @@ -108,6 +108,7 @@ import Simplex.Chat.Migrations.M20240402_item_forwarded import Simplex.Chat.Migrations.M20240430_ui_theme import Simplex.Chat.Migrations.M20240501_chat_deleted import Simplex.Chat.Migrations.M20240510_chat_items_via_proxy +import Simplex.Chat.Migrations.M20240515_rcv_files_user_approved_relays import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -215,7 +216,8 @@ schemaMigrations = ("20240402_item_forwarded", m20240402_item_forwarded, Just down_m20240402_item_forwarded), ("20240430_ui_theme", m20240430_ui_theme, Just down_m20240430_ui_theme), ("20240501_chat_deleted", m20240501_chat_deleted, Just down_m20240501_chat_deleted), - ("20240510_chat_items_via_proxy", m20240510_chat_items_via_proxy, Just down_m20240510_chat_items_via_proxy) + ("20240510_chat_items_via_proxy", m20240510_chat_items_via_proxy, Just down_m20240510_chat_items_via_proxy), + ("20240515_rcv_files_user_approved_relays", m20240515_rcv_files_user_approved_relays, Just down_m20240515_rcv_files_user_approved_relays) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 336448d7f5..ca6cd2e375 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -1072,7 +1072,8 @@ data RcvFileTransfer = RcvFileTransfer data XFTPRcvFile = XFTPRcvFile { rcvFileDescription :: RcvFileDescr, agentRcvFileId :: Maybe AgentRcvFileId, - agentRcvFileDeleted :: Bool + agentRcvFileDeleted :: Bool, + userApprovedRelays :: Bool } deriving (Eq, Show) diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 4b3240fe46..1c2b0b2cc1 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -1766,6 +1766,7 @@ viewFileTransferStatusXFTP (AChatItem _ _ _ ChatItem {file = Just CIFile {fileId CIFSRcvInvitation -> ["receiving " <> fstr <> " not accepted yet, use " <> highlight ("/fr " <> show fileId) <> " to receive file"] CIFSRcvAccepted -> ["receiving " <> fstr <> " just started"] CIFSRcvTransfer progress total -> ["receiving " <> fstr <> " progress " <> fileProgressXFTP progress total fileSize] + CIFSRcvAborted -> ["receiving " <> fstr <> " aborted, use " <> highlight ("/fr " <> show fileId) <> " to receive file"] CIFSRcvComplete -> ["receiving " <> fstr <> " complete" <> maybe "" (\(CryptoFile fp _) -> ", path: " <> plain fp) fileSource] CIFSRcvCancelled -> ["receiving " <> fstr <> " cancelled"] CIFSRcvError -> ["receiving " <> fstr <> " error"] @@ -1969,6 +1970,7 @@ viewChatError logLevel testView = \case CEFileImageType _ -> ["image type must be jpg, send as a file using " <> highlight' "/f"] CEFileImageSize _ -> ["max image size: " <> sShow maxImageSize <> " bytes, resize it or send as a file using " <> highlight' "/f"] CEFileNotReceived fileId -> ["file " <> sShow fileId <> " not received"] + CEFileNotApproved fileId unknownSrvs -> ["file " <> sShow fileId <> " aborted, unknwon XFTP servers:"] <> map (plain . show) unknownSrvs CEXFTPRcvFile fileId aFileId e -> ["error receiving XFTP file " <> sShow fileId <> ", agent file id " <> sShow aFileId <> ": " <> sShow e | logLevel == CLLError] CEXFTPSndFile fileId aFileId e -> ["error sending XFTP file " <> sShow fileId <> ", agent file id " <> sShow aFileId <> ": " <> sShow e | logLevel == CLLError] CEFallbackToSMPProhibited fileId -> ["recipient tried to accept file " <> sShow fileId <> " via old protocol, prohibited"]