From edeaf36e8b8eede3194af5c11a5d433c11182d31 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Wed, 6 Sep 2023 19:54:13 +0100 Subject: [PATCH] core: C api to encrypt/decrypt local app files (#3029) * core: C api to encrypt/decrypt local app files * do not call CF.hPut with empty chunk --- src/Simplex/Chat/Mobile/File.hs | 67 ++++++++++++++++++++++++++++++++- tests/MobileTests.hs | 30 ++++++++++++--- 2 files changed, 90 insertions(+), 7 deletions(-) diff --git a/src/Simplex/Chat/Mobile/File.hs b/src/Simplex/Chat/Mobile/File.hs index 25e694365..1c9219cab 100644 --- a/src/Simplex/Chat/Mobile/File.hs +++ b/src/Simplex/Chat/Mobile/File.hs @@ -1,10 +1,14 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} module Simplex.Chat.Mobile.File ( cChatWriteFile, cChatReadFile, + cChatEncryptFile, + cChatDecryptFile, WriteFileResult (..), ReadFileResult (..), chatWriteFile, @@ -19,16 +23,18 @@ 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.Either (fromLeft) import Data.Word (Word8) import Foreign.C import Foreign.Marshal.Alloc (mallocBytes) import Foreign.Ptr import GHC.Generics (Generic) import Simplex.Chat.Mobile.Shared -import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) +import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..), CryptoFileHandle, FTCryptoError (..)) import qualified Simplex.Messaging.Crypto.File as CF import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON) +import UnliftIO (Handle, IOMode (..), withFile) data WriteFileResult = WFResult {cryptoArgs :: CryptoFileArgs} @@ -81,3 +87,62 @@ chatReadFile path keyStr nonceStr = do 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 + fromPath <- peekCAString cFromPath + toPath <- peekCAString cToPath + r <- chatEncryptFile fromPath toPath + newCAString . LB'.unpack $ J.encode r + +chatEncryptFile :: FilePath -> FilePath -> IO WriteFileResult +chatEncryptFile fromPath toPath = + either WFError WFResult <$> runExceptT encrypt + where + encrypt = do + cfArgs <- liftIO $ CF.randomArgs + let toFile = CryptoFile toPath $ Just cfArgs + withExceptT show $ + withFile fromPath ReadMode $ \r -> CF.withFile toFile WriteMode $ \w -> do + encryptChunks r w + liftIO $ CF.hPutTag w + pure cfArgs + encryptChunks r w = do + ch <- liftIO $ LB.hGet r chunkSize + unless (LB.null ch) $ liftIO $ CF.hPut w ch + unless (LB.length ch < chunkSize) $ encryptChunks r w + +cChatDecryptFile :: CString -> CString -> CString -> CString -> IO CString +cChatDecryptFile cFromPath cKey cNonce cToPath = do + fromPath <- peekCAString cFromPath + key <- B.packCString cKey + nonce <- B.packCString cNonce + toPath <- peekCAString cToPath + r <- chatDecryptFile fromPath key nonce toPath + newCAString r + +chatDecryptFile :: FilePath -> ByteString -> ByteString -> FilePath -> IO String +chatDecryptFile fromPath keyStr nonceStr toPath = fromLeft "" <$> runExceptT decrypt + where + decrypt = do + key <- liftEither $ strDecode keyStr + nonce <- liftEither $ strDecode nonceStr + let fromFile = CryptoFile fromPath $ Just $ CFArgs key nonce + size <- liftIO $ CF.getFileContentsSize fromFile + withExceptT show $ + CF.withFile fromFile ReadMode $ \r -> withFile toPath WriteMode $ \w -> do + decryptChunks r w size + CF.hGetTag r + decryptChunks :: CryptoFileHandle -> Handle -> Integer -> ExceptT FTCryptoError IO () + decryptChunks r w !size = do + let chSize = min size chunkSize + chSize' = fromIntegral chSize + size' = size - chSize + ch <- liftIO $ CF.hGet r chSize' + when (B.length ch /= chSize') $ throwError $ FTCEFileIOError "encrypting file: unexpected EOF" + liftIO $ B.hPut w ch + when (size' > 0) $ decryptChunks r w size' + +chunkSize :: Num a => a +chunkSize = 65536 +{-# INLINE chunkSize #-} diff --git a/tests/MobileTests.hs b/tests/MobileTests.hs index 604a1640e..26b096086 100644 --- a/tests/MobileTests.hs +++ b/tests/MobileTests.hs @@ -27,7 +27,7 @@ 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.Crypto.File (CryptoFile(..), CryptoFileArgs (..), getFileContentsSize) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON) import System.FilePath (()) @@ -41,6 +41,7 @@ mobileTests = do 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 + it "should encrypt/decrypt files via C API" testFileEncryptionCApi noActiveUser :: String #if defined(darwin_HOST_OS) && defined(swiftJSON) @@ -194,8 +195,25 @@ testFileCApi tmp = do 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 + +testFileEncryptionCApi :: FilePath -> IO () +testFileEncryptionCApi tmp = do + src <- B.readFile "./tests/fixtures/test.pdf" + cFromPath <- newCAString "./tests/fixtures/test.pdf" + let toPath = tmp "test.encrypted.pdf" + cToPath <- newCAString toPath + r <- peekCAString =<< cChatEncryptFile cFromPath cToPath + Just (WFResult cfArgs@(CFArgs key nonce)) <- jDecode r + getFileContentsSize (CryptoFile toPath $ Just cfArgs) `shouldReturn` fromIntegral (B.length src) + cKey <- encodedCString key + cNonce <- encodedCString nonce + let toPath' = tmp "test.decrypted.pdf" + cToPath' <- newCAString toPath' + "" <- peekCAString =<< cChatDecryptFile cToPath cKey cNonce cToPath' + B.readFile toPath' `shouldReturn` src + +jDecode :: FromJSON a => String -> IO (Maybe a) +jDecode = pure . J.decode . LB.pack + +encodedCString :: StrEncoding a => a -> IO CString +encodedCString = newCAString . BS.unpack . strEncode