mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-04-17 15:35:58 +00:00
core: support unicode filenames and catch IO exceptions in C API for local file encryption (#3035)
* core: support unicode filenames in C API * catch IO exceptions and return as errors
This commit is contained in:
committed by
GitHub
parent
7cd4a417e7
commit
b5a0269aa2
@@ -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 #-}
|
||||
|
||||
Reference in New Issue
Block a user