core: update return type of read/write file C api, tests (#3010)
This commit is contained in:
parent
aa67692465
commit
4793173465
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user