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:
parent
5075657c02
commit
a2e5733be6
@ -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);
|
||||
|
@ -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
|
||||
|
@ -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 #-}
|
||||
|
@ -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"
|
||||
|
Loading…
Reference in New Issue
Block a user