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

@@ -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 #-}

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