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
This commit is contained in:
Evgeny Poberezkin 2023-09-07 20:18:43 +01:00 committed by GitHub
parent b5a0269aa2
commit 82fd3b9004
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 33 additions and 29 deletions

View File

@ -23,11 +23,13 @@ import Data.ByteString (ByteString)
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB import qualified Data.ByteString.Lazy as LB
import qualified Data.ByteString.Lazy.Char8 as LB' import qualified Data.ByteString.Lazy.Char8 as LB'
import Data.Char (chr)
import Data.Either (fromLeft) import Data.Either (fromLeft)
import Data.Word (Word8) import Data.Word (Word8, Word32)
import Foreign.C import Foreign.C
import Foreign.Marshal.Alloc (mallocBytes) import Foreign.Marshal.Alloc (mallocBytes)
import Foreign.Ptr import Foreign.Ptr
import Foreign.Storable (poke)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Simplex.Chat.Mobile.Shared import Simplex.Chat.Mobile.Shared
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..), CryptoFileHandle, FTCryptoError (..)) import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..), CryptoFileHandle, FTCryptoError (..))
@ -70,20 +72,19 @@ cChatReadFile cPath cKey cNonce = do
path <- peekCString cPath path <- peekCString cPath
key <- B.packCString cKey key <- B.packCString cKey
nonce <- B.packCString cNonce nonce <- B.packCString cNonce
(r, s) <- chatReadFile path key nonce chatReadFile path key nonce >>= \case
let r' = LB.toStrict $ J.encode r <> "\NUL" Left e -> castPtr <$> newCString (chr 1 : e)
ptr <- mallocBytes $ B.length r' + B.length s Right s -> do
putByteString ptr r' let s' = LB.toStrict s
unless (B.null s) $ putByteString (ptr `plusPtr` B.length r') 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 pure ptr
chatReadFile :: FilePath -> ByteString -> ByteString -> IO (ReadFileResult, ByteString) chatReadFile :: FilePath -> ByteString -> ByteString -> IO (Either String LB.ByteString)
chatReadFile path keyStr nonceStr = do chatReadFile path keyStr nonceStr = runCatchExceptT $ 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 key <- liftEither $ strDecode keyStr
nonce <- liftEither $ strDecode nonceStr nonce <- liftEither $ strDecode nonceStr
let file = CryptoFile path $ Just $ CFArgs key nonce let file = CryptoFile path $ Just $ CFArgs key nonce

View File

@ -1041,9 +1041,9 @@ testXFTPFileTransferEncrypted =
alice <## "completed uploading file 1 (test.pdf) for bob" alice <## "completed uploading file 1 (test.pdf) for bob"
bob <## "started receiving file 1 (test.pdf) from alice" bob <## "started receiving file 1 (test.pdf) from alice"
bob <## "completed 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) Right dest <- chatReadFile "./tests/tmp/bob/test.pdf" (strEncode key) (strEncode nonce)
fromIntegral destLen `shouldBe` srcLen LB.length dest `shouldBe` fromIntegral srcLen
dest `shouldBe` src LB.toStrict dest `shouldBe` src
where where
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"} cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}

View File

@ -13,11 +13,13 @@ import qualified Data.Aeson as J
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Char8 as BS
import Data.ByteString.Internal (create, memcpy)
import qualified Data.ByteString.Lazy.Char8 as LB import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Word (Word8) import Data.Word (Word8, Word32)
import Foreign.C import Foreign.C
import Foreign.Marshal.Alloc (mallocBytes) import Foreign.Marshal.Alloc (mallocBytes)
import Foreign.Ptr import Foreign.Ptr
import Foreign.Storable (peek)
import GHC.IO.Encoding (setLocaleEncoding, setFileSystemEncoding, setForeignEncoding) import GHC.IO.Encoding (setLocaleEncoding, setFileSystemEncoding, setForeignEncoding)
import Simplex.Chat.Mobile import Simplex.Chat.Mobile
import Simplex.Chat.Mobile.File import Simplex.Chat.Mobile.File
@ -207,13 +209,14 @@ testFileCApi fileName tmp = do
CF.getFileContentsSize encryptedFile `shouldReturn` fromIntegral (B.length src) CF.getFileContentsSize encryptedFile `shouldReturn` fromIntegral (B.length src)
cKey <- encodedCString key cKey <- encodedCString key
cNonce <- encodedCString nonce cNonce <- encodedCString nonce
-- the returned pointer contains 0, buffer length as Word32, then buffer
ptr' <- cChatReadFile cPath cKey cNonce ptr' <- cChatReadFile cPath cKey cNonce
-- the returned pointer contains NUL-terminated JSON string of ReadFileResult followed by the file contents peek ptr' `shouldReturn` (0 :: Word8)
r' <- peekCAString $ castPtr ptr' sz :: Word32 <- peek (ptr' `plusPtr` 1)
Just (RFResult sz) <- jDecode r' let sz' = fromIntegral sz
contents <- getByteString (ptr' `plusPtr` (length r' + 1)) $ fromIntegral sz contents <- create sz' $ \toPtr -> memcpy toPtr (ptr' `plusPtr` 5) sz'
contents `shouldBe` src contents `shouldBe` src
sz `shouldBe` len sz' `shouldBe` fromIntegral len
testMissingFileCApi :: FilePath -> IO () testMissingFileCApi :: FilePath -> IO ()
testMissingFileCApi tmp = do testMissingFileCApi tmp = do
@ -223,8 +226,8 @@ testMissingFileCApi tmp = do
cKey <- encodedCString key cKey <- encodedCString key
cNonce <- encodedCString nonce cNonce <- encodedCString nonce
ptr <- cChatReadFile cPath cKey cNonce ptr <- cChatReadFile cPath cKey cNonce
r <- peekCAString $ castPtr ptr peek ptr `shouldReturn` 1
Just (RFError err) <- jDecode r err <- peekCAString (ptr `plusPtr` 1)
err `shouldContain` "missing_file: openBinaryFile: does not exist" err `shouldContain` "missing_file: openBinaryFile: does not exist"
testFileEncryptionCApi :: FilePath -> FilePath -> IO () testFileEncryptionCApi :: FilePath -> FilePath -> IO ()