From b5a0269aa201c60fcc7fdfd9e0d85d45a7e2300f Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Thu, 7 Sep 2023 13:44:37 +0100 Subject: [PATCH] core: support unicode filenames and catch IO exceptions in C API for local file encryption (#3035) * core: support unicode filenames in C API * catch IO exceptions and return as errors --- src/Simplex/Chat/Mobile/File.hs | 28 ++++++----- tests/MobileTests.hs | 86 ++++++++++++++++++++++++++------- 2 files changed, 84 insertions(+), 30 deletions(-) diff --git a/src/Simplex/Chat/Mobile/File.hs b/src/Simplex/Chat/Mobile/File.hs index 1c9219cab..a0fb3eb5b 100644 --- a/src/Simplex/Chat/Mobile/File.hs +++ b/src/Simplex/Chat/Mobile/File.hs @@ -34,6 +34,7 @@ import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..), Cryp import qualified Simplex.Messaging.Crypto.File as CF import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON) +import Simplex.Messaging.Util (catchAll) import UnliftIO (Handle, IOMode (..), withFile) data WriteFileResult @@ -45,7 +46,7 @@ instance ToJSON WriteFileResult where toEncoding = J.genericToEncoding . sumType cChatWriteFile :: CString -> Ptr Word8 -> CInt -> IO CJSONString cChatWriteFile cPath ptr len = do - path <- peekCAString cPath + path <- peekCString cPath s <- getByteString ptr len r <- chatWriteFile path s newCAString $ LB'.unpack $ J.encode r @@ -54,8 +55,8 @@ 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) + either WFError (\_ -> WFResult cfArgs) + <$> runCatchExceptT (withExceptT show $ CF.writeFile file $ LB.fromStrict s) data ReadFileResult = RFResult {fileSize :: Int} @@ -66,7 +67,7 @@ instance ToJSON ReadFileResult where toEncoding = J.genericToEncoding . sumTypeJ cChatReadFile :: CString -> CString -> CString -> IO (Ptr Word8) cChatReadFile cPath cKey cNonce = do - path <- peekCAString cPath + path <- peekCString cPath key <- B.packCString cKey nonce <- B.packCString cNonce (r, s) <- chatReadFile path key nonce @@ -78,7 +79,7 @@ cChatReadFile cPath cKey cNonce = do chatReadFile :: FilePath -> ByteString -> ByteString -> IO (ReadFileResult, ByteString) chatReadFile path keyStr nonceStr = do - either ((,"") . RFError) result <$> runExceptT readFile_ + either ((,"") . RFError) result <$> runCatchExceptT readFile_ where result s = let s' = LB.toStrict s in (RFResult $ B.length s', s') readFile_ :: ExceptT String IO LB.ByteString @@ -90,14 +91,14 @@ chatReadFile path keyStr nonceStr = do cChatEncryptFile :: CString -> CString -> IO CJSONString cChatEncryptFile cFromPath cToPath = do - fromPath <- peekCAString cFromPath - toPath <- peekCAString cToPath + fromPath <- peekCString cFromPath + toPath <- peekCString cToPath r <- chatEncryptFile fromPath toPath newCAString . LB'.unpack $ J.encode r chatEncryptFile :: FilePath -> FilePath -> IO WriteFileResult chatEncryptFile fromPath toPath = - either WFError WFResult <$> runExceptT encrypt + either WFError WFResult <$> runCatchExceptT encrypt where encrypt = do cfArgs <- liftIO $ CF.randomArgs @@ -114,15 +115,15 @@ chatEncryptFile fromPath toPath = cChatDecryptFile :: CString -> CString -> CString -> CString -> IO CString cChatDecryptFile cFromPath cKey cNonce cToPath = do - fromPath <- peekCAString cFromPath + fromPath <- peekCString cFromPath key <- B.packCString cKey nonce <- B.packCString cNonce - toPath <- peekCAString cToPath + toPath <- peekCString cToPath r <- chatDecryptFile fromPath key nonce toPath newCAString r - + chatDecryptFile :: FilePath -> ByteString -> ByteString -> FilePath -> IO String -chatDecryptFile fromPath keyStr nonceStr toPath = fromLeft "" <$> runExceptT decrypt +chatDecryptFile fromPath keyStr nonceStr toPath = fromLeft "" <$> runCatchExceptT decrypt where decrypt = do key <- liftEither $ strDecode keyStr @@ -143,6 +144,9 @@ chatDecryptFile fromPath keyStr nonceStr toPath = fromLeft "" <$> runExceptT dec liftIO $ B.hPut w ch when (size' > 0) $ decryptChunks r w size' +runCatchExceptT :: ExceptT String IO a -> IO (Either String a) +runCatchExceptT action = runExceptT action `catchAll` (pure . Left . show) + chunkSize :: Num a => a chunkSize = 65536 {-# INLINE chunkSize #-} diff --git a/tests/MobileTests.hs b/tests/MobileTests.hs index 26b096086..6746266d5 100644 --- a/tests/MobileTests.hs +++ b/tests/MobileTests.hs @@ -18,6 +18,7 @@ import Data.Word (Word8) import Foreign.C import Foreign.Marshal.Alloc (mallocBytes) import Foreign.Ptr +import GHC.IO.Encoding (setLocaleEncoding, setFileSystemEncoding, setForeignEncoding) import Simplex.Chat.Mobile import Simplex.Chat.Mobile.File import Simplex.Chat.Mobile.Shared @@ -27,21 +28,36 @@ import Simplex.Chat.Store.Profiles import Simplex.Chat.Types (AgentUserId (..), Profile (..)) import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..)) import qualified Simplex.Messaging.Crypto as C -import Simplex.Messaging.Crypto.File (CryptoFile(..), CryptoFileArgs (..), getFileContentsSize) +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) +import System.Directory (copyFile) import System.FilePath (()) +import System.IO (utf8) import Test.Hspec mobileTests :: HasCallStack => SpecWith FilePath mobileTests = do describe "mobile API" $ do + runIO $ do + setLocaleEncoding utf8 + setFileSystemEncoding utf8 + setForeignEncoding utf8 it "start new chat without user" testChatApiNoUser it "start new chat with existing user" testChatApi it "should encrypt/decrypt WebRTC frames" testMediaApi it "should encrypt/decrypt WebRTC frames via C API" testMediaCApi - it "should read/write encrypted files via C API" testFileCApi - it "should encrypt/decrypt files via C API" testFileEncryptionCApi + describe "should read/write encrypted files via C API" $ do + it "latin1 name" $ testFileCApi "test" + it "utf8 name 1" $ testFileCApi "ั‚ะตัั‚" + it "utf8 name 2" $ testFileCApi "๐Ÿ‘" + it "no exception on missing file" testMissingFileCApi + describe "should encrypt/decrypt files via C API" $ do + it "latin1 name" $ testFileEncryptionCApi "test" + it "utf8 name 1" $ testFileEncryptionCApi "ั‚ะตัั‚" + it "utf8 name 2" $ testFileEncryptionCApi "๐Ÿ‘" + it "no exception on missing file" testMissingFileEncryptionCApi noActiveUser :: String #if defined(darwin_HOST_OS) && defined(swiftJSON) @@ -176,16 +192,19 @@ instance FromJSON WriteFileResult where parseJSON = J.genericParseJSON . sumType instance FromJSON ReadFileResult where parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RF" -testFileCApi :: FilePath -> IO () -testFileCApi tmp = do +testFileCApi :: FilePath -> FilePath -> IO () +testFileCApi fileName tmp = do src <- B.readFile "./tests/fixtures/test.pdf" - cPath <- newCAString $ tmp "test.pdf" + let path = tmp (fileName <> ".pdf") + cPath <- newCString path let len = B.length src cLen = fromIntegral len ptr <- mallocBytes $ B.length src putByteString ptr src r <- peekCAString =<< cChatWriteFile cPath ptr cLen - Just (WFResult (CFArgs key nonce)) <- jDecode r + Just (WFResult cfArgs@(CFArgs key nonce)) <- jDecode r + let encryptedFile = CryptoFile path $ Just cfArgs + CF.getFileContentsSize encryptedFile `shouldReturn` fromIntegral (B.length src) cKey <- encodedCString key cNonce <- encodedCString nonce ptr' <- cChatReadFile cPath cKey cNonce @@ -196,22 +215,53 @@ testFileCApi tmp = do contents `shouldBe` src sz `shouldBe` len -testFileEncryptionCApi :: FilePath -> IO () -testFileEncryptionCApi tmp = do - src <- B.readFile "./tests/fixtures/test.pdf" - cFromPath <- newCAString "./tests/fixtures/test.pdf" - let toPath = tmp "test.encrypted.pdf" - cToPath <- newCAString toPath - r <- peekCAString =<< cChatEncryptFile cFromPath cToPath - Just (WFResult cfArgs@(CFArgs key nonce)) <- jDecode r - getFileContentsSize (CryptoFile toPath $ Just cfArgs) `shouldReturn` fromIntegral (B.length src) +testMissingFileCApi :: FilePath -> IO () +testMissingFileCApi tmp = do + let path = tmp "missing_file" + cPath <- newCString path + CFArgs key nonce <- CF.randomArgs cKey <- encodedCString key cNonce <- encodedCString nonce - let toPath' = tmp "test.decrypted.pdf" - cToPath' <- newCAString toPath' + ptr <- cChatReadFile cPath cKey cNonce + r <- peekCAString $ castPtr ptr + Just (RFError err) <- jDecode r + err `shouldContain` "missing_file: openBinaryFile: does not exist" + +testFileEncryptionCApi :: FilePath -> FilePath -> IO () +testFileEncryptionCApi fileName tmp = do + let fromPath = tmp (fileName <> ".source.pdf") + copyFile "./tests/fixtures/test.pdf" fromPath + src <- B.readFile fromPath + cFromPath <- newCString fromPath + let toPath = tmp (fileName <> ".encrypted.pdf") + cToPath <- newCString toPath + r <- peekCAString =<< cChatEncryptFile cFromPath cToPath + Just (WFResult cfArgs@(CFArgs key nonce)) <- jDecode r + CF.getFileContentsSize (CryptoFile toPath $ Just cfArgs) `shouldReturn` fromIntegral (B.length src) + cKey <- encodedCString key + cNonce <- encodedCString nonce + let toPath' = tmp (fileName <> ".decrypted.pdf") + cToPath' <- newCString toPath' "" <- peekCAString =<< cChatDecryptFile cToPath cKey cNonce cToPath' B.readFile toPath' `shouldReturn` src +testMissingFileEncryptionCApi :: FilePath -> IO () +testMissingFileEncryptionCApi tmp = do + let fromPath = tmp "missing_file.source.pdf" + toPath = tmp "missing_file.encrypted.pdf" + cFromPath <- newCString fromPath + cToPath <- newCString toPath + r <- peekCAString =<< cChatEncryptFile cFromPath cToPath + Just (WFError err) <- jDecode r + err `shouldContain` fromPath + CFArgs key nonce <- CF.randomArgs + cKey <- encodedCString key + cNonce <- encodedCString nonce + let toPath' = tmp "missing_file.decrypted.pdf" + cToPath' <- newCString toPath' + err' <- peekCAString =<< cChatDecryptFile cToPath cKey cNonce cToPath' + err' `shouldContain` toPath + jDecode :: FromJSON a => String -> IO (Maybe a) jDecode = pure . J.decode . LB.pack