From 720fb40a861157c81afd4b9997b36fc899746679 Mon Sep 17 00:00:00 2001 From: sim Date: Fri, 18 Jul 2025 10:17:08 +0200 Subject: [PATCH] Encrypt wp notifications --- simplexmq.cabal | 1 + src/Simplex/Messaging/Crypto.hs | 22 +++- .../Notifications/Server/Push/WebPush.hs | 104 +++++++++++++++++- 3 files changed, 120 insertions(+), 7 deletions(-) diff --git a/simplexmq.cabal b/simplexmq.cabal index 710d6409c..54fb464d3 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -292,6 +292,7 @@ library , attoparsec ==0.14.* , base >=4.14 && <5 , base64-bytestring >=1.0 && <1.3 + , binary ==0.8.* , composition ==1.0.* , constraints >=0.12 && <0.14 , containers ==0.6.* diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs index ed1363b46..a540bd037 100644 --- a/src/Simplex/Messaging/Crypto.hs +++ b/src/Simplex/Messaging/Crypto.hs @@ -127,6 +127,7 @@ module Simplex.Messaging.Crypto encryptAEAD, decryptAEAD, encryptAESNoPad, + encryptAES128NoPad, decryptAESNoPad, authTagSize, randomAesKey, @@ -209,7 +210,7 @@ import Control.Exception (Exception) import Control.Monad import Control.Monad.Except import Control.Monad.Trans.Except -import Crypto.Cipher.AES (AES256) +import Crypto.Cipher.AES (AES256, AES128) import qualified Crypto.Cipher.Types as AES import qualified Crypto.Cipher.XSalsa as XSalsa import qualified Crypto.Error as CE @@ -895,6 +896,8 @@ data CryptoError CERatchetEarlierMessage Word32 | -- | duplicate message number CERatchetDuplicateMessage + | -- | unable to decode ecc key + CryptoInvalidECCKey CE.CryptoError deriving (Eq, Show, Exception) aesKeySize :: Int @@ -1021,11 +1024,22 @@ encryptAESNoPad :: Key -> GCMIV -> ByteString -> ExceptT CryptoError IO (AuthTag encryptAESNoPad key iv = encryptAEADNoPad key iv "" {-# INLINE encryptAESNoPad #-} +-- Used to encrypt WebPush notifications +-- This function requires 12 bytes IV, it does not transform IV. +encryptAES128NoPad :: Key -> GCMIV -> ByteString -> ExceptT CryptoError IO (AuthTag, ByteString) +encryptAES128NoPad key iv = encryptAEAD128NoPad key iv "" +{-# INLINE encryptAES128NoPad #-} + encryptAEADNoPad :: Key -> GCMIV -> ByteString -> ByteString -> ExceptT CryptoError IO (AuthTag, ByteString) encryptAEADNoPad aesKey ivBytes ad msg = do aead <- initAEADGCM aesKey ivBytes pure . first AuthTag $ AES.aeadSimpleEncrypt aead ad msg authTagSize +encryptAEAD128NoPad :: Key -> GCMIV -> ByteString -> ByteString -> ExceptT CryptoError IO (AuthTag, ByteString) +encryptAEAD128NoPad aesKey ivBytes ad msg = do + aead <- initAEAD128GCM aesKey ivBytes + pure . first AuthTag $ AES.aeadSimpleEncrypt aead ad msg authTagSize + -- | AEAD-GCM decryption with associated data. -- -- Used as part of double ratchet encryption. @@ -1125,6 +1139,12 @@ initAEADGCM (Key aesKey) (GCMIV ivBytes) = cryptoFailable $ do cipher <- AES.cipherInit aesKey AES.aeadInit AES.AEAD_GCM cipher ivBytes +-- this function requires 12 bytes IV, it does not transforms IV. +initAEAD128GCM :: Key -> GCMIV -> ExceptT CryptoError IO (AES.AEAD AES128) +initAEAD128GCM (Key aesKey) (GCMIV ivBytes) = cryptoFailable $ do + cipher <- AES.cipherInit aesKey + AES.aeadInit AES.AEAD_GCM cipher ivBytes + -- | Random AES256 key. randomAesKey :: TVar ChaChaDRG -> STM Key randomAesKey = fmap Key . randomBytes aesKeySize diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs index bdb2745a6..51e571df3 100644 --- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs +++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs @@ -9,10 +9,12 @@ {-# HLINT ignore "Use newtype instead of data" #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} module Simplex.Messaging.Notifications.Server.Push.WebPush where import Network.HTTP.Client +import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Notifications.Protocol (DeviceToken (WPDeviceToken), WPEndpoint (..), encodePNMessages, PNMessageData) import Simplex.Messaging.Notifications.Server.Store.Types import Simplex.Messaging.Notifications.Server.Push @@ -25,36 +27,126 @@ import Control.Exception ( fromException, SomeException, try ) import qualified Network.HTTP.Types as N import qualified Data.Aeson as J import Data.Aeson ((.=)) +import qualified Data.Binary as Bin +import qualified Data.Bits as Bits +import qualified Data.ByteArray as BA import qualified Data.ByteString.Lazy as BL import Data.List.NonEmpty (NonEmpty) import qualified Data.Text.Encoding as T import qualified Data.Text as T +import Control.Monad.Trans.Except (throwE) +import Crypto.Hash.Algorithms (SHA256) +import Crypto.Random (MonadRandom(getRandomBytes)) +import qualified Crypto.Cipher.Types as CT +import qualified Crypto.Error as CE +import qualified Crypto.MAC.HMAC as HMAC +import qualified Crypto.PubKey.ECC.DH as ECDH +import qualified Crypto.PubKey.ECC.Types as ECC +import GHC.Base (when) wpPushProviderClient :: Manager -> PushProviderClient wpPushProviderClient mg tkn pn = do - e <- B.unpack <$> endpoint tkn - r <- liftPPWPError $ parseUrlThrow e + e <- endpoint tkn + r <- liftPPWPError $ parseUrlThrow $ B.unpack e.endpoint logDebug $ "Request to " <> tshow r.host + encBody <- body e let requestHeaders = [ ("TTL", "2592000") -- 30 days , ("Urgency", "High") , ("Content-Encoding", "aes128gcm") -- TODO: topic for pings and interval ] - let req = r { + req = r { method = "POST" , requestHeaders - , requestBody = RequestBodyLBS $ encodePN pn + , requestBody = RequestBodyBS encBody , redirectCount = 0 } _ <- liftPPWPError $ httpNoBody req mg pure () where - endpoint :: NtfTknRec -> ExceptT PushProviderError IO B.ByteString + endpoint :: NtfTknRec -> ExceptT PushProviderError IO WPEndpoint endpoint NtfTknRec {token} = do case token of - WPDeviceToken WPEndpoint{ endpoint = e } -> pure e + WPDeviceToken e -> pure e _ -> fail "Wrong device token" + -- TODO: move to PPIndalidPusher ? WPEndpoint should be invalidated and removed if the key is invalid, but the validation key is never sent + body :: WPEndpoint -> ExceptT PushProviderError IO B.ByteString + body e = withExceptT PPCryptoError $ wpEncrypt e.auth e.p256dh (BL.toStrict $ encodePN pn) + +-- | encrypt :: auth -> key -> clear -> cipher +-- | https://www.rfc-editor.org/rfc/rfc8291#section-3.4 +wpEncrypt :: B.ByteString -> B.ByteString -> B.ByteString -> ExceptT C.CryptoError IO B.ByteString +wpEncrypt auth uaPubKS clearT = do + salt :: B.ByteString <- liftIO $ getRandomBytes 16 + asPrivK <- liftIO $ ECDH.generatePrivate $ ECC.getCurveByName ECC.SEC_p256r1 + uaPubK <- point uaPubKS + let asPubK = BL.toStrict . uncompressEncode . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) $ asPrivK + ecdhSecret = ECDH.getShared (ECC.getCurveByName ECC.SEC_p256r1) asPrivK uaPubK + prkKey = hmac auth ecdhSecret + keyInfo = "WebPush: info\0" <> uaPubKS <> asPubK + ikm = hmac prkKey (keyInfo <> "\x01") + prk = hmac salt ikm + cekInfo = "Content-Encoding: aes128gcm\0" :: B.ByteString + cek = takeHM 16 $ hmac prk (cekInfo <> "\x01") + nonceInfo = "Content-Encoding: nonce\0" :: B.ByteString + nonce = takeHM 12 $ hmac prk (nonceInfo <> "\x01") + rs = BL.toStrict $ Bin.encode (4096 :: Bin.Word32) -- with RFC8291, it's ok to always use 4096 because there is only one single record and the final record can be smaller than rs (RFC8188) + idlen = BL.toStrict $ Bin.encode (65 :: Bin.Word8) -- with RFC8291, keyid is the pubkey, so always 65 bytes + header = salt <> rs <> idlen <> asPubK + iv <- ivFrom nonce + -- The last record uses a padding delimiter octet set to the value 0x02 + (C.AuthTag (CT.AuthTag tag), cipherT) <- C.encryptAES128NoPad (C.Key cek) iv $ clearT <> "\x02" + pure $ header <> cipherT <> BA.convert tag + where + point :: B.ByteString -> ExceptT C.CryptoError IO ECC.Point + point s = withExceptT C.CryptoInvalidECCKey $ uncompressDecode $ BL.fromStrict s + hmac k v = HMAC.hmac k v :: HMAC.HMAC SHA256 + takeHM :: Int -> HMAC.HMAC SHA256 -> B.ByteString + takeHM n v = BL.toStrict $ BL.pack $ take n $ BA.unpack v + ivFrom :: B.ByteString -> ExceptT C.CryptoError IO C.GCMIV + ivFrom s = case C.gcmIV s of + Left e -> throwE e + Right iv -> pure iv + +-- | Elliptic-Curve-Point-to-Octet-String Conversion without compression +-- | as required by RFC8291 +-- | https://www.secg.org/sec1-v2.pdf#subsubsection.2.3.3 +uncompressEncode :: ECC.Point -> BL.ByteString +uncompressEncode (ECC.Point x y) = "\x04" <> + encodeBigInt x <> + encodeBigInt y +uncompressEncode ECC.PointO = "\0" + +uncompressDecode :: BL.ByteString -> ExceptT CE.CryptoError IO ECC.Point +uncompressDecode "\0" = pure ECC.PointO +uncompressDecode s = do + when (BL.take 1 s /= prefix) $ throwError CE.CryptoError_PointFormatUnsupported + when (BL.length s /= 65) $ throwError CE.CryptoError_KeySizeInvalid + let s' = BL.drop 1 s + x <- decodeBigInt $ BL.take 32 s' + y <- decodeBigInt $ BL.drop 32 s' + pure $ ECC.Point x y + where + prefix = "\x04" :: BL.ByteString + +encodeBigInt :: Integer -> BL.ByteString +encodeBigInt i = do + let s1 = Bits.shiftR i 64 + s2 = Bits.shiftR s1 64 + s3 = Bits.shiftR s2 64 + Bin.encode ( w64 s3, w64 s2, w64 s1, w64 i ) + where + w64 :: Integer -> Bin.Word64 + w64 = fromIntegral + +decodeBigInt :: BL.ByteString -> ExceptT CE.CryptoError IO Integer +decodeBigInt s = do + when (BL.length s /= 32) $ throwError CE.CryptoError_PointSizeInvalid + let (w3, w2, w1, w0) = Bin.decode s :: (Bin.Word64, Bin.Word64, Bin.Word64, Bin.Word64 ) + pure $ shift 3 w3 + shift 2 w2 + shift 1 w1 + shift 0 w0 + where + shift i w = Bits.shiftL (fromIntegral w) (64*i) encodePN :: PushNotification -> BL.ByteString encodePN pn = J.encode $ case pn of