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:
parent
b5a0269aa2
commit
82fd3b9004
@ -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
|
||||
|
@ -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"}
|
||||
|
||||
|
@ -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 ()
|
||||
|
Loading…
Reference in New Issue
Block a user