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
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 77 additions and 45 deletions

View File

@ -22,5 +22,5 @@ extern char *chat_recv_msg(chat_ctrl ctl);
extern char *chat_recv_msg_wait(chat_ctrl ctl, int wait);
extern char *chat_parse_markdown(char *str);
extern char *chat_parse_server(char *str);
extern void chat_encrypt_media(char *key, char *frame, int len);
extern void chat_decrypt_media(char *key, char *frame, int len);
extern char *chat_encrypt_media(char *key, char *frame, int len);
extern char *chat_decrypt_media(char *key, char *frame, int len);

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
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 - C.authTagSize - ivSize) frame
(tag, frame'') <- withExceptT show $ C.encryptAESNoPad (C.Key key) (C.IV iv) frame'
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
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
withExceptT show $ C.decryptAESNoPad (C.Key key) (C.IV iv) frame' authTag
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 #-}

View File

@ -1,5 +1,6 @@
module WebRTCTests where
import Control.Monad.Except
import Crypto.Random (getRandomBytes)
import qualified Data.ByteString.Base64.URL as U
import qualified Data.ByteString.Char8 as B
@ -11,8 +12,27 @@ webRTCTests = describe "WebRTC crypto" $ do
it "encrypts and decrypts media" $ do
key <- U.encode <$> getRandomBytes 32
frame <- getRandomBytes 1000
let reservedSize = authTagSize + ivSize
frame' <- chatEncryptMedia key $ frame <> B.replicate reservedSize '\NUL'
Right frame' <- runExceptT $ chatEncryptMedia key $ frame <> B.replicate reservedSize '\NUL'
B.length frame' `shouldBe` B.length frame + reservedSize
frame'' <- chatDecryptMedia key frame'
Right frame'' <- runExceptT $ chatDecryptMedia key frame'
frame'' `shouldBe` frame <> B.replicate reservedSize '\NUL'
it "should fail on invalid frame size" $ do
key <- U.encode <$> getRandomBytes 32
frame <- getRandomBytes 10
runExceptT (chatEncryptMedia key frame) `shouldReturn` Left "frame has no [reserved space] IV and/or auth tag"
runExceptT (chatDecryptMedia key frame) `shouldReturn` Left "frame has no [reserved space] IV and/or auth tag"
it "should fail on invalid key" $ do
let key = B.replicate 32 '#'
frame <- (<> B.replicate reservedSize '\NUL') <$> getRandomBytes 100
runExceptT (chatEncryptMedia key frame) `shouldReturn` Left "invalid key: invalid character at offset: 0"
runExceptT (chatDecryptMedia key frame) `shouldReturn` Left "invalid key: invalid character at offset: 0"
it "should fail on invalid auth tag" $ do
key <- U.encode <$> getRandomBytes 32
frame <- getRandomBytes 1000
Right frame' <- runExceptT $ chatEncryptMedia key $ frame <> B.replicate reservedSize '\NUL'
Right frame'' <- runExceptT $ chatDecryptMedia key frame'
frame'' `shouldBe` frame <> B.replicate reservedSize '\NUL'
let (rest, iv) = B.splitAt (B.length frame' - ivSize) frame
(encFrame, _tag) = B.splitAt (B.length rest - authTagSize) rest
badFrame = encFrame <> B.replicate authTagSize '\NUL' <> iv
runExceptT (chatDecryptMedia key badFrame) `shouldReturn` Left "AESDecryptError"