From 82fd3b9004fcd37f90e0020d078cd00faa797d0d Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Thu, 7 Sep 2023 20:18:43 +0100
Subject: [PATCH] core: change encoding of the result returned by
 chat_read_file C API (#3036)

* core: change encoding of the result returned by chat_read_file C API

* remove unused dependency

* remove pointer cast
---
 src/Simplex/Chat/Mobile/File.hs | 37 +++++++++++++++++----------------
 tests/ChatTests/Files.hs        |  6 +++---
 tests/MobileTests.hs            | 19 ++++++++++-------
 3 files changed, 33 insertions(+), 29 deletions(-)

diff --git a/src/Simplex/Chat/Mobile/File.hs b/src/Simplex/Chat/Mobile/File.hs
index a0fb3eb5b..4aabbcd12 100644
--- a/src/Simplex/Chat/Mobile/File.hs
+++ b/src/Simplex/Chat/Mobile/File.hs
@@ -23,11 +23,13 @@ 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.Char (chr)
 import Data.Either (fromLeft)
-import Data.Word (Word8)
+import Data.Word (Word8, Word32)
 import Foreign.C
 import Foreign.Marshal.Alloc (mallocBytes)
 import Foreign.Ptr
+import Foreign.Storable (poke)
 import GHC.Generics (Generic)
 import Simplex.Chat.Mobile.Shared
 import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..), CryptoFileHandle, FTCryptoError (..))
@@ -70,24 +72,23 @@ cChatReadFile cPath cKey cNonce = do
   path <- peekCString 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 path key nonce >>= \case
+    Left e -> castPtr <$> newCString (chr 1 : e)
+    Right s -> do
+      let s' = LB.toStrict s
+          len = B.length s'
+      ptr <- mallocBytes $ len + 5
+      poke ptr 0
+      poke (ptr `plusPtr` 1) (fromIntegral len :: Word32)
+      putByteString (ptr `plusPtr` 5) s'
+      pure ptr
 
-chatReadFile :: FilePath -> ByteString -> ByteString -> IO (ReadFileResult, ByteString)
-chatReadFile path keyStr nonceStr = do
-  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
-    readFile_ = do
-      key <- liftEither $ strDecode keyStr
-      nonce <- liftEither $ strDecode nonceStr
-      let file = CryptoFile path $ Just $ CFArgs key nonce
-      withExceptT show $ CF.readFile file
+chatReadFile :: FilePath -> ByteString -> ByteString -> IO (Either String LB.ByteString)
+chatReadFile path keyStr nonceStr = runCatchExceptT $ do
+  key <- liftEither $ strDecode keyStr
+  nonce <- liftEither $ strDecode nonceStr
+  let file = CryptoFile path $ Just $ CFArgs key nonce
+  withExceptT show $ CF.readFile file
 
 cChatEncryptFile :: CString -> CString -> IO CJSONString
 cChatEncryptFile cFromPath cToPath = do
diff --git a/tests/ChatTests/Files.hs b/tests/ChatTests/Files.hs
index 0adb234ce..927705f4d 100644
--- a/tests/ChatTests/Files.hs
+++ b/tests/ChatTests/Files.hs
@@ -1041,9 +1041,9 @@ testXFTPFileTransferEncrypted =
       alice <## "completed uploading file 1 (test.pdf) for bob"
       bob <## "started receiving file 1 (test.pdf) from alice"
       bob <## "completed receiving file 1 (test.pdf) from alice"
-      (RFResult destLen, dest) <- chatReadFile "./tests/tmp/bob/test.pdf" (strEncode key) (strEncode nonce)
-      fromIntegral destLen `shouldBe` srcLen
-      dest `shouldBe` src
+      Right dest <- chatReadFile "./tests/tmp/bob/test.pdf" (strEncode key) (strEncode nonce)
+      LB.length dest `shouldBe` fromIntegral srcLen
+      LB.toStrict dest `shouldBe` src
   where
     cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
 
diff --git a/tests/MobileTests.hs b/tests/MobileTests.hs
index 6746266d5..07d0d2fe9 100644
--- a/tests/MobileTests.hs
+++ b/tests/MobileTests.hs
@@ -13,11 +13,13 @@ import qualified Data.Aeson as J
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as BS
+import Data.ByteString.Internal (create, memcpy)
 import qualified Data.ByteString.Lazy.Char8 as LB
-import Data.Word (Word8)
+import Data.Word (Word8, Word32)
 import Foreign.C
 import Foreign.Marshal.Alloc (mallocBytes)
 import Foreign.Ptr
+import Foreign.Storable (peek)
 import GHC.IO.Encoding (setLocaleEncoding, setFileSystemEncoding, setForeignEncoding)
 import Simplex.Chat.Mobile
 import Simplex.Chat.Mobile.File
@@ -207,13 +209,14 @@ testFileCApi fileName tmp = do
   CF.getFileContentsSize encryptedFile `shouldReturn` fromIntegral (B.length src)
   cKey <- encodedCString key
   cNonce <- encodedCString nonce
+  -- the returned pointer contains 0, buffer length as Word32, then buffer
   ptr' <- cChatReadFile cPath cKey cNonce
-  -- the returned pointer contains NUL-terminated JSON string of ReadFileResult followed by the file contents
-  r' <- peekCAString $ castPtr ptr'
-  Just (RFResult sz) <- jDecode r'
-  contents <- getByteString (ptr' `plusPtr` (length r' + 1)) $ fromIntegral sz
+  peek ptr' `shouldReturn` (0 :: Word8)
+  sz :: Word32 <- peek (ptr' `plusPtr` 1)
+  let sz' = fromIntegral sz
+  contents <- create sz' $ \toPtr -> memcpy toPtr (ptr' `plusPtr` 5) sz'
   contents `shouldBe` src
-  sz `shouldBe` len
+  sz' `shouldBe` fromIntegral len
 
 testMissingFileCApi :: FilePath -> IO ()
 testMissingFileCApi tmp = do
@@ -223,8 +226,8 @@ testMissingFileCApi tmp = do
   cKey <- encodedCString key
   cNonce <- encodedCString nonce
   ptr <- cChatReadFile cPath cKey cNonce
-  r <- peekCAString $ castPtr ptr
-  Just (RFError err) <- jDecode r
+  peek ptr `shouldReturn` 1
+  err <- peekCAString (ptr `plusPtr` 1)
   err `shouldContain` "missing_file: openBinaryFile: does not exist"
 
 testFileEncryptionCApi :: FilePath -> FilePath -> IO ()