diff --git a/src/Simplex/Chat/Mobile/File.hs b/src/Simplex/Chat/Mobile/File.hs index 4f73e191a..25e694365 100644 --- a/src/Simplex/Chat/Mobile/File.hs +++ b/src/Simplex/Chat/Mobile/File.hs @@ -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 diff --git a/tests/MobileTests.hs b/tests/MobileTests.hs index e11496ef4..604a1640e 100644 --- a/tests/MobileTests.hs +++ b/tests/MobileTests.hs @@ -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