IntenseFinance/simplex-chat
3
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: support unicode filenames and catch IO exceptions in C API for local file encryption (#3035)

Browse Source 
* core: support unicode filenames in C API

* catch IO exceptions and return as errors
This commit is contained in:
Evgeny Poberezkin 2023-09-07 13:44:37 +01:00 committed by GitHub
parent 7cd4a417e7
commit b5a0269aa2
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 84 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
src/Simplex/Chat/Mobile/File.hs
View File

@ -34,6 +34,7 @@ import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..), Cryp
import qualified Simplex.Messaging.Crypto.File as CF
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
import Simplex.Messaging.Util (catchAll)
import UnliftIO (Handle, IOMode (..), withFile)
data WriteFileResult
@ -45,7 +46,7 @@ instance ToJSON WriteFileResult where toEncoding = J.genericToEncoding . sumType
cChatWriteFile :: CString -> Ptr Word8 -> CInt -> IO CJSONString
cChatWriteFile cPath ptr len = do
path <- peekCAString cPath
path <- peekCString cPath
s <- getByteString ptr len
r <- chatWriteFile path s
newCAString $ LB'.unpack $ J.encode r
@ -54,8 +55,8 @@ chatWriteFile :: FilePath -> ByteString -> IO WriteFileResult
chatWriteFile path s = do
cfArgs <- CF.randomArgs
let file = CryptoFile path $ Just cfArgs
either (WFError . show) (\_ -> WFResult cfArgs)
<$> runExceptT (CF.writeFile file $ LB.fromStrict s)
either WFError (\_ -> WFResult cfArgs)
<$> runCatchExceptT (withExceptT show $ CF.writeFile file $ LB.fromStrict s)
data ReadFileResult
= RFResult {fileSize :: Int}
@ -66,7 +67,7 @@ instance ToJSON ReadFileResult where toEncoding = J.genericToEncoding . sumTypeJ
cChatReadFile :: CString -> CString -> CString -> IO (Ptr Word8)
cChatReadFile cPath cKey cNonce = do
path <- peekCAString cPath
path <- peekCString cPath
key <- B.packCString cKey
nonce <- B.packCString cNonce
(r, s) <- chatReadFile path key nonce
@ -78,7 +79,7 @@ cChatReadFile cPath cKey cNonce = do
chatReadFile :: FilePath -> ByteString -> ByteString -> IO (ReadFileResult, ByteString)
chatReadFile path keyStr nonceStr = do
either ((,"") . RFError) result <$> runExceptT readFile_
either ((,"") . RFError) result <$> runCatchExceptT readFile_
where
result s = let s' = LB.toStrict s in (RFResult $ B.length s', s')
readFile_ :: ExceptT String IO LB.ByteString
@ -90,14 +91,14 @@ chatReadFile path keyStr nonceStr = do
cChatEncryptFile :: CString -> CString -> IO CJSONString
cChatEncryptFile cFromPath cToPath = do
fromPath <- peekCAString cFromPath
toPath <- peekCAString cToPath
fromPath <- peekCString cFromPath
toPath <- peekCString cToPath
r <- chatEncryptFile fromPath toPath
newCAString . LB'.unpack $ J.encode r
chatEncryptFile :: FilePath -> FilePath -> IO WriteFileResult
chatEncryptFile fromPath toPath =
either WFError WFResult <$> runExceptT encrypt
either WFError WFResult <$> runCatchExceptT encrypt
where
encrypt = do
cfArgs <- liftIO $ CF.randomArgs
@ -114,15 +115,15 @@ chatEncryptFile fromPath toPath =
cChatDecryptFile :: CString -> CString -> CString -> CString -> IO CString
cChatDecryptFile cFromPath cKey cNonce cToPath = do
fromPath <- peekCAString cFromPath
fromPath <- peekCString cFromPath
key <- B.packCString cKey
nonce <- B.packCString cNonce
toPath <- peekCAString cToPath
toPath <- peekCString cToPath
r <- chatDecryptFile fromPath key nonce toPath
newCAString r
chatDecryptFile :: FilePath -> ByteString -> ByteString -> FilePath -> IO String
chatDecryptFile fromPath keyStr nonceStr toPath = fromLeft "" <$> runExceptT decrypt
chatDecryptFile fromPath keyStr nonceStr toPath = fromLeft "" <$> runCatchExceptT decrypt
where
decrypt = do
key <- liftEither $ strDecode keyStr
@ -143,6 +144,9 @@ chatDecryptFile fromPath keyStr nonceStr toPath = fromLeft "" <$> runExceptT dec
liftIO $ B.hPut w ch
when (size' > 0) $ decryptChunks r w size'
runCatchExceptT :: ExceptT String IO a -> IO (Either String a)
runCatchExceptT action = runExceptT action `catchAll` (pure . Left . show)
chunkSize :: Num a => a
chunkSize = 65536
{-# INLINE chunkSize #-}

86
tests/MobileTests.hs
View File

@ -18,6 +18,7 @@ import Data.Word (Word8)
import Foreign.C
import Foreign.Marshal.Alloc (mallocBytes)
import Foreign.Ptr
import GHC.IO.Encoding (setLocaleEncoding, setFileSystemEncoding, setForeignEncoding)
import Simplex.Chat.Mobile
import Simplex.Chat.Mobile.File
import Simplex.Chat.Mobile.Shared
@ -27,21 +28,36 @@ 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 (CryptoFile(..), CryptoFileArgs (..), getFileContentsSize)
import Simplex.Messaging.Crypto.File (CryptoFile(..), CryptoFileArgs (..))
import qualified Simplex.Messaging.Crypto.File as CF
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
import System.Directory (copyFile)
import System.FilePath ((</>))
import System.IO (utf8)
import Test.Hspec
mobileTests :: HasCallStack => SpecWith FilePath
mobileTests = do
describe "mobile API" $ do
runIO $ do
setLocaleEncoding utf8
setFileSystemEncoding utf8
setForeignEncoding utf8
it "start new chat without user" testChatApiNoUser
it "start new chat with existing user" testChatApi
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
describe "should read/write encrypted files via C API" $ do
it "latin1 name" $ testFileCApi "test"
it "utf8 name 1" $ testFileCApi "тест"
it "utf8 name 2" $ testFileCApi "👍"
it "no exception on missing file" testMissingFileCApi
describe "should encrypt/decrypt files via C API" $ do
it "latin1 name" $ testFileEncryptionCApi "test"
it "utf8 name 1" $ testFileEncryptionCApi "тест"
it "utf8 name 2" $ testFileEncryptionCApi "👍"
it "no exception on missing file" testMissingFileEncryptionCApi
noActiveUser :: String
#if defined(darwin_HOST_OS) && defined(swiftJSON)
@ -176,16 +192,19 @@ instance FromJSON WriteFileResult where parseJSON = J.genericParseJSON . sumType
instance FromJSON ReadFileResult where parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RF"
testFileCApi :: FilePath -> IO ()
testFileCApi tmp = do
testFileCApi :: FilePath -> FilePath -> IO ()
testFileCApi fileName tmp = do
src <- B.readFile "./tests/fixtures/test.pdf"
cPath <- newCAString $ tmp </> "test.pdf"
let path = tmp </> (fileName <> ".pdf")
cPath <- newCString path
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
Just (WFResult cfArgs@(CFArgs key nonce)) <- jDecode r
let encryptedFile = CryptoFile path $ Just cfArgs
CF.getFileContentsSize encryptedFile `shouldReturn` fromIntegral (B.length src)
cKey <- encodedCString key
cNonce <- encodedCString nonce
ptr' <- cChatReadFile cPath cKey cNonce
@ -196,22 +215,53 @@ testFileCApi tmp = do
contents `shouldBe` src
sz `shouldBe` len
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)
testMissingFileCApi :: FilePath -> IO ()
testMissingFileCApi tmp = do
let path = tmp </> "missing_file"
cPath <- newCString path
CFArgs key nonce <- CF.randomArgs
cKey <- encodedCString key
cNonce <- encodedCString nonce
let toPath' = tmp </> "test.decrypted.pdf"
cToPath' <- newCAString toPath'
ptr <- cChatReadFile cPath cKey cNonce
r <- peekCAString $ castPtr ptr
Just (RFError err) <- jDecode r
err `shouldContain` "missing_file: openBinaryFile: does not exist"
testFileEncryptionCApi :: FilePath -> FilePath -> IO ()
testFileEncryptionCApi fileName tmp = do
let fromPath = tmp </> (fileName <> ".source.pdf")
copyFile "./tests/fixtures/test.pdf" fromPath
src <- B.readFile fromPath
cFromPath <- newCString fromPath
let toPath = tmp </> (fileName <> ".encrypted.pdf")
cToPath <- newCString toPath
r <- peekCAString =<< cChatEncryptFile cFromPath cToPath
Just (WFResult cfArgs@(CFArgs key nonce)) <- jDecode r
CF.getFileContentsSize (CryptoFile toPath $ Just cfArgs) `shouldReturn` fromIntegral (B.length src)
cKey <- encodedCString key
cNonce <- encodedCString nonce
let toPath' = tmp </> (fileName <> ".decrypted.pdf")
cToPath' <- newCString toPath'
"" <- peekCAString =<< cChatDecryptFile cToPath cKey cNonce cToPath'
B.readFile toPath' `shouldReturn` src
testMissingFileEncryptionCApi :: FilePath -> IO ()
testMissingFileEncryptionCApi tmp = do
let fromPath = tmp </> "missing_file.source.pdf"
toPath = tmp </> "missing_file.encrypted.pdf"
cFromPath <- newCString fromPath
cToPath <- newCString toPath
r <- peekCAString =<< cChatEncryptFile cFromPath cToPath
Just (WFError err) <- jDecode r
err `shouldContain` fromPath
CFArgs key nonce <- CF.randomArgs
cKey <- encodedCString key
cNonce <- encodedCString nonce
let toPath' = tmp </> "missing_file.decrypted.pdf"
cToPath' <- newCString toPath'
err' <- peekCAString =<< cChatDecryptFile cToPath cKey cNonce cToPath'
err' `shouldContain` toPath
jDecode :: FromJSON a => String -> IO (Maybe a)
jDecode = pure . J.decode . LB.pack