From daceaac86fcd889ab4083865ef912ae23f61e389 Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Wed, 8 Jul 2026 16:43:13 +0400 Subject: [PATCH] sign file hash --- simplex-chat.cabal | 2 + src/Simplex/Chat/Library/Commands.hs | 6 +- src/Simplex/Chat/Library/Internal.hs | 5 ++ src/Simplex/Chat/Library/Subscriber.hs | 28 ++++++-- src/Simplex/Chat/Store/Files.hs | 15 +++-- src/Simplex/Chat/Store/Postgres/Migrations.hs | 4 +- .../Migrations/M20260707_file_digest.hs | 19 ++++++ src/Simplex/Chat/Store/SQLite/Migrations.hs | 4 +- .../Migrations/M20260707_file_digest.hs | 18 ++++++ .../Store/SQLite/Migrations/chat_schema.sql | 3 +- tests/ChatTests/Groups.hs | 64 +++++++++++++++++++ 11 files changed, 150 insertions(+), 18 deletions(-) create mode 100644 src/Simplex/Chat/Store/Postgres/Migrations/M20260707_file_digest.hs create mode 100644 src/Simplex/Chat/Store/SQLite/Migrations/M20260707_file_digest.hs diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 6403dd19b2..54462f941a 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -147,6 +147,7 @@ library Simplex.Chat.Store.Postgres.Migrations.M20260602_group_roster Simplex.Chat.Store.Postgres.Migrations.M20260603_simplex_name Simplex.Chat.Store.Postgres.Migrations.M20260629_roster_catchup + Simplex.Chat.Store.Postgres.Migrations.M20260707_file_digest else exposed-modules: Simplex.Chat.Archive @@ -311,6 +312,7 @@ library Simplex.Chat.Store.SQLite.Migrations.M20260602_group_roster Simplex.Chat.Store.SQLite.Migrations.M20260603_simplex_name Simplex.Chat.Store.SQLite.Migrations.M20260629_roster_catchup + Simplex.Chat.Store.SQLite.Migrations.M20260707_file_digest other-modules: Paths_simplex_chat hs-source-dirs: diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index fcd8ff5a71..1328e9d6f1 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -4654,7 +4654,11 @@ processChatCommand cxt nm = \case let User {profile = LocalProfile {localBadge}} = user fileSize <- checkSndFile (if incognitoMembership gInfo then Nothing else localBadge) file (fInv, ciFile) <- xftpSndFileTransfer user file fileSize n $ CGGroup gInfo recipients - pure (Just fInv, Just ciFile) + fInv' <- + if sign && useRelays' gInfo + then (\d -> (fInv :: FileInvitation) {fileDigest = Just d}) <$> cryptoFileDigest file + else pure fInv + pure (Just fInv', Just ciFile) Nothing -> pure (Nothing, Nothing) prepareMsgs :: NonEmpty (ComposedMessageReq, Maybe FileInvitation) -> Maybe CITimed -> CM (NonEmpty (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup))) prepareMsgs cmsFileInvs timed_ = withFastStore $ \db -> diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index d106195fc2..e6787f818b 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -397,6 +397,11 @@ xftpSndFileTransfer_ user file@(CryptoFile filePath cfArgs) fileSize n contactOr ciFile = CIFile {fileId, fileName, fileSize, fileSource, fileStatus = CIFSSndStored, fileProtocol = FPXFTP} pure (fInv, ciFile, ft) +cryptoFileDigest :: CryptoFile -> CM FD.FileDigest +cryptoFileDigest file = do + r <- liftIO $ runExceptT $ CF.readFile file + either (throwChatError . CEInternalError . show) (pure . FD.FileDigest . LC.sha512Hash) r + xftpSndFileRedirect :: User -> FileTransferId -> ValidFileDescription 'FRecipient -> CM FileTransferMeta xftpSndFileRedirect user ftId vfd = do let fileName = "redirect.yaml" diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 20565ac880..3e6bc91abd 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -349,13 +349,27 @@ processAgentMsgRcvFile _corrId aFileId msg = do Just targetPath -> do fsTargetPath <- lift $ toFSFilePath targetPath renameFile xftpPath fsTargetPath - ci_ <- withStore $ \db -> do - liftIO $ do - updateRcvFileStatus db fileId FSComplete - updateCIFileStatus db user fileId CIFSRcvComplete - lookupChatItemByFileId db cxt user fileId - agentXFTPDeleteRcvFile aFileId fileId - toView $ maybe (CEvtRcvStandaloneFileComplete user fsTargetPath ft) (CEvtRcvFileComplete user) ci_ + ci_ <- withStore $ \db -> lookupChatItemByFileId db cxt user fileId + let signedDigest = case (ci_, ft) of + (Just (AChatItem _ _ _ ChatItem {meta = CIMeta {msgSigned = Just MSSVerified}}), RcvFileTransfer {fileInvitation = FileInvitation {fileDigest = Just d}, cryptoArgs = cfArgs}) -> Just (d, cfArgs) + _ -> Nothing + badDigest <- case signedDigest of + Just (expected, cfArgs) -> (/= expected) <$> cryptoFileDigest (CryptoFile fsTargetPath cfArgs) + Nothing -> pure False + if badDigest + then do + aci_ <- resetRcvCIFileStatus user fileId (CIFSRcvError $ FileErrOther "file signature") + forM_ aci_ cleanupACIFile + agentXFTPDeleteRcvFile aFileId fileId + forM_ aci_ $ \aci -> toView $ CEvtChatItemUpdated user aci + else do + ci_' <- withStore $ \db -> do + liftIO $ do + updateRcvFileStatus db fileId FSComplete + updateCIFileStatus db user fileId CIFSRcvComplete + lookupChatItemByFileId db cxt user fileId + agentXFTPDeleteRcvFile aFileId fileId + toView $ maybe (CEvtRcvStandaloneFileComplete user fsTargetPath ft) (CEvtRcvFileComplete user) ci_' RFWARN e -> do ci <- withStore $ \db -> do liftIO $ updateCIFileStatus db user fileId (CIFSRcvWarning $ agentFileError e) diff --git a/src/Simplex/Chat/Store/Files.hs b/src/Simplex/Chat/Store/Files.hs index dee72731a8..762583b7a5 100644 --- a/src/Simplex/Chat/Store/Files.hs +++ b/src/Simplex/Chat/Store/Files.hs @@ -96,6 +96,7 @@ import Simplex.Chat.Messages.CIContent import Simplex.Chat.Store.Messages import Simplex.Chat.Store.Profiles import Simplex.Chat.Store.Shared +import Simplex.FileTransfer.Description (FileDigest) import Simplex.Chat.Types import Simplex.Messaging.Agent.Protocol (AgentMsgId, UserId) import Simplex.Messaging.Agent.Store.AgentStore (firstRow, firstRow', maybeFirstRow) @@ -447,7 +448,7 @@ createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@File pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, fileType = FTNormal, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Nothing, cryptoArgs = Nothing} createRcvGroupFileTransfer :: DB.Connection -> UserId -> GroupInfo -> Maybe GroupMember -> FileType -> Maybe SharedMsgId -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer -createRcvGroupFileTransfer db userId GroupInfo {groupId, localDisplayName = gName} m_ fileType sharedMsgId_ f@FileInvitation {fileName, fileSize, fileConnReq, fileInline, fileDescr} rcvFileInline chunkSize = do +createRcvGroupFileTransfer db userId GroupInfo {groupId, localDisplayName = gName} m_ fileType sharedMsgId_ f@FileInvitation {fileName, fileSize, fileDigest, fileConnReq, fileInline, fileDescr} rcvFileInline chunkSize = do currentTs <- liftIO getCurrentTime rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr let rfdId = (\RcvFileDescr {fileDescrId} -> fileDescrId) <$> rfd_ @@ -459,8 +460,8 @@ createRcvGroupFileTransfer db userId GroupInfo {groupId, localDisplayName = gNam fileId <- liftIO $ do DB.execute db - "INSERT INTO files (user_id, group_id, file_name, file_size, chunk_size, file_inline, ci_file_status, protocol, file_type, shared_msg_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)" - (userId, groupId, fileName, fileSize, chunkSize, fileInline, CIFSRcvInvitation, fileProtocol, fileType, sharedMsgId_, currentTs, currentTs) + "INSERT INTO files (user_id, group_id, file_name, file_size, chunk_size, file_inline, ci_file_status, protocol, file_type, shared_msg_id, created_at, updated_at, file_digest) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)" + ((userId, groupId, fileName, fileSize, chunkSize, fileInline, CIFSRcvInvitation, fileProtocol, fileType, sharedMsgId_, currentTs, currentTs) :. Only fileDigest) insertedRowId db liftIO $ DB.execute @@ -632,7 +633,7 @@ getRcvFileTransfer_ db userId fileId = do 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, r.user_approved_relays, g.local_display_name, f.file_type + r.agent_rcv_file_id, r.agent_rcv_file_deleted, r.user_approved_relays, g.local_display_name, f.file_type, f.file_digest FROM rcv_files r JOIN files f USING (file_id) LEFT JOIN contacts cs ON cs.contact_id = f.contact_id @@ -646,9 +647,9 @@ getRcvFileTransfer_ db userId fileId = do where rcvFileTransfer :: Maybe RcvFileDescr -> - (FileStatus, Maybe ConnReqInvitation, Maybe Int64, String, Integer, Integer, Maybe BoolInt) :. (Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe InlineFileMode, Maybe InlineFileMode, Maybe AgentRcvFileId, BoolInt, BoolInt) :. (Maybe ContactName, FileType) -> + (FileStatus, Maybe ConnReqInvitation, Maybe Int64, String, Integer, Integer, Maybe BoolInt) :. (Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe InlineFileMode, Maybe InlineFileMode, Maybe AgentRcvFileId, BoolInt, BoolInt) :. (Maybe ContactName, FileType, Maybe FileDigest) -> ExceptT StoreError IO RcvFileTransfer - rcvFileTransfer rfd_ ((fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_) :. (contactName_, memberName_, filePath_, fileKey, fileNonce, fileInline, rcvFileInline, agentRcvFileId, BI agentRcvFileDeleted, BI userApprovedRelays) :. (groupName_, fileType)) = + rcvFileTransfer rfd_ ((fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_) :. (contactName_, memberName_, filePath_, fileKey, fileNonce, fileInline, rcvFileInline, agentRcvFileId, BI agentRcvFileDeleted, BI userApprovedRelays) :. (groupName_, fileType, fileDigest_)) = case contactName_ <|> memberName_ <|> groupName_ <|> standaloneName_ of Nothing -> throwError $ SERcvFileInvalid fileId Just name -> @@ -663,7 +664,7 @@ getRcvFileTransfer_ db userId fileId = do (Just _, Just _) -> Just "" -- filePath marks files that are accepted from contact or, in this case, set by createRcvDirectFileTransfer _ -> Nothing ft senderDisplayName fileStatus = - let fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing} + let fileInvitation = FileInvitation {fileName, fileSize, fileDigest = fileDigest_, fileConnReq, fileInline, fileDescr = Nothing} cryptoArgs = CFArgs <$> fileKey <*> fileNonce xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId, agentRcvFileDeleted, userApprovedRelays}) <$> rfd_ in RcvFileTransfer {fileId, xftpRcvFile, fileInvitation, fileStatus, fileType, rcvFileInline, senderDisplayName, chunkSize, cancelled, grpMemberId, cryptoArgs} diff --git a/src/Simplex/Chat/Store/Postgres/Migrations.hs b/src/Simplex/Chat/Store/Postgres/Migrations.hs index a3335640a2..2e62542c4e 100644 --- a/src/Simplex/Chat/Store/Postgres/Migrations.hs +++ b/src/Simplex/Chat/Store/Postgres/Migrations.hs @@ -40,6 +40,7 @@ import Simplex.Chat.Store.Postgres.Migrations.M20260601_relay_sent_web_domain import Simplex.Chat.Store.Postgres.Migrations.M20260602_group_roster import Simplex.Chat.Store.Postgres.Migrations.M20260603_simplex_name import Simplex.Chat.Store.Postgres.Migrations.M20260629_roster_catchup +import Simplex.Chat.Store.Postgres.Migrations.M20260707_file_digest import Simplex.Messaging.Agent.Store.Shared (Migration (..)) schemaMigrations :: [(String, Text, Maybe Text)] @@ -79,7 +80,8 @@ schemaMigrations = ("20260601_relay_sent_web_domain", m20260601_relay_sent_web_domain, Just down_m20260601_relay_sent_web_domain), ("20260602_group_roster", m20260602_group_roster, Just down_m20260602_group_roster), ("20260603_simplex_name", m20260603_simplex_name, Just down_m20260603_simplex_name), - ("20260629_roster_catchup", m20260629_roster_catchup, Just down_m20260629_roster_catchup) + ("20260629_roster_catchup", m20260629_roster_catchup, Just down_m20260629_roster_catchup), + ("20260707_file_digest", m20260707_file_digest, Just down_m20260707_file_digest) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/Postgres/Migrations/M20260707_file_digest.hs b/src/Simplex/Chat/Store/Postgres/Migrations/M20260707_file_digest.hs new file mode 100644 index 0000000000..56e4f00db7 --- /dev/null +++ b/src/Simplex/Chat/Store/Postgres/Migrations/M20260707_file_digest.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Store.Postgres.Migrations.M20260707_file_digest where + +import Data.Text (Text) +import Text.RawString.QQ (r) + +m20260707_file_digest :: Text +m20260707_file_digest = + [r| +ALTER TABLE files ADD COLUMN file_digest BYTEA; +|] + +down_m20260707_file_digest :: Text +down_m20260707_file_digest = + [r| +ALTER TABLE files DROP COLUMN file_digest; +|] diff --git a/src/Simplex/Chat/Store/SQLite/Migrations.hs b/src/Simplex/Chat/Store/SQLite/Migrations.hs index d135c0f742..c6ae71a58d 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations.hs +++ b/src/Simplex/Chat/Store/SQLite/Migrations.hs @@ -163,6 +163,7 @@ import Simplex.Chat.Store.SQLite.Migrations.M20260601_relay_sent_web_domain import Simplex.Chat.Store.SQLite.Migrations.M20260602_group_roster import Simplex.Chat.Store.SQLite.Migrations.M20260603_simplex_name import Simplex.Chat.Store.SQLite.Migrations.M20260629_roster_catchup +import Simplex.Chat.Store.SQLite.Migrations.M20260707_file_digest import Simplex.Messaging.Agent.Store.Shared (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -325,7 +326,8 @@ schemaMigrations = ("20260601_relay_sent_web_domain", m20260601_relay_sent_web_domain, Just down_m20260601_relay_sent_web_domain), ("20260602_group_roster", m20260602_group_roster, Just down_m20260602_group_roster), ("20260603_simplex_name", m20260603_simplex_name, Just down_m20260603_simplex_name), - ("20260629_roster_catchup", m20260629_roster_catchup, Just down_m20260629_roster_catchup) + ("20260629_roster_catchup", m20260629_roster_catchup, Just down_m20260629_roster_catchup), + ("20260707_file_digest", m20260707_file_digest, Just down_m20260707_file_digest) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/M20260707_file_digest.hs b/src/Simplex/Chat/Store/SQLite/Migrations/M20260707_file_digest.hs new file mode 100644 index 0000000000..086932aa46 --- /dev/null +++ b/src/Simplex/Chat/Store/SQLite/Migrations/M20260707_file_digest.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Store.SQLite.Migrations.M20260707_file_digest where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20260707_file_digest :: Query +m20260707_file_digest = + [sql| +ALTER TABLE files ADD COLUMN file_digest BLOB; +|] + +down_m20260707_file_digest :: Query +down_m20260707_file_digest = + [sql| +ALTER TABLE files DROP COLUMN file_digest; +|] diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql b/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql index 01d53ad000..676dd7e312 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql @@ -296,7 +296,8 @@ CREATE TABLE files( redirect_file_id INTEGER REFERENCES files ON DELETE CASCADE, shared_msg_id BLOB, file_type TEXT NOT NULL DEFAULT 'normal', - roster_transfer_id INTEGER + roster_transfer_id INTEGER, + file_digest BLOB ) STRICT; CREATE TABLE snd_files( file_id INTEGER NOT NULL REFERENCES files ON DELETE CASCADE, diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index a9b4c6388a..3517f0fcc3 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -339,6 +339,7 @@ chatGroupTests = do it "should sign self-delete of a signed item" testChannelMemberSelfDeleteSign it "should reject unsigned delete of a signed item" testChannelMemberDeleteEnforcement it "should always sign moderation delete" testChannelModerationDeleteSign + it "should verify signed file digest" testChannelSignedFile testGroupCheckMessages :: HasCallStack => TestParams -> IO () testGroupCheckMessages = @@ -12144,6 +12145,69 @@ testChannelMemberMessageSign ps = cath #$> ("/_get chat #1 count=100 search=plain hello", chat, [(1, "plain hello")]) dan #$> ("/_get chat #1 count=100 search=plain hello", chat, [(0, "plain hello")]) +testChannelSignedFile :: HasCallStack => TestParams -> IO () +testChannelSignedFile ps = + withNewTestChat ps "alice" aliceProfile $ \alice -> + withNewTestChatOpts ps relayTestOpts "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> + withNewTestChat ps "dan" danProfile $ \dan -> + withNewTestChat ps "eve" eveProfile $ \eve -> withXFTPServer $ do + xftpCLI ["rand", "./tests/tmp/testfile", "1mb"] `shouldReturn` ["File created: ./tests/tmp/testfile"] + createChannel1Relay "team" alice bob cath dan eve + promoteChannelMember "team" alice bob cath [dan, eve] + + -- cath's first (signed) message introduces her to dan/eve + cath ##> "/_send #1 sign=on text hi" + cath <# "#team hi (signed)" + bob <# "#team cath> hi (signed)" + concurrentlyN_ + [ alice <# "#team cath> hi (signed) [>>]", + do dan <### [EndsWith "updated to cath"] + dan <## "#team: bob introduced cath (Catherine) in the channel" + dan <# "#team cath> hi (signed) [>>]", + do eve <### [EndsWith "updated to cath"] + eve <## "#team: bob introduced cath (Catherine) in the channel" + eve <# "#team cath> hi (signed) [>>]" + ] + + -- cath sends a signed file + cath ##> "/_send #1 sign=on json [{\"filePath\": \"./tests/tmp/testfile\", \"msgContent\": {\"text\":\"signed file\",\"type\":\"file\"}}]" + cath <# "#team signed file (signed)" + cath <# "/f #team ./tests/tmp/testfile" + cath <## "use /fc 1 to cancel sending" + cath <## "completed uploading file 1 (testfile) for #team" + + bob <# "#team cath> signed file (signed)" + bob <# "#team cath> sends file testfile (1.0 MiB / 1048576 bytes)" + bob <## "use /fr 1 [/ | ] to receive it" + + concurrentlyN_ + [ do alice <# "#team cath> signed file (signed) [>>]" + alice <# "#team cath> sends file testfile (1.0 MiB / 1048576 bytes) [>>]" + alice <## "use /fr 1 [/ | ] to receive it [>>]", + do dan <# "#team cath> signed file (signed) [>>]" + dan <# "#team cath> sends file testfile (1.0 MiB / 1048576 bytes) [>>]" + dan <## "use /fr 1 [/ | ] to receive it [>>]", + do eve <# "#team cath> signed file (signed) [>>]" + eve <# "#team cath> sends file testfile (1.0 MiB / 1048576 bytes) [>>]" + eve <## "use /fr 1 [/ | ] to receive it [>>]" + ] + + -- dan downloads: the signed digest is verified and the file completes + dan ##> "/fr 1 ./tests/tmp" + dan + <### [ "saving file 1 from cath to ./tests/tmp/testfile_1", + "started receiving file 1 (testfile) from cath" + ] + dan <## "completed receiving file 1 (testfile) from cath" + src <- B.readFile "./tests/tmp/testfile" + destDan <- B.readFile "./tests/tmp/testfile_1" + destDan `shouldBe` src + -- the signed digest was carried to dan and stored, so verification ran (not skipped) and passed + digestCount <- withCCTransaction dan $ \db -> + DB.query_ db "SELECT count(1) FROM files WHERE file_digest IS NOT NULL" :: IO [[Int]] + digestCount `shouldBe` [[1]] + testChannelMemberUpdateEnforcement :: HasCallStack => TestParams -> IO () testChannelMemberUpdateEnforcement ps = withNewTestChat ps "alice" aliceProfile $ \alice ->