mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
core: support encrypted local files (#2989)
* core: support encrypted local files * add migration * update agent api, chat api * fix query, exported functions to read/write files * update simplexmq * remove formatting changes * test, fix file size * reduce diff Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> * fail when receiving SMP files with local encryption * update simplexmq * remove style changes --------- Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
This commit is contained in:
committed by
GitHub
parent
1c90eb0a2e
commit
0b214acf97
@@ -66,7 +66,7 @@ sendComposedMessage cc = sendComposedMessage' cc . contactId'
|
||||
|
||||
sendComposedMessage' :: ChatController -> ContactId -> Maybe ChatItemId -> MsgContent -> IO ()
|
||||
sendComposedMessage' cc ctId quotedItemId msgContent = do
|
||||
let cm = ComposedMessage {filePath = Nothing, quotedItemId, msgContent}
|
||||
let cm = ComposedMessage {fileSource = Nothing, quotedItemId, msgContent}
|
||||
sendChatCmd cc (APISendMessage (ChatRef CTDirect ctId) False Nothing cm) >>= \case
|
||||
CRNewChatItem {} -> printLog cc CLLInfo $ "sent message to contact ID " <> show ctId
|
||||
r -> putStrLn $ "unexpected send message response: " <> show r
|
||||
|
||||
@@ -22,8 +22,9 @@ import Control.Monad.Except
|
||||
import Control.Monad.IO.Unlift
|
||||
import Control.Monad.Reader
|
||||
import Crypto.Random (ChaChaDRG)
|
||||
import Data.Aeson (FromJSON (..), ToJSON (..))
|
||||
import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.:?))
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.Aeson.Types as JT
|
||||
import qualified Data.Attoparsec.ByteString.Char8 as A
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
@@ -54,16 +55,18 @@ import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, NetworkConfig)
|
||||
import Simplex.Messaging.Agent.Lock
|
||||
import Simplex.Messaging.Agent.Protocol
|
||||
import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation, SQLiteStore, UpMigration)
|
||||
import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..))
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Crypto.File (CryptoFile (..))
|
||||
import qualified Simplex.Messaging.Crypto.File as CF
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfTknStatus)
|
||||
import Simplex.Messaging.Parsers (dropPrefix, enumJSON, parseAll, parseString, sumTypeJSON)
|
||||
import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType, CorrId, MsgFlags, NtfServer, ProtoServerWithAuth, ProtocolTypeI, QueueId, SProtocolType, UserProtocol, XFTPServerWithAuth)
|
||||
import Simplex.Messaging.TMap (TMap)
|
||||
import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..))
|
||||
import Simplex.Messaging.Transport (simplexMQVersion)
|
||||
import Simplex.Messaging.Transport.Client (TransportHost)
|
||||
import Simplex.Messaging.Util (allFinally, catchAllErrors, tryAllErrors)
|
||||
import Simplex.Messaging.Util (allFinally, catchAllErrors, tryAllErrors, (<$$>))
|
||||
import System.IO (Handle)
|
||||
import System.Mem.Weak (Weak)
|
||||
import UnliftIO.STM
|
||||
@@ -387,8 +390,8 @@ data ChatCommand
|
||||
| ForwardFile ChatName FileTransferId
|
||||
| ForwardImage ChatName FileTransferId
|
||||
| SendFileDescription ChatName FilePath
|
||||
| ReceiveFile {fileId :: FileTransferId, fileInline :: Maybe Bool, filePath :: Maybe FilePath}
|
||||
| SetFileToReceive FileTransferId
|
||||
| ReceiveFile {fileId :: FileTransferId, storeEncrypted :: Bool, fileInline :: Maybe Bool, filePath :: Maybe FilePath}
|
||||
| SetFileToReceive {fileId :: FileTransferId, storeEncrypted :: Bool}
|
||||
| CancelFile FileTransferId
|
||||
| FileStatus FileTransferId
|
||||
| ShowProfile -- UserId (not used in UI)
|
||||
@@ -723,11 +726,24 @@ data UserProfileUpdateSummary = UserProfileUpdateSummary
|
||||
instance ToJSON UserProfileUpdateSummary where toEncoding = J.genericToEncoding J.defaultOptions
|
||||
|
||||
data ComposedMessage = ComposedMessage
|
||||
{ filePath :: Maybe FilePath,
|
||||
{ fileSource :: Maybe CryptoFile,
|
||||
quotedItemId :: Maybe ChatItemId,
|
||||
msgContent :: MsgContent
|
||||
}
|
||||
deriving (Show, Generic, FromJSON)
|
||||
deriving (Show, Generic)
|
||||
|
||||
-- This instance is needed for backward compatibility, can be removed in v6.0
|
||||
instance FromJSON ComposedMessage where
|
||||
parseJSON (J.Object v) = do
|
||||
fileSource <-
|
||||
(v .:? "fileSource") >>= \case
|
||||
Nothing -> CF.plain <$$> (v .:? "filePath")
|
||||
f -> pure f
|
||||
quotedItemId <- v .:? "quotedItemId"
|
||||
msgContent <- v .: "msgContent"
|
||||
pure ComposedMessage {fileSource, quotedItemId, msgContent}
|
||||
parseJSON invalid =
|
||||
JT.prependFailure "bad ComposedMessage, " (JT.typeMismatch "Object" invalid)
|
||||
|
||||
instance ToJSON ComposedMessage where
|
||||
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
|
||||
|
||||
@@ -37,6 +37,8 @@ import Simplex.Chat.Protocol
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Types.Preferences
|
||||
import Simplex.Messaging.Agent.Protocol (AgentMsgId, MsgMeta (..), MsgReceiptStatus (..))
|
||||
import Simplex.Messaging.Crypto.File (CryptoFile (..))
|
||||
import qualified Simplex.Messaging.Crypto.File as CF
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, parseAll, sumTypeJSON)
|
||||
import Simplex.Messaging.Protocol (MsgBody)
|
||||
@@ -459,7 +461,7 @@ data CIFile (d :: MsgDirection) = CIFile
|
||||
{ fileId :: Int64,
|
||||
fileName :: String,
|
||||
fileSize :: Integer,
|
||||
filePath :: Maybe FilePath, -- local file path
|
||||
fileSource :: Maybe CryptoFile, -- local file path with optional key and nonce
|
||||
fileStatus :: CIFileStatus d,
|
||||
fileProtocol :: FileProtocol
|
||||
}
|
||||
@@ -631,6 +633,14 @@ data CIFileInfo = CIFileInfo
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
mkCIFileInfo :: MsgDirectionI d => CIFile d -> CIFileInfo
|
||||
mkCIFileInfo CIFile {fileId, fileStatus, fileSource} =
|
||||
CIFileInfo
|
||||
{ fileId,
|
||||
fileStatus = Just $ AFS msgDirection fileStatus,
|
||||
filePath = CF.filePath <$> fileSource
|
||||
}
|
||||
|
||||
data CIStatus (d :: MsgDirection) where
|
||||
CISSndNew :: CIStatus 'MDSnd
|
||||
CISSndSent :: SndCIStatusProgress -> CIStatus 'MDSnd
|
||||
|
||||
@@ -50,7 +50,7 @@ instance FromField AMsgDirection where fromField = fromIntField_ $ fmap fromMsgD
|
||||
|
||||
instance ToField MsgDirection where toField = toField . msgDirectionInt
|
||||
|
||||
fromIntField_ :: (Typeable a) => (Int64 -> Maybe a) -> Field -> Ok a
|
||||
fromIntField_ :: Typeable a => (Int64 -> Maybe a) -> Field -> Ok a
|
||||
fromIntField_ fromInt = \case
|
||||
f@(Field (SQLInteger i) _) ->
|
||||
case fromInt i of
|
||||
|
||||
@@ -0,0 +1,20 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20230827_file_encryption where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20230827_file_encryption :: Query
|
||||
m20230827_file_encryption =
|
||||
[sql|
|
||||
ALTER TABLE files ADD COLUMN file_crypto_key BLOB;
|
||||
ALTER TABLE files ADD COLUMN file_crypto_nonce BLOB;
|
||||
|]
|
||||
|
||||
down_m20230827_file_encryption :: Query
|
||||
down_m20230827_file_encryption =
|
||||
[sql|
|
||||
ALTER TABLE files DROP COLUMN file_crypto_key;
|
||||
ALTER TABLE files DROP COLUMN file_crypto_nonce;
|
||||
|]
|
||||
@@ -204,7 +204,9 @@ CREATE TABLE files(
|
||||
agent_snd_file_id BLOB NULL,
|
||||
private_snd_file_descr TEXT NULL,
|
||||
agent_snd_file_deleted INTEGER DEFAULT 0 CHECK(agent_snd_file_deleted NOT NULL),
|
||||
protocol TEXT NOT NULL DEFAULT 'smp'
|
||||
protocol TEXT NOT NULL DEFAULT 'smp',
|
||||
file_crypto_key BLOB,
|
||||
file_crypto_nonce BLOB
|
||||
);
|
||||
CREATE TABLE snd_files(
|
||||
file_id INTEGER NOT NULL REFERENCES files ON DELETE CASCADE,
|
||||
|
||||
@@ -35,6 +35,8 @@ import GHC.Generics (Generic)
|
||||
import Simplex.Chat
|
||||
import Simplex.Chat.Controller
|
||||
import Simplex.Chat.Markdown (ParsedMarkdown (..), parseMaybeMarkdownList)
|
||||
import Simplex.Chat.Mobile.File
|
||||
import Simplex.Chat.Mobile.Shared
|
||||
import Simplex.Chat.Mobile.WebRTC
|
||||
import Simplex.Chat.Options
|
||||
import Simplex.Chat.Store
|
||||
@@ -69,6 +71,10 @@ foreign export ccall "chat_encrypt_media" cChatEncryptMedia :: CString -> Ptr Wo
|
||||
|
||||
foreign export ccall "chat_decrypt_media" cChatDecryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString
|
||||
|
||||
foreign export ccall "chat_write_file" cChatWriteFile :: CString -> Ptr Word8 -> CInt -> IO CJSONString
|
||||
|
||||
foreign export ccall "chat_read_file" cChatReadFile :: CString -> CString -> CString -> IO (Ptr Word8)
|
||||
|
||||
-- | check / migrate database and initialize chat controller on success
|
||||
cChatMigrateInit :: CString -> CString -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString
|
||||
cChatMigrateInit fp key conf ctrl = do
|
||||
@@ -151,8 +157,6 @@ defaultMobileConfig =
|
||||
logLevel = CLLError
|
||||
}
|
||||
|
||||
type CJSONString = CString
|
||||
|
||||
getActiveUser_ :: SQLiteStore -> IO (Maybe User)
|
||||
getActiveUser_ st = find activeUser <$> withTransaction st getUsers
|
||||
|
||||
|
||||
@@ -0,0 +1,83 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
|
||||
module Simplex.Chat.Mobile.File
|
||||
( cChatWriteFile,
|
||||
cChatReadFile,
|
||||
WriteFileResult (..),
|
||||
ReadFileResult (..),
|
||||
chatWriteFile,
|
||||
chatReadFile,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad.Except
|
||||
import Data.Aeson (ToJSON)
|
||||
import qualified Data.Aeson as J
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Lazy as LB
|
||||
import qualified Data.ByteString.Lazy.Char8 as LB'
|
||||
import Data.Int (Int64)
|
||||
import Data.Word (Word8)
|
||||
import Foreign.C
|
||||
import Foreign.Marshal.Alloc (mallocBytes)
|
||||
import Foreign.Ptr
|
||||
import GHC.Generics (Generic)
|
||||
import Simplex.Chat.Mobile.Shared
|
||||
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
|
||||
import qualified Simplex.Messaging.Crypto.File as CF
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
|
||||
|
||||
data WriteFileResult
|
||||
= WFResult {cryptoArgs :: CryptoFileArgs}
|
||||
| WFError {writeError :: String}
|
||||
deriving (Generic)
|
||||
|
||||
instance ToJSON WriteFileResult where toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "WF"
|
||||
|
||||
cChatWriteFile :: CString -> Ptr Word8 -> CInt -> IO CJSONString
|
||||
cChatWriteFile cPath ptr len = do
|
||||
path <- peekCAString cPath
|
||||
s <- getByteString ptr len
|
||||
r <- chatWriteFile path s
|
||||
newCAString $ LB'.unpack $ J.encode r
|
||||
|
||||
chatWriteFile :: FilePath -> ByteString -> IO WriteFileResult
|
||||
chatWriteFile path s = do
|
||||
cfArgs <- CF.randomArgs
|
||||
let file = CryptoFile path $ Just cfArgs
|
||||
either (WFError . show) (\_ -> WFResult cfArgs)
|
||||
<$> runExceptT (CF.writeFile file $ LB.fromStrict s)
|
||||
|
||||
data ReadFileResult
|
||||
= RFResult {fileSize :: Int64}
|
||||
| RFError {readError :: String}
|
||||
deriving (Generic)
|
||||
|
||||
instance ToJSON ReadFileResult where toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RF"
|
||||
|
||||
cChatReadFile :: CString -> CString -> CString -> IO (Ptr Word8)
|
||||
cChatReadFile cPath cKey cNonce = do
|
||||
path <- peekCAString cPath
|
||||
key <- B.packCString cKey
|
||||
nonce <- B.packCString cNonce
|
||||
(r, s) <- chatReadFile path key nonce
|
||||
let r' = LB.toStrict (J.encode r) <> "\NUL"
|
||||
ptr <- mallocBytes $ B.length r' + B.length s
|
||||
putByteString ptr r'
|
||||
unless (B.null s) $ putByteString (ptr `plusPtr` B.length r') s
|
||||
pure ptr
|
||||
|
||||
chatReadFile :: FilePath -> ByteString -> ByteString -> IO (ReadFileResult, ByteString)
|
||||
chatReadFile path keyStr nonceStr = do
|
||||
either ((,"") . RFError) (\s -> (RFResult $ LB.length s, LB.toStrict s)) <$> runExceptT readFile_
|
||||
where
|
||||
readFile_ :: ExceptT String IO LB.ByteString
|
||||
readFile_ = do
|
||||
key <- liftEither $ strDecode keyStr
|
||||
nonce <- liftEither $ strDecode nonceStr
|
||||
let file = CryptoFile path $ Just $ CFArgs key nonce
|
||||
withExceptT show $ CF.readFile file
|
||||
@@ -0,0 +1,19 @@
|
||||
module Simplex.Chat.Mobile.Shared where
|
||||
|
||||
import qualified Data.ByteString as B
|
||||
import Data.ByteString.Internal (ByteString (PS), memcpy)
|
||||
import Foreign.C (CInt, CString)
|
||||
import Foreign (Ptr, Word8, newForeignPtr_, plusPtr)
|
||||
import Foreign.ForeignPtr.Unsafe
|
||||
|
||||
type CJSONString = CString
|
||||
|
||||
getByteString :: Ptr Word8 -> CInt -> IO ByteString
|
||||
getByteString ptr len = do
|
||||
fp <- newForeignPtr_ ptr
|
||||
pure $ PS fp 0 $ fromIntegral len
|
||||
|
||||
putByteString :: Ptr Word8 -> ByteString -> IO ()
|
||||
putByteString ptr bs@(PS fp offset _) = do
|
||||
let p = unsafeForeignPtrToPtr fp `plusPtr` offset
|
||||
memcpy ptr p $ B.length bs
|
||||
@@ -12,16 +12,15 @@ import Control.Monad.Except
|
||||
import qualified Crypto.Cipher.Types as AES
|
||||
import Data.Bifunctor (bimap)
|
||||
import qualified Data.ByteArray as BA
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Base64.URL as U
|
||||
import Data.ByteString.Internal (ByteString (PS), memcpy)
|
||||
import Data.Either (fromLeft)
|
||||
import Data.Word (Word8)
|
||||
import Foreign.C (CInt, CString, newCAString)
|
||||
import Foreign.ForeignPtr (newForeignPtr_)
|
||||
import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
|
||||
import Foreign.Ptr (Ptr, plusPtr)
|
||||
import Foreign.Ptr (Ptr)
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Chat.Mobile.Shared
|
||||
|
||||
cChatEncryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString
|
||||
cChatEncryptMedia = cTransformMedia chatEncryptMedia
|
||||
@@ -32,16 +31,10 @@ cChatDecryptMedia = cTransformMedia chatDecryptMedia
|
||||
cTransformMedia :: (ByteString -> ByteString -> ExceptT String IO ByteString) -> CString -> Ptr Word8 -> CInt -> IO CString
|
||||
cTransformMedia f cKey cFrame cFrameLen = do
|
||||
key <- B.packCString cKey
|
||||
frame <- getFrame
|
||||
frame <- getByteString cFrame cFrameLen
|
||||
runExceptT (f key frame >>= liftIO . putFrame) >>= newCAString . fromLeft ""
|
||||
where
|
||||
getFrame = do
|
||||
fp <- newForeignPtr_ cFrame
|
||||
pure $ PS fp 0 $ fromIntegral cFrameLen
|
||||
putFrame bs@(PS fp offset _) = do
|
||||
let len = B.length bs
|
||||
p = unsafeForeignPtrToPtr fp `plusPtr` offset
|
||||
when (len <= fromIntegral cFrameLen) $ memcpy cFrame p len
|
||||
putFrame s = when (B.length s < fromIntegral cFrameLen) $ putByteString cFrame s
|
||||
{-# INLINE cTransformMedia #-}
|
||||
|
||||
chatEncryptMedia :: ByteString -> ByteString -> ExceptT String IO ByteString
|
||||
|
||||
@@ -56,6 +56,7 @@ module Simplex.Chat.Store.Files
|
||||
startRcvInlineFT,
|
||||
xftpAcceptRcvFT,
|
||||
setRcvFileToReceive,
|
||||
setFileCryptoArgs,
|
||||
getRcvFilesToReceive,
|
||||
setRcvFTAgentDeleted,
|
||||
updateRcvFileStatus,
|
||||
@@ -84,18 +85,21 @@ import Data.Time.Clock (UTCTime (..), getCurrentTime, nominalDay)
|
||||
import Data.Type.Equality
|
||||
import Database.SQLite.Simple (Only (..), (:.) (..))
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
import Simplex.Chat.Messages
|
||||
import Simplex.Chat.Messages.CIContent
|
||||
import Simplex.Chat.Protocol
|
||||
import Simplex.Chat.Store.Direct
|
||||
import Simplex.Chat.Store.Messages
|
||||
import Simplex.Chat.Store.Profiles
|
||||
import Simplex.Chat.Store.Shared
|
||||
import Simplex.Chat.Messages
|
||||
import Simplex.Chat.Messages.CIContent
|
||||
import Simplex.Chat.Protocol
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Util (week)
|
||||
import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, UserId)
|
||||
import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
|
||||
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
|
||||
import qualified Simplex.Messaging.Crypto.File as CF
|
||||
|
||||
getLiveSndFileTransfers :: DB.Connection -> User -> IO [SndFileTransfer]
|
||||
getLiveSndFileTransfers db User {userId} = do
|
||||
@@ -257,14 +261,14 @@ getSndFTViaMsgDelivery db User {userId} Connection {connId, agentConnId} agentMs
|
||||
(\n -> SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, groupMemberId, recipientDisplayName = n, connId, agentConnId})
|
||||
<$> (contactName_ <|> memberName_)
|
||||
|
||||
createSndFileTransferXFTP :: DB.Connection -> User -> ContactOrGroup -> FilePath -> FileInvitation -> AgentSndFileId -> Integer -> IO FileTransferMeta
|
||||
createSndFileTransferXFTP db User {userId} contactOrGroup filePath FileInvitation {fileName, fileSize} agentSndFileId chunkSize = do
|
||||
createSndFileTransferXFTP :: DB.Connection -> User -> ContactOrGroup -> CryptoFile -> FileInvitation -> AgentSndFileId -> Integer -> IO FileTransferMeta
|
||||
createSndFileTransferXFTP db User {userId} contactOrGroup (CryptoFile filePath cryptoArgs) FileInvitation {fileName, fileSize} agentSndFileId chunkSize = do
|
||||
currentTs <- getCurrentTime
|
||||
let xftpSndFile = Just XFTPSndFile {agentSndFileId, privateSndFileDescr = Nothing, agentSndFileDeleted = False}
|
||||
let xftpSndFile = Just XFTPSndFile {agentSndFileId, privateSndFileDescr = Nothing, agentSndFileDeleted = False, cryptoArgs}
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO files (contact_id, group_id, user_id, file_name, file_path, file_size, chunk_size, agent_snd_file_id, ci_file_status, protocol, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)"
|
||||
(contactAndGroupIds contactOrGroup :. (userId, fileName, filePath, fileSize, chunkSize, agentSndFileId, CIFSSndStored, FPXFTP, currentTs, currentTs))
|
||||
"INSERT INTO files (contact_id, group_id, user_id, file_name, file_path, file_crypto_key, file_crypto_nonce, file_size, chunk_size, agent_snd_file_id, ci_file_status, protocol, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
|
||||
(contactAndGroupIds contactOrGroup :. (userId, fileName, filePath, CF.fileKey <$> cryptoArgs, CF.fileNonce <$> cryptoArgs, fileSize, chunkSize, agentSndFileId, CIFSSndStored, FPXFTP, currentTs, currentTs))
|
||||
fileId <- insertedRowId db
|
||||
pure FileTransferMeta {fileId, xftpSndFile, fileName, filePath, fileSize, fileInline = Nothing, chunkSize, cancelled = False}
|
||||
|
||||
@@ -479,7 +483,8 @@ createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@File
|
||||
currentTs <- liftIO getCurrentTime
|
||||
rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr
|
||||
let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd_
|
||||
xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_
|
||||
-- cryptoArgs = Nothing here, the decision to encrypt is made when receiving it
|
||||
xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False, cryptoArgs = Nothing}) <$> rfd_
|
||||
fileProtocol = if isJust rfd_ then FPXFTP else FPSMP
|
||||
fileId <- liftIO $ do
|
||||
DB.execute
|
||||
@@ -499,7 +504,8 @@ createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localD
|
||||
currentTs <- liftIO getCurrentTime
|
||||
rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr
|
||||
let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd_
|
||||
xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_
|
||||
-- cryptoArgs = Nothing here, the decision to encrypt is made when receiving it
|
||||
xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False, cryptoArgs = Nothing}) <$> rfd_
|
||||
fileProtocol = if isJust rfd_ then FPXFTP else FPSMP
|
||||
fileId <- liftIO $ do
|
||||
DB.execute
|
||||
@@ -600,7 +606,7 @@ getRcvFileTransfer db User {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, 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, 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
|
||||
@@ -614,9 +620,9 @@ getRcvFileTransfer db User {userId} fileId = do
|
||||
where
|
||||
rcvFileTransfer ::
|
||||
Maybe RcvFileDescr ->
|
||||
(FileStatus, Maybe ConnReqInvitation, Maybe Int64, String, Integer, Integer, Maybe Bool) :. (Maybe ContactName, Maybe ContactName, Maybe FilePath, 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) :. (Maybe Int64, Maybe AgentConnId) ->
|
||||
ExceptT StoreError IO RcvFileTransfer
|
||||
rcvFileTransfer rfd_ ((fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_) :. (contactName_, memberName_, filePath_, fileInline, rcvFileInline, agentRcvFileId, agentRcvFileDeleted) :. (connId_, agentConnId_)) =
|
||||
rcvFileTransfer rfd_ ((fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_) :. (contactName_, memberName_, filePath_, fileKey, fileNonce, fileInline, rcvFileInline, agentRcvFileId, agentRcvFileDeleted) :. (connId_, agentConnId_)) =
|
||||
case contactName_ <|> memberName_ of
|
||||
Nothing -> throwError $ SERcvFileInvalid fileId
|
||||
Just name -> do
|
||||
@@ -629,7 +635,8 @@ getRcvFileTransfer db User {userId} fileId = do
|
||||
where
|
||||
ft senderDisplayName fileStatus =
|
||||
let fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing}
|
||||
xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId, agentRcvFileDeleted}) <$> rfd_
|
||||
cryptoArgs = CFArgs <$> fileKey <*> fileNonce
|
||||
xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId, agentRcvFileDeleted, cryptoArgs}) <$> rfd_
|
||||
in RcvFileTransfer {fileId, xftpRcvFile, fileInvitation, fileStatus, rcvFileInline, senderDisplayName, chunkSize, cancelled, grpMemberId}
|
||||
rfi = maybe (throwError $ SERcvFileInvalid fileId) pure =<< rfi_
|
||||
rfi_ = case (filePath_, connId_, agentConnId_) of
|
||||
@@ -683,13 +690,21 @@ acceptRcvFT_ db User {userId} fileId filePath rcvFileInline currentTs = do
|
||||
"UPDATE rcv_files SET rcv_file_inline = ?, file_status = ?, updated_at = ? WHERE file_id = ?"
|
||||
(rcvFileInline, FSAccepted, currentTs, fileId)
|
||||
|
||||
setRcvFileToReceive :: DB.Connection -> FileTransferId -> IO ()
|
||||
setRcvFileToReceive db fileId = do
|
||||
setRcvFileToReceive :: DB.Connection -> FileTransferId -> Maybe CryptoFileArgs -> IO ()
|
||||
setRcvFileToReceive db fileId cfArgs_ = do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute db "UPDATE rcv_files SET to_receive = 1, updated_at = ? WHERE file_id = ?" (currentTs, fileId)
|
||||
forM_ cfArgs_ $ \cfArgs -> setFileCryptoArgs_ db fileId cfArgs currentTs
|
||||
|
||||
setFileCryptoArgs :: DB.Connection -> FileTransferId -> CryptoFileArgs -> IO ()
|
||||
setFileCryptoArgs db fileId cfArgs = setFileCryptoArgs_ db fileId cfArgs =<< getCurrentTime
|
||||
|
||||
setFileCryptoArgs_ :: DB.Connection -> FileTransferId -> CryptoFileArgs -> UTCTime -> IO ()
|
||||
setFileCryptoArgs_ db fileId (CFArgs key nonce) currentTs =
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE rcv_files SET to_receive = 1, updated_at = ? WHERE file_id = ?"
|
||||
(currentTs, fileId)
|
||||
"UPDATE files SET file_crypto_key = ?, file_crypto_nonce = ?, updated_at = ? WHERE file_id = ?"
|
||||
(key, nonce, currentTs, fileId)
|
||||
|
||||
getRcvFilesToReceive :: DB.Connection -> User -> IO [RcvFileTransfer]
|
||||
getRcvFilesToReceive db user@User {userId} = do
|
||||
@@ -842,15 +857,16 @@ getFileTransferMeta db User {userId} fileId =
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT file_name, file_size, chunk_size, file_path, file_inline, agent_snd_file_id, agent_snd_file_deleted, private_snd_file_descr, cancelled
|
||||
SELECT file_name, file_size, chunk_size, file_path, file_crypto_key, file_crypto_nonce, file_inline, agent_snd_file_id, agent_snd_file_deleted, private_snd_file_descr, cancelled
|
||||
FROM files
|
||||
WHERE user_id = ? AND file_id = ?
|
||||
|]
|
||||
(userId, fileId)
|
||||
where
|
||||
fileTransferMeta :: (String, Integer, Integer, FilePath, Maybe InlineFileMode, Maybe AgentSndFileId, Bool, Maybe Text, Maybe Bool) -> FileTransferMeta
|
||||
fileTransferMeta (fileName, fileSize, chunkSize, filePath, fileInline, aSndFileId_, agentSndFileDeleted, privateSndFileDescr, cancelled_) =
|
||||
let xftpSndFile = (\fId -> XFTPSndFile {agentSndFileId = fId, privateSndFileDescr, agentSndFileDeleted}) <$> aSndFileId_
|
||||
fileTransferMeta :: (String, Integer, Integer, FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe InlineFileMode, Maybe AgentSndFileId, Bool, Maybe Text, Maybe Bool) -> FileTransferMeta
|
||||
fileTransferMeta (fileName, fileSize, chunkSize, filePath, fileKey, fileNonce, fileInline, aSndFileId_, agentSndFileDeleted, privateSndFileDescr, cancelled_) =
|
||||
let cryptoArgs = CFArgs <$> fileKey <*> fileNonce
|
||||
xftpSndFile = (\fId -> XFTPSndFile {agentSndFileId = fId, privateSndFileDescr, agentSndFileDeleted, cryptoArgs}) <$> aSndFileId_
|
||||
in FileTransferMeta {fileId, xftpSndFile, fileName, fileSize, chunkSize, filePath, fileInline, cancelled = fromMaybe False cancelled_}
|
||||
|
||||
getContactFileInfo :: DB.Connection -> User -> Contact -> IO [CIFileInfo]
|
||||
|
||||
@@ -13,7 +13,6 @@
|
||||
module Simplex.Chat.Store.Messages
|
||||
( getContactConnIds_,
|
||||
getDirectChatReactions_,
|
||||
toDirectChatItem,
|
||||
|
||||
-- * Message and chat item functions
|
||||
deleteContactCIs,
|
||||
@@ -122,6 +121,8 @@ import Simplex.Chat.Types
|
||||
import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, MsgMeta (..), UserId)
|
||||
import Simplex.Messaging.Agent.Store.SQLite (firstRow, firstRow', maybeFirstRow)
|
||||
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
|
||||
import Simplex.Messaging.Util (eitherToMaybe)
|
||||
import UnliftIO.STM
|
||||
|
||||
@@ -483,7 +484,7 @@ getDirectChatPreviews_ db user@User {userId} = do
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, f.protocol,
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
|
||||
-- DirectQuote
|
||||
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent
|
||||
FROM contacts ct
|
||||
@@ -548,7 +549,7 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, f.protocol,
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
|
||||
-- Maybe GroupMember - sender
|
||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
|
||||
m.member_status, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
|
||||
@@ -669,7 +670,7 @@ getDirectChatItemsLast db User {userId} contactId count search = ExceptT $ do
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, f.protocol,
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
|
||||
-- DirectQuote
|
||||
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent
|
||||
FROM chat_items i
|
||||
@@ -698,7 +699,7 @@ getDirectChatAfter_ db User {userId} ct@Contact {contactId} afterChatItemId coun
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, f.protocol,
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
|
||||
-- DirectQuote
|
||||
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent
|
||||
FROM chat_items i
|
||||
@@ -728,7 +729,7 @@ getDirectChatBefore_ db User {userId} ct@Contact {contactId} beforeChatItemId co
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, f.protocol,
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
|
||||
-- DirectQuote
|
||||
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent
|
||||
FROM chat_items i
|
||||
@@ -950,7 +951,7 @@ type ChatStatsRow = (Int, ChatItemId, Bool)
|
||||
toChatStats :: ChatStatsRow -> ChatStats
|
||||
toChatStats (unreadCount, minUnreadItemId, unreadChat) = ChatStats {unreadCount, minUnreadItemId, unreadChat}
|
||||
|
||||
type MaybeCIFIleRow = (Maybe Int64, Maybe String, Maybe Integer, Maybe FilePath, Maybe ACIFileStatus, Maybe FileProtocol)
|
||||
type MaybeCIFIleRow = (Maybe Int64, Maybe String, Maybe Integer, Maybe FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe ACIFileStatus, Maybe FileProtocol)
|
||||
|
||||
type ChatItemModeRow = (Maybe Int, Maybe UTCTime, Maybe Bool)
|
||||
|
||||
@@ -971,7 +972,7 @@ toQuote (quotedItemId, quotedSharedMsgId, quotedSentAt, quotedMsgContent, _) dir
|
||||
|
||||
-- this function can be changed so it never fails, not only avoid failure on invalid json
|
||||
toDirectChatItem :: UTCTime -> ChatItemRow :. QuoteRow -> Either StoreError (CChatItem 'CTDirect)
|
||||
toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_, fileProtocol_)) :. quoteRow) =
|
||||
toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. quoteRow) =
|
||||
chatItem $ fromRight invalid $ dbParseACIContent itemContentText
|
||||
where
|
||||
invalid = ACIContent msgDir $ CIInvalidJSON itemContentText
|
||||
@@ -988,7 +989,10 @@ toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentT
|
||||
maybeCIFile :: CIFileStatus d -> Maybe (CIFile d)
|
||||
maybeCIFile fileStatus =
|
||||
case (fileId_, fileName_, fileSize_, fileProtocol_) of
|
||||
(Just fileId, Just fileName, Just fileSize, Just fileProtocol) -> Just CIFile {fileId, fileName, fileSize, filePath, fileStatus, fileProtocol}
|
||||
(Just fileId, Just fileName, Just fileSize, Just fileProtocol) ->
|
||||
let cfArgs = CFArgs <$> fileKey <*> fileNonce
|
||||
fileSource = (`CryptoFile` cfArgs) <$> filePath
|
||||
in Just CIFile {fileId, fileName, fileSize, fileSource, fileStatus, fileProtocol}
|
||||
_ -> Nothing
|
||||
cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTDirect d -> CIStatus d -> CIContent d -> Maybe (CIFile d) -> CChatItem 'CTDirect
|
||||
cItem d chatDir ciStatus content file =
|
||||
@@ -1021,7 +1025,7 @@ toGroupQuote qr@(_, _, _, _, quotedSent) quotedMember_ = toQuote qr $ direction
|
||||
|
||||
-- this function can be changed so it never fails, not only avoid failure on invalid json
|
||||
toGroupChatItem :: UTCTime -> Int64 -> ChatItemRow :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow -> Either StoreError (CChatItem 'CTGroup)
|
||||
toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_, fileProtocol_)) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do
|
||||
toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do
|
||||
chatItem $ fromRight invalid $ dbParseACIContent itemContentText
|
||||
where
|
||||
member_ = toMaybeGroupMember userContactId memberRow_
|
||||
@@ -1041,7 +1045,10 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir,
|
||||
maybeCIFile :: CIFileStatus d -> Maybe (CIFile d)
|
||||
maybeCIFile fileStatus =
|
||||
case (fileId_, fileName_, fileSize_, fileProtocol_) of
|
||||
(Just fileId, Just fileName, Just fileSize, Just fileProtocol) -> Just CIFile {fileId, fileName, fileSize, filePath, fileStatus, fileProtocol}
|
||||
(Just fileId, Just fileName, Just fileSize, Just fileProtocol) ->
|
||||
let cfArgs = CFArgs <$> fileKey <*> fileNonce
|
||||
fileSource = (`CryptoFile` cfArgs) <$> filePath
|
||||
in Just CIFile {fileId, fileName, fileSize, fileSource, fileStatus, fileProtocol}
|
||||
_ -> Nothing
|
||||
cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTGroup d -> CIStatus d -> CIContent d -> Maybe (CIFile d) -> CChatItem 'CTGroup
|
||||
cItem d chatDir ciStatus content file =
|
||||
@@ -1141,7 +1148,7 @@ updateDirectChatItemStatus db user@User {userId} contactId itemId itemStatus = d
|
||||
correctDir :: CChatItem c -> Either StoreError (ChatItem c d)
|
||||
correctDir (CChatItem _ ci) = first SEInternalError $ checkDirection ci
|
||||
|
||||
updateDirectChatItem :: forall d. (MsgDirectionI d) => DB.Connection -> User -> Int64 -> ChatItemId -> CIContent d -> Bool -> Maybe MessageId -> ExceptT StoreError IO (ChatItem 'CTDirect d)
|
||||
updateDirectChatItem :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItemId -> CIContent d -> Bool -> Maybe MessageId -> ExceptT StoreError IO (ChatItem 'CTDirect d)
|
||||
updateDirectChatItem db user contactId itemId newContent live msgId_ = do
|
||||
ci <- liftEither . correctDir =<< getDirectChatItem db user contactId itemId
|
||||
liftIO $ updateDirectChatItem' db user contactId ci newContent live msgId_
|
||||
@@ -1149,7 +1156,7 @@ updateDirectChatItem db user contactId itemId newContent live msgId_ = do
|
||||
correctDir :: CChatItem c -> Either StoreError (ChatItem c d)
|
||||
correctDir (CChatItem _ ci) = first SEInternalError $ checkDirection ci
|
||||
|
||||
updateDirectChatItem' :: forall d. (MsgDirectionI d) => DB.Connection -> User -> Int64 -> ChatItem 'CTDirect d -> CIContent d -> Bool -> Maybe MessageId -> IO (ChatItem 'CTDirect d)
|
||||
updateDirectChatItem' :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItem 'CTDirect d -> CIContent d -> Bool -> Maybe MessageId -> IO (ChatItem 'CTDirect d)
|
||||
updateDirectChatItem' db User {userId} contactId ci newContent live msgId_ = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
let ci' = updatedChatItem ci newContent live currentTs
|
||||
@@ -1294,7 +1301,7 @@ getDirectChatItem db User {userId} contactId itemId = ExceptT $ do
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, f.protocol,
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
|
||||
-- DirectQuote
|
||||
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent
|
||||
FROM chat_items i
|
||||
@@ -1469,7 +1476,7 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, f.protocol,
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
|
||||
-- GroupMember
|
||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
|
||||
m.member_status, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
|
||||
|
||||
@@ -76,6 +76,7 @@ import Simplex.Chat.Migrations.M20230621_chat_item_moderations
|
||||
import Simplex.Chat.Migrations.M20230705_delivery_receipts
|
||||
import Simplex.Chat.Migrations.M20230721_group_snd_item_statuses
|
||||
import Simplex.Chat.Migrations.M20230814_indexes
|
||||
import Simplex.Chat.Migrations.M20230827_file_encryption
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
@@ -151,7 +152,8 @@ schemaMigrations =
|
||||
("20230621_chat_item_moderations", m20230621_chat_item_moderations, Just down_m20230621_chat_item_moderations),
|
||||
("20230705_delivery_receipts", m20230705_delivery_receipts, Just down_m20230705_delivery_receipts),
|
||||
("20230721_group_snd_item_statuses", m20230721_group_snd_item_statuses, Just down_m20230721_group_snd_item_statuses),
|
||||
("20230814_indexes", m20230814_indexes, Just down_m20230814_indexes)
|
||||
("20230814_indexes", m20230814_indexes, Just down_m20230814_indexes),
|
||||
("20230827_file_encryption", m20230827_file_encryption, Just down_m20230827_file_encryption)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
@@ -42,6 +42,7 @@ import Simplex.Chat.Types.Preferences
|
||||
import Simplex.Chat.Types.Util
|
||||
import Simplex.FileTransfer.Description (FileDigest)
|
||||
import Simplex.Messaging.Agent.Protocol (ACommandTag (..), ACorrId, AParty (..), APartyCmdTag (..), ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId, SAEntity (..), UserId)
|
||||
import Simplex.Messaging.Crypto.File (CryptoFileArgs (..))
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (dropPrefix, fromTextField_, sumTypeJSON, taggedObjectJSON)
|
||||
import Simplex.Messaging.Protocol (ProtoServerWithAuth, ProtocolTypeI)
|
||||
@@ -345,11 +346,12 @@ data ChatSettings = ChatSettings
|
||||
instance ToJSON ChatSettings where toEncoding = J.genericToEncoding J.defaultOptions
|
||||
|
||||
defaultChatSettings :: ChatSettings
|
||||
defaultChatSettings = ChatSettings
|
||||
{ enableNtfs = True,
|
||||
sendRcpts = Nothing,
|
||||
favorite = False
|
||||
}
|
||||
defaultChatSettings =
|
||||
ChatSettings
|
||||
{ enableNtfs = True,
|
||||
sendRcpts = Nothing,
|
||||
favorite = False
|
||||
}
|
||||
|
||||
pattern DisableNtfs :: ChatSettings
|
||||
pattern DisableNtfs <- ChatSettings {enableNtfs = False}
|
||||
@@ -953,7 +955,8 @@ instance ToJSON RcvFileTransfer where toEncoding = J.genericToEncoding J.default
|
||||
data XFTPRcvFile = XFTPRcvFile
|
||||
{ rcvFileDescription :: RcvFileDescr,
|
||||
agentRcvFileId :: Maybe AgentRcvFileId,
|
||||
agentRcvFileDeleted :: Bool
|
||||
agentRcvFileDeleted :: Bool,
|
||||
cryptoArgs :: Maybe CryptoFileArgs
|
||||
}
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
@@ -1108,7 +1111,8 @@ instance ToJSON FileTransferMeta where toEncoding = J.genericToEncoding J.defaul
|
||||
data XFTPSndFile = XFTPSndFile
|
||||
{ agentSndFileId :: AgentSndFileId,
|
||||
privateSndFileDescr :: Maybe Text,
|
||||
agentSndFileDeleted :: Bool
|
||||
agentSndFileDeleted :: Bool,
|
||||
cryptoArgs :: Maybe CryptoFileArgs
|
||||
}
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
|
||||
+25
-17
@@ -50,6 +50,7 @@ import Simplex.Messaging.Agent.Env.SQLite (NetworkConfig (..))
|
||||
import Simplex.Messaging.Agent.Protocol
|
||||
import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..))
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
|
||||
import Simplex.Messaging.Encoding
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (dropPrefix, taggedObjectJSON)
|
||||
@@ -160,7 +161,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
|
||||
CRRcvFileDescrReady _ _ -> []
|
||||
CRRcvFileDescrNotReady _ _ -> []
|
||||
CRRcvFileProgressXFTP {} -> []
|
||||
CRRcvFileAccepted u ci -> ttyUser u $ savingFile' ci
|
||||
CRRcvFileAccepted u ci -> ttyUser u $ savingFile' testView ci
|
||||
CRRcvFileAcceptedSndCancelled u ft -> ttyUser u $ viewRcvFileSndCancelled ft
|
||||
CRSndFileCancelled u _ ftm fts -> ttyUser u $ viewSndFileCancelled ftm fts
|
||||
CRRcvFileCancelled u _ ft -> ttyUser u $ receivingFile_ "cancelled" ft
|
||||
@@ -251,7 +252,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
|
||||
CRSQLResult rows -> map plain rows
|
||||
CRSlowSQLQueries {chatQueries, agentQueries} ->
|
||||
let viewQuery SlowSQLQuery {query, queryStats = SlowQueryStats {count, timeMax, timeAvg}} =
|
||||
"count: " <> sShow count
|
||||
("count: " <> sShow count)
|
||||
<> (" :: max: " <> sShow timeMax <> " ms")
|
||||
<> (" :: avg: " <> sShow timeAvg <> " ms")
|
||||
<> (" :: " <> plain (T.unwords $ T.lines query))
|
||||
@@ -274,7 +275,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
|
||||
<> ("pending subscriptions: " : map sShow pendingSubscriptions)
|
||||
CRConnectionDisabled entity -> viewConnectionEntityDisabled entity
|
||||
CRAgentRcvQueueDeleted acId srv aqId err_ ->
|
||||
[ "completed deleting rcv queue, agent connection id: " <> sShow acId
|
||||
[ ("completed deleting rcv queue, agent connection id: " <> sShow acId)
|
||||
<> (", server: " <> sShow srv)
|
||||
<> (", agent queue id: " <> sShow aqId)
|
||||
<> maybe "" (\e -> ", error: " <> sShow e) err_
|
||||
@@ -327,7 +328,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
|
||||
Just CIQuote {chatDir = quoteDir, content} ->
|
||||
Just (msgDirectionInt $ quoteMsgDirection quoteDir, msgContentText content)
|
||||
fPath = case file of
|
||||
Just CIFile {filePath = Just fp} -> Just fp
|
||||
Just CIFile {fileSource = Just (CryptoFile fp _)} -> Just fp
|
||||
_ -> Nothing
|
||||
testViewItem :: CChatItem c -> Maybe GroupMember -> Text
|
||||
testViewItem (CChatItem _ ci@ChatItem {meta = CIMeta {itemText}}) membership_ =
|
||||
@@ -950,7 +951,8 @@ viewNetworkConfig NetworkConfig {socksProxy, tcpTimeout} =
|
||||
|
||||
viewContactInfo :: Contact -> ConnectionStats -> Maybe Profile -> [StyledString]
|
||||
viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, contactLink}} stats incognitoProfile =
|
||||
["contact ID: " <> sShow contactId] <> viewConnectionStats stats
|
||||
["contact ID: " <> sShow contactId]
|
||||
<> viewConnectionStats stats
|
||||
<> maybe [] (\l -> ["contact address: " <> (plain . strEncode) l]) contactLink
|
||||
<> maybe
|
||||
["you've shared main profile with this contact"]
|
||||
@@ -1269,8 +1271,8 @@ viewSentBroadcast mc s f ts tz time = prependFirst (highlight' "/feed" <> " (" <
|
||||
| otherwise = ""
|
||||
|
||||
viewSentFileInvitation :: StyledString -> CIFile d -> CurrentTime -> TimeZone -> CIMeta c d -> [StyledString]
|
||||
viewSentFileInvitation to CIFile {fileId, filePath, fileStatus} ts tz = case filePath of
|
||||
Just fPath -> sentWithTime_ ts tz $ ttySentFile fPath
|
||||
viewSentFileInvitation to CIFile {fileId, fileSource, fileStatus} ts tz = case fileSource of
|
||||
Just (CryptoFile fPath _) -> sentWithTime_ ts tz $ ttySentFile fPath
|
||||
_ -> const []
|
||||
where
|
||||
ttySentFile fPath = ["/f " <> to <> ttyFilePath fPath] <> cancelSending
|
||||
@@ -1338,14 +1340,20 @@ humanReadableSize size
|
||||
mB = kB * 1024
|
||||
gB = mB * 1024
|
||||
|
||||
savingFile' :: AChatItem -> [StyledString]
|
||||
savingFile' (AChatItem _ _ (DirectChat Contact {localDisplayName = c}) ChatItem {file = Just CIFile {fileId, filePath = Just filePath}, chatDir = CIDirectRcv}) =
|
||||
["saving file " <> sShow fileId <> " from " <> ttyContact c <> " to " <> plain filePath]
|
||||
savingFile' (AChatItem _ _ _ ChatItem {file = Just CIFile {fileId, filePath = Just filePath}, chatDir = CIGroupRcv GroupMember {localDisplayName = m}}) =
|
||||
["saving file " <> sShow fileId <> " from " <> ttyContact m <> " to " <> plain filePath]
|
||||
savingFile' (AChatItem _ _ _ ChatItem {file = Just CIFile {fileId, filePath = Just filePath}}) =
|
||||
["saving file " <> sShow fileId <> " to " <> plain filePath]
|
||||
savingFile' _ = ["saving file"] -- shouldn't happen
|
||||
savingFile' :: Bool -> AChatItem -> [StyledString]
|
||||
savingFile' testView (AChatItem _ _ chat ChatItem {file = Just CIFile {fileId, fileSource = Just (CryptoFile filePath cfArgs_)}, chatDir}) =
|
||||
let from = case (chat, chatDir) of
|
||||
(DirectChat Contact {localDisplayName = c}, CIDirectRcv) -> " from " <> ttyContact c
|
||||
(_, CIGroupRcv GroupMember {localDisplayName = m}) -> " from " <> ttyContact m
|
||||
_ -> ""
|
||||
in ["saving file " <> sShow fileId <> from <> " to " <> plain filePath] <> cfArgsStr
|
||||
where
|
||||
cfArgsStr = case cfArgs_ of
|
||||
Just cfArgs@(CFArgs key nonce)
|
||||
| testView -> [plain $ LB.unpack $ J.encode cfArgs]
|
||||
| otherwise -> [plain $ "encryption key: " <> strEncode key <> ", nonce: " <> strEncode nonce]
|
||||
_ -> []
|
||||
savingFile' _ _ = ["saving file"] -- shouldn't happen
|
||||
|
||||
receivingFile_' :: StyledString -> AChatItem -> [StyledString]
|
||||
receivingFile_' status (AChatItem _ _ (DirectChat Contact {localDisplayName = c}) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIDirectRcv}) =
|
||||
@@ -1397,7 +1405,7 @@ viewFileTransferStatus (FTRcv ft@RcvFileTransfer {fileId, fileInvitation = FileI
|
||||
RFSCancelled Nothing -> "cancelled"
|
||||
|
||||
viewFileTransferStatusXFTP :: AChatItem -> [StyledString]
|
||||
viewFileTransferStatusXFTP (AChatItem _ _ _ ChatItem {file = Just CIFile {fileId, fileName, fileSize, fileStatus, filePath}}) =
|
||||
viewFileTransferStatusXFTP (AChatItem _ _ _ ChatItem {file = Just CIFile {fileId, fileName, fileSize, fileStatus, fileSource}}) =
|
||||
case fileStatus of
|
||||
CIFSSndStored -> ["sending " <> fstr <> " just started"]
|
||||
CIFSSndTransfer progress total -> ["sending " <> fstr <> " in progress " <> fileProgressXFTP progress total fileSize]
|
||||
@@ -1407,7 +1415,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]
|
||||
CIFSRcvComplete -> ["receiving " <> fstr <> " complete" <> maybe "" (\fp -> ", path: " <> plain fp) filePath]
|
||||
CIFSRcvComplete -> ["receiving " <> fstr <> " complete" <> maybe "" (\(CryptoFile fp _) -> ", path: " <> plain fp) fileSource]
|
||||
CIFSRcvCancelled -> ["receiving " <> fstr <> " cancelled"]
|
||||
CIFSRcvError -> ["receiving " <> fstr <> " error"]
|
||||
CIFSInvalid text -> [fstr <> " invalid status: " <> plain text]
|
||||
|
||||
Reference in New Issue
Block a user