sign file hash

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:

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 ->

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"

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)

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}

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

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;
+|]

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

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;
+|]

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,

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 [<dir>/ | <path>] 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 [<dir>/ | <path>] 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 [<dir>/ | <path>] 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 [<dir>/ | <path>] 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 ->