core: update return type of read/write file C api, tests (#3010)

This commit is contained in:
Evgeny Poberezkin 2023-09-03 22:25:19 +01:00 committed by GitHub
parent aa67692465
commit 4793173465
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 46 additions and 8 deletions

View File

@ -19,7 +19,6 @@ 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.Int (Int64)
import Data.Word (Word8)
import Foreign.C
import Foreign.Marshal.Alloc (mallocBytes)
@ -53,7 +52,7 @@ chatWriteFile path s = do
<$> runExceptT (CF.writeFile file $ LB.fromStrict s)
data ReadFileResult
= RFResult {fileSize :: Int64}
= RFResult {fileSize :: Int}
| RFError {readError :: String}
deriving (Generic)
@ -65,7 +64,7 @@ cChatReadFile cPath cKey cNonce = do
key <- B.packCString cKey
nonce <- B.packCString cNonce
(r, s) <- chatReadFile path key nonce
let r' = LB.toStrict (J.encode r) <> "\NUL"
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
@ -73,8 +72,9 @@ cChatReadFile cPath cKey cNonce = do
chatReadFile :: FilePath -> ByteString -> ByteString -> IO (ReadFileResult, ByteString)
chatReadFile path keyStr nonceStr = do
either ((,"") . RFError) (\s -> (RFResult $ LB.length s, LB.toStrict s)) <$> runExceptT readFile_
either ((,"") . RFError) result <$> runExceptT 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

View File

@ -1,19 +1,25 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module MobileTests where
import ChatTests.Utils
import Control.Monad.Except
import Crypto.Random (getRandomBytes)
import Data.Aeson (FromJSON (..))
import qualified Data.Aeson as J
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Word (Word8)
import Foreign.C
import Foreign.Marshal.Alloc (mallocBytes)
import Foreign.Ptr
import Simplex.Chat.Mobile
import Simplex.Chat.Mobile.File
import Simplex.Chat.Mobile.Shared
import Simplex.Chat.Mobile.WebRTC
import Simplex.Chat.Store
@ -21,7 +27,9 @@ 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 (CryptoFileArgs (..))
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
import System.FilePath ((</>))
import Test.Hspec
@ -30,8 +38,9 @@ mobileTests = do
describe "mobile API" $ do
it "start new chat without user" testChatApiNoUser
it "start new chat with existing user" testChatApi
fit "should encrypt/decrypt WebRTC frames" testMediaApi
fit "should encrypt/decrypt WebRTC frames via C API" testMediaCApi
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
noActiveUser :: String
#if defined(darwin_HOST_OS) && defined(swiftJSON)
@ -158,6 +167,35 @@ testMediaCApi _ = do
cLen = fromIntegral len
ptr <- mallocBytes len
putByteString ptr frame
cKeyStr <- newCString $ BS.unpack keyStr
(f cKeyStr ptr cLen >>= peekCString) `shouldReturn` ""
cKeyStr <- newCAString $ BS.unpack keyStr
(f cKeyStr ptr cLen >>= peekCAString) `shouldReturn` ""
getByteString ptr cLen
instance FromJSON WriteFileResult where parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "WF"
instance FromJSON ReadFileResult where parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RF"
testFileCApi :: FilePath -> IO ()
testFileCApi tmp = do
src <- B.readFile "./tests/fixtures/test.pdf"
cPath <- newCAString $ tmp </> "test.pdf"
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
cKey <- encodedCString key
cNonce <- encodedCString nonce
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
contents `shouldBe` src
sz `shouldBe` len
where
jDecode :: FromJSON a => String -> IO (Maybe a)
jDecode = pure . J.decode . LB.pack
encodedCString :: StrEncoding a => a -> IO CString
encodedCString = newCAString . BS.unpack . strEncode