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

@@ -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)
+  either WFError (\_ -> WFResult cfArgs)
-    <$> runExceptT (CF.writeFile file $ LB.fromStrict s)
+    <$> 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
+  fromPath <- peekCString cFromPath
-  toPath <- peekCAString cToPath
+  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 #-}

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
+    describe "should read/write encrypted files via C API" $ do
-    it "should encrypt/decrypt files via C API" testFileEncryptionCApi
+      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 :: FilePath -> FilePath -> IO ()
-testFileCApi tmp = do
+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 ()
+testMissingFileCApi :: FilePath -> IO ()
-testFileEncryptionCApi tmp = do
+testMissingFileCApi tmp = do
-  src <- B.readFile "./tests/fixtures/test.pdf"
+  let path = tmp </> "missing_file"
-  cFromPath <- newCAString "./tests/fixtures/test.pdf"
+  cPath <- newCString path
-  let toPath = tmp </> "test.encrypted.pdf"
+  CFArgs key nonce <- CF.randomArgs
-  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)
   cKey <- encodedCString key
   cNonce <- encodedCString nonce
-  let toPath' = tmp </> "test.decrypted.pdf"
+  ptr <- cChatReadFile cPath cKey cNonce
-  cToPath' <- newCAString toPath'
+  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