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

apps/ios/SimpleXChat/SimpleX.h

@@ -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 char *chat_encrypt_media(char *key, char *frame, int len);
-extern void chat_decrypt_media(char *key, char *frame, int len);
+extern char *chat_decrypt_media(char *key, char *frame, int len);

src/Simplex/Chat/Mobile.hs

@@ -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

src/Simplex/Chat/Mobile/WebRTC.hs

@@ -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 <- getFrame
-  frame' <- f key frame
+  runExceptT (f key frame >>= liftIO . putFrame) >>= newCAString . fromLeft ""
-  putByteString frame' cFrame cFrameLen
+  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 :: ByteString -> ByteString -> ExceptT String IO ByteString
-chatEncryptMedia keyStr frame = fromRight frame <$> encrypt
+chatEncryptMedia keyStr frame = do
-  where
+  checkFrameLen frame
-    encrypt = runExceptT $ do
+  key <- decodeKey keyStr
-      key <- liftEither $ U.decode keyStr
+  iv <- liftIO $ getRandomBytes ivSize
-      iv <- liftIO $ getRandomBytes ivSize
+  let (frame', _) = B.splitAt (B.length frame - reservedSize) frame
-      let (frame', _) = B.splitAt (B.length frame - C.authTagSize - ivSize) frame
+  (tag, frame'') <- withExceptT show $ C.encryptAESNoPad key (C.IV $ iv <> ivPad) frame'
-      (tag, frame'') <- withExceptT show $ C.encryptAESNoPad (C.Key key) (C.IV iv) frame'
+  let authTag = BA.convert $ C.unAuthTag tag
-      let authTag = BA.convert $ C.unAuthTag tag
+  pure $ frame'' <> authTag <> iv
-      pure $ frame'' <> authTag <> iv
 
-chatDecryptMedia :: ByteString -> ByteString -> IO ByteString
+chatDecryptMedia :: ByteString -> ByteString -> ExceptT String IO ByteString
-chatDecryptMedia keyStr frame = fromRight frame <$> decrypt
+chatDecryptMedia keyStr frame = do
-  where
+  checkFrameLen frame
-    decrypt = runExceptT $ do
+  key <- decodeKey keyStr
-      key <- liftEither $ U.decode keyStr
+  let (rest, iv) = B.splitAt (B.length frame - ivSize) frame
-      let (rest, iv) = B.splitAt (B.length frame - ivSize) frame
+      (frame', tag) = B.splitAt (B.length rest - C.authTagSize) rest
-          (frame', tag) = B.splitAt (B.length rest - C.authTagSize) rest
+      authTag = C.AuthTag $ AES.AuthTag $ BA.convert tag
-          authTag = C.AuthTag $ AES.AuthTag $ BA.convert tag
+  frame'' <- withExceptT show $ C.decryptAESNoPad key (C.IV $ iv <> ivPad) frame' authTag
-      withExceptT show $ C.decryptAESNoPad (C.Key key) (C.IV iv) 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
+ivPad :: ByteString
-getByteString p size = do
+ivPad = B.replicate 4 0
-  fp <- newForeignPtr_ p
-  pure $ PS fp 0 $ fromIntegral size
-{-# INLINE getByteString #-}
 
-putByteString :: ByteString -> Ptr Word8 -> CInt -> IO ()
+reservedSize :: Int
-putByteString bs@(PS fp offset _) to size = do
+reservedSize = authTagSize + ivSize
-  let len = B.length bs
+{-# INLINE reservedSize #-}
-      p = unsafeForeignPtrToPtr fp `plusPtr` offset
-  when (len <= fromIntegral size) $ memcpy to p len
-{-# INLINE putByteString #-}

tests/WebRTCTests.hs

@@ -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
+    Right frame' <- runExceptT $ chatEncryptMedia key $ frame <> B.replicate reservedSize '\NUL'
-    frame' <- 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"