core: update/fix webrtc frame encryption function to return error (#1950)

* core: update/fix webrtc frame encryption function to return error

* ios: update C header

* more tests
This commit is contained in:
Evgeny Poberezkin
2023-02-24 20:55:59 +00:00
committed by GitHub
parent 5075657c02
commit a2e5733be6
4 changed files with 77 additions and 45 deletions

View File

@@ -65,9 +65,9 @@ foreign export ccall "chat_parse_markdown" cChatParseMarkdown :: CString -> IO C
foreign export ccall "chat_parse_server" cChatParseServer :: CString -> IO CJSONString
foreign export ccall "chat_encrypt_media" cChatEncryptMedia :: CString -> Ptr Word8 -> CInt -> IO ()
foreign export ccall "chat_encrypt_media" cChatEncryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString
foreign export ccall "chat_decrypt_media" cChatDecryptMedia :: CString -> Ptr Word8 -> CInt -> IO ()
foreign export ccall "chat_decrypt_media" cChatDecryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString
-- | check / migrate database and initialize chat controller on success
cChatMigrateInit :: CString -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString

View File

@@ -1,54 +1,72 @@
{-# LANGUAGE FlexibleContexts #-}
module Simplex.Chat.Mobile.WebRTC where
import Control.Monad.Except
import qualified Crypto.Cipher.Types as AES
import Crypto.Random (getRandomBytes)
import Data.Bifunctor (bimap)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64.URL as U
import Data.ByteString.Internal (ByteString (PS), memcpy)
import Data.Either (fromRight)
import Data.Either (fromLeft)
import Data.Word (Word8)
import Foreign.C (CInt, CString)
import Foreign.C (CInt, CString, newCAString)
import Foreign.ForeignPtr (newForeignPtr_)
import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
import Foreign.Ptr (Ptr, plusPtr)
import qualified Simplex.Messaging.Crypto as C
cChatEncryptMedia :: CString -> Ptr Word8 -> CInt -> IO ()
cChatEncryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString
cChatEncryptMedia = cTransformMedia chatEncryptMedia
cChatDecryptMedia :: CString -> Ptr Word8 -> CInt -> IO ()
cChatDecryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString
cChatDecryptMedia = cTransformMedia chatDecryptMedia
cTransformMedia :: (ByteString -> ByteString -> IO ByteString) -> CString -> Ptr Word8 -> CInt -> IO ()
cTransformMedia :: (ByteString -> ByteString -> ExceptT String IO ByteString) -> CString -> Ptr Word8 -> CInt -> IO CString
cTransformMedia f cKey cFrame cFrameLen = do
key <- B.packCString cKey
frame <- getByteString cFrame cFrameLen
frame' <- f key frame
putByteString frame' cFrame cFrameLen
frame <- getFrame
runExceptT (f key frame >>= liftIO . putFrame) >>= newCAString . fromLeft ""
where
getFrame = do
fp <- newForeignPtr_ cFrame
pure $ PS fp 0 $ fromIntegral cFrameLen
putFrame bs@(PS fp offset _) = do
let len = B.length bs
p = unsafeForeignPtrToPtr fp `plusPtr` offset
when (len <= fromIntegral cFrameLen) $ memcpy cFrame p len
{-# INLINE cTransformMedia #-}
chatEncryptMedia :: ByteString -> ByteString -> IO ByteString
chatEncryptMedia keyStr frame = fromRight frame <$> encrypt
where
encrypt = runExceptT $ do
key <- liftEither $ U.decode keyStr
iv <- liftIO $ getRandomBytes ivSize
let (frame', _) = B.splitAt (B.length frame - C.authTagSize - ivSize) frame
(tag, frame'') <- withExceptT show $ C.encryptAESNoPad (C.Key key) (C.IV iv) frame'
let authTag = BA.convert $ C.unAuthTag tag
pure $ frame'' <> authTag <> iv
chatEncryptMedia :: ByteString -> ByteString -> ExceptT String IO ByteString
chatEncryptMedia keyStr frame = do
checkFrameLen frame
key <- decodeKey keyStr
iv <- liftIO $ getRandomBytes ivSize
let (frame', _) = B.splitAt (B.length frame - reservedSize) frame
(tag, frame'') <- withExceptT show $ C.encryptAESNoPad key (C.IV $ iv <> ivPad) frame'
let authTag = BA.convert $ C.unAuthTag tag
pure $ frame'' <> authTag <> iv
chatDecryptMedia :: ByteString -> ByteString -> IO ByteString
chatDecryptMedia keyStr frame = fromRight frame <$> decrypt
where
decrypt = runExceptT $ do
key <- liftEither $ U.decode keyStr
let (rest, iv) = B.splitAt (B.length frame - ivSize) frame
(frame', tag) = B.splitAt (B.length rest - C.authTagSize) rest
authTag = C.AuthTag $ AES.AuthTag $ BA.convert tag
withExceptT show $ C.decryptAESNoPad (C.Key key) (C.IV iv) frame' authTag
chatDecryptMedia :: ByteString -> ByteString -> ExceptT String IO ByteString
chatDecryptMedia keyStr frame = do
checkFrameLen frame
key <- decodeKey keyStr
let (rest, iv) = B.splitAt (B.length frame - ivSize) frame
(frame', tag) = B.splitAt (B.length rest - C.authTagSize) rest
authTag = C.AuthTag $ AES.AuthTag $ BA.convert tag
frame'' <- withExceptT show $ C.decryptAESNoPad key (C.IV $ iv <> ivPad) frame' authTag
pure $ frame'' <> B.replicate reservedSize 0
checkFrameLen :: ByteString -> ExceptT String IO ()
checkFrameLen frame =
when (B.length frame < reservedSize) $ throwError "frame has no [reserved space] IV and/or auth tag"
{-# INLINE checkFrameLen #-}
decodeKey :: ByteString -> ExceptT String IO C.Key
decodeKey = liftEither . bimap ("invalid key: " <>) C.Key . U.decode
{-# INLINE decodeKey #-}
authTagSize :: Int
authTagSize = C.authTagSize
@@ -58,15 +76,9 @@ ivSize :: Int
ivSize = 12
{-# INLINE ivSize #-}
getByteString :: Ptr Word8 -> CInt -> IO ByteString
getByteString p size = do
fp <- newForeignPtr_ p
pure $ PS fp 0 $ fromIntegral size
{-# INLINE getByteString #-}
ivPad :: ByteString
ivPad = B.replicate 4 0
putByteString :: ByteString -> Ptr Word8 -> CInt -> IO ()
putByteString bs@(PS fp offset _) to size = do
let len = B.length bs
p = unsafeForeignPtrToPtr fp `plusPtr` offset
when (len <= fromIntegral size) $ memcpy to p len
{-# INLINE putByteString #-}
reservedSize :: Int
reservedSize = authTagSize + ivSize
{-# INLINE reservedSize #-}