core: WebRTC frames encryption (#1942)

* core: WebRTC frames encryption

* test

cabal.project

@@ -7,7 +7,7 @@ constraints: zip +disable-bzip2 +disable-zstd
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/simplexmq.git
-    tag: 44535628a5babefec838ab346546208fbe6501b4
+    tag: a8121fc8add20f4f63ba6ba598e4adbe25c52605
 
 source-repository-package
     type: git

package.yaml

@@ -28,6 +28,7 @@ dependencies:
   - exceptions == 0.10.*
   - filepath == 1.4.*
   - http-types == 0.12.*
+  - memory == 0.15.*
   - mtl == 2.2.*
   - network >= 3.1.2.7 && < 3.2
   - optparse-applicative >= 0.15 && < 0.17

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."44535628a5babefec838ab346546208fbe6501b4" = "16nzpigy10qw4lydm6cg85yzcnflgmlf58sc0c4cwmvr2lw8mfi1";
+  "https://github.com/simplex-chat/simplexmq.git"."a8121fc8add20f4f63ba6ba598e4adbe25c52605" = "08rjzw759iqkfdmdicnqj8aam7r9irnrr6129hz8s3mxz9g7d2jp";
   "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
   "https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd";
   "https://github.com/simplex-chat/sqlcipher-simple.git"."5e154a2aeccc33ead6c243ec07195ab673137221" = "1d1gc5wax4vqg0801ajsmx1sbwvd9y7p7b8mmskvqsmpbwgbh0m0";

simplex-chat.cabal

@@ -120,6 +120,7 @@ library
     , exceptions ==0.10.*
     , filepath ==1.4.*
     , http-types ==0.12.*
+    , memory ==0.15.*
     , mtl ==2.2.*
     , network >=3.1.2.7 && <3.2
     , optparse-applicative >=0.15 && <0.17
@@ -166,6 +167,7 @@ executable simplex-bot
     , exceptions ==0.10.*
     , filepath ==1.4.*
     , http-types ==0.12.*
+    , memory ==0.15.*
     , mtl ==2.2.*
     , network >=3.1.2.7 && <3.2
     , optparse-applicative >=0.15 && <0.17
@@ -213,6 +215,7 @@ executable simplex-bot-advanced
     , exceptions ==0.10.*
     , filepath ==1.4.*
     , http-types ==0.12.*
+    , memory ==0.15.*
     , mtl ==2.2.*
     , network >=3.1.2.7 && <3.2
     , optparse-applicative >=0.15 && <0.17
@@ -261,6 +264,7 @@ executable simplex-broadcast-bot
     , exceptions ==0.10.*
     , filepath ==1.4.*
     , http-types ==0.12.*
+    , memory ==0.15.*
     , mtl ==2.2.*
     , network >=3.1.2.7 && <3.2
     , optparse-applicative >=0.15 && <0.17
@@ -309,6 +313,7 @@ executable simplex-chat
     , exceptions ==0.10.*
     , filepath ==1.4.*
     , http-types ==0.12.*
+    , memory ==0.15.*
     , mtl ==2.2.*
     , network ==3.1.*
     , optparse-applicative >=0.15 && <0.17
@@ -348,6 +353,7 @@ test-suite simplex-chat-test
       MobileTests
       ProtocolTests
       SchemaDump
+      WebRTCTests
       Paths_simplex_chat
   hs-source-dirs:
       tests
@@ -371,6 +377,7 @@ test-suite simplex-chat-test
     , filepath ==1.4.*
     , hspec ==2.7.*
     , http-types ==0.12.*
+    , memory ==0.15.*
     , mtl ==2.2.*
     , network ==3.1.*
     , optparse-applicative >=0.15 && <0.17

src/Simplex/Chat/Mobile/WebRTC.hs

@@ -1,13 +1,19 @@
 module Simplex.Chat.Mobile.WebRTC where
 
+import Control.Monad.Except
+import qualified Crypto.Cipher.Types as AES
+import Crypto.Random (getRandomBytes)
+import qualified Data.ByteArray as BA
 import qualified Data.ByteString as B
-import Data.ByteString.Internal (ByteString(PS), memcpy)
+import qualified Data.ByteString.Base64.URL as U
+import Data.ByteString.Internal (ByteString (PS), memcpy)
+import Data.Either (fromRight)
+import Data.Word (Word8)
 import Foreign.C (CInt, CString)
-import Foreign.Ptr (Ptr, plusPtr)
 import Foreign.ForeignPtr (newForeignPtr_)
 import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
-import Control.Monad (when)
+import Foreign.Ptr (Ptr, plusPtr)
-import Data.Word (Word8)
+import qualified Simplex.Messaging.Crypto as C
 
 cChatEncryptMedia :: CString -> Ptr Word8 -> CInt -> IO ()
 cChatEncryptMedia = cTransformMedia chatEncryptMedia
@@ -15,19 +21,42 @@ cChatEncryptMedia = cTransformMedia chatEncryptMedia
 cChatDecryptMedia :: CString -> Ptr Word8 -> CInt -> IO ()
 cChatDecryptMedia = cTransformMedia chatDecryptMedia
 
-cTransformMedia :: (ByteString -> ByteString -> ByteString) -> CString -> Ptr Word8 -> CInt -> IO ()
+cTransformMedia :: (ByteString -> ByteString -> IO ByteString) -> CString -> Ptr Word8 -> CInt -> IO ()
 cTransformMedia f cKey cFrame cFrameLen = do
-  key <- B.packCStringLen (cKey, 32)
+  key <- B.packCString cKey
   frame <- getByteString cFrame cFrameLen
-  let frame' = f key frame
+  frame' <- f key frame
   putByteString frame' cFrame cFrameLen
 {-# INLINE cTransformMedia #-}
 
-chatEncryptMedia :: ByteString -> ByteString -> ByteString
+chatEncryptMedia :: ByteString -> ByteString -> IO ByteString
-chatEncryptMedia _key frame = frame
+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
 
-chatDecryptMedia :: ByteString -> ByteString -> ByteString
+chatDecryptMedia :: ByteString -> ByteString -> IO ByteString
-chatDecryptMedia _key frame = frame
+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
+
+authTagSize :: Int
+authTagSize = C.authTagSize
+{-# INLINE authTagSize #-}
+
+ivSize :: Int
+ivSize = 12
+{-# INLINE ivSize #-}
 
 getByteString :: Ptr Word8 -> CInt -> IO ByteString
 getByteString p size = do

stack.yaml

@@ -49,7 +49,7 @@ extra-deps:
   # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
   # - ../simplexmq
   - github: simplex-chat/simplexmq
-    commit: 44535628a5babefec838ab346546208fbe6501b4
+    commit: a8121fc8add20f4f63ba6ba598e4adbe25c52605
   # - ../direct-sqlcipher
   - github: simplex-chat/direct-sqlcipher
     commit: 34309410eb2069b029b8fc1872deb1e0db123294

tests/Test.hs

@@ -8,6 +8,7 @@ import ProtocolTests
 import SchemaDump
 import Test.Hspec
 import UnliftIO.Temporary (withTempDirectory)
+import WebRTCTests
 
 main :: IO ()
 main = do
@@ -15,6 +16,7 @@ main = do
   withGlobalLogging logCfg . hspec $ do
     describe "SimpleX chat markdown" markdownTests
     describe "SimpleX chat protocol" protocolTests
+    describe "WebRTC encryption" webRTCTests
     describe "Schema dump" schemaDumpTest
     around testBracket $ do
       describe "Mobile API Tests" mobileTests

tests/WebRTCTests.hs

@@ -0,0 +1,18 @@
+module WebRTCTests where
+
+import Crypto.Random (getRandomBytes)
+import qualified Data.ByteString.Base64.URL as U
+import qualified Data.ByteString.Char8 as B
+import Simplex.Chat.Mobile.WebRTC
+import Test.Hspec
+
+webRTCTests :: Spec
+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'
+    B.length frame' `shouldBe` B.length frame + reservedSize
+    frame'' <- chatDecryptMedia key frame'
+    frame'' `shouldBe` frame <> B.replicate reservedSize '\NUL'