From 938471451616d72da5ac7b34529fb56fb5ec2988 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Wed, 12 Nov 2025 12:46:54 +0000 Subject: [PATCH] clean up WP encryption --- .../Messaging/Notifications/Protocol.hs | 63 +++++++-------- .../Notifications/Server/Push/APNS.hs | 1 - .../Notifications/Server/Push/WebPush.hs | 80 ++++++++----------- tests/NtfWPTests.hs | 2 +- 4 files changed, 61 insertions(+), 85 deletions(-) diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs index 091e89759..06f644267 100644 --- a/src/Simplex/Messaging/Notifications/Protocol.hs +++ b/src/Simplex/Messaging/Notifications/Protocol.hs @@ -28,7 +28,7 @@ import Data.Maybe (isNothing) import Data.Text.Encoding (decodeLatin1, encodeUtf8) import Data.Time.Clock.System import Data.Type.Equality -import Data.Word (Word16) +import Data.Word (Word16, Word64) import Simplex.Messaging.Agent.Protocol (updateSMPServerHosts) import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..), fromTextField_) import qualified Simplex.Messaging.Crypto as C @@ -39,7 +39,6 @@ import Simplex.Messaging.Protocol hiding (Command (..), CommandTag (..)) import Simplex.Messaging.Util (eitherToMaybe, (<$?>)) import qualified Data.ByteString.Lazy as BL import qualified Data.Binary as Bin -import qualified Crypto.Error as CE import qualified Data.Bits as Bits import Network.HTTP.Client (Request, parseUrlThrow) @@ -546,52 +545,50 @@ data WPKey = WPKey -- | Elliptic-Curve-Point-to-Octet-String Conversion without compression -- | as required by RFC8291 -- | https://www.secg.org/sec1-v2.pdf#subsubsection.2.3.3 -uncompressEncodePoint :: ECC.Point -> BL.ByteString +uncompressEncodePoint :: ECC.Point -> ByteString uncompressEncodePoint (ECC.Point x y) = "\x04" <> encodeBigInt x <> encodeBigInt y uncompressEncodePoint ECC.PointO = "\0" -uncompressDecodePoint :: BL.ByteString -> Either CE.CryptoError ECC.Point +uncompressDecodePoint :: ByteString -> Either String ECC.Point uncompressDecodePoint "\0" = pure ECC.PointO uncompressDecodePoint s - | BL.take 1 s /= prefix = Left CE.CryptoError_PointFormatUnsupported - | BL.length s /= 65 = Left CE.CryptoError_KeySizeInvalid + | B.null s = Left "KeySizeInvalid" + | B.head s /= '\x04' = Left "PointFormatUnsupported" + | B.length s /= 65 = Left "KeySizeInvalid" | otherwise = do - 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 + let s' = B.drop 1 s + x <- decodeBigInt $ B.take 32 s' + y <- decodeBigInt $ B.drop 32 s' + pure $ ECC.Point x y -- Used to test encryption against the RFC8291 Example - which gives the AS private key -uncompressDecodePrivateNumber :: BL.ByteString -> Either CE.CryptoError ECC.PrivateNumber +uncompressDecodePrivateNumber :: ByteString -> Either String ECC.PrivateNumber uncompressDecodePrivateNumber s - | BL.length s /= 32 = Left CE.CryptoError_KeySizeInvalid - | otherwise = do - decodeBigInt s + | B.length s /= 32 = Left "KeySizeInvalid" + | otherwise = decodeBigInt s -uncompressEncode :: WPP256dh -> BL.ByteString +uncompressEncode :: WPP256dh -> ByteString uncompressEncode (WPP256dh p) = uncompressEncodePoint p -uncompressDecode :: BL.ByteString -> Either CE.CryptoError WPP256dh +uncompressDecode :: ByteString -> Either String WPP256dh uncompressDecode bs = WPP256dh <$> uncompressDecodePoint bs -encodeBigInt :: Integer -> BL.ByteString -encodeBigInt i = do +encodeBigInt :: Integer -> ByteString +encodeBigInt i = 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) + in BL.toStrict $ Bin.encode (w64 s3, w64 s2, w64 s1, w64 i) where - w64 :: Integer -> Bin.Word64 + w64 :: Integer -> Word64 w64 = fromIntegral -decodeBigInt :: BL.ByteString -> Either CE.CryptoError Integer +decodeBigInt :: ByteString -> Either String Integer decodeBigInt s - | BL.length s /= 32 = Left CE.CryptoError_PointSizeInvalid + | B.length s /= 32 = Left "PointSizeInvalid" | otherwise = do - 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 + let (w3, w2, w1, w0) = Bin.decode (BL.fromStrict s) :: (Word64, Word64, Word64, Word64) + in Right $ shift 3 w3 + shift 2 w2 + shift 1 w1 + fromIntegral w0 where shift i w = Bits.shiftL (fromIntegral w) (64 * i) @@ -610,18 +607,12 @@ instance StrEncoding WPAuth where strP = toWPAuth <$?> strP instance Encoding WPP256dh where - smpEncode p = smpEncode . BL.toStrict $ uncompressEncode p - smpP = smpP >>= \bs -> - case uncompressDecode (BL.fromStrict bs) of - Left _ -> fail "Invalid p256dh key" - Right res -> pure res + smpEncode p = smpEncode $ uncompressEncode p + smpP = uncompressDecode <$?> smpP instance StrEncoding WPP256dh where - strEncode p = strEncode . BL.toStrict $ uncompressEncode p - strP = strP >>= \bs -> - case uncompressDecode (BL.fromStrict bs) of - Left _ -> fail "Invalid p256dh key" - Right res -> pure res + strEncode p = strEncode $ uncompressEncode p + strP = uncompressDecode <$?> strP instance Encoding WPKey where smpEncode WPKey {wpAuth, wpP256dh} = smpEncode (wpAuth, wpP256dh) diff --git a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs index f4901b46f..f25f977f5 100644 --- a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs +++ b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs @@ -257,7 +257,6 @@ data APNSErrorResponse = APNSErrorResponse {reason :: Text} $(JQ.deriveFromJSON defaultJSON ''APNSErrorResponse) --- TODO [webpush] change type accept token components so it only allows APNS token apnsPushProviderClient :: APNSPushClient -> PushProviderClient 'APNS apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn (APNSDeviceToken _ tknStr) pn = do http2 <- liftHTTPS2 $ getApnsHTTP2Client c diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs index 078458d99..f756a0e14 100644 --- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs +++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs @@ -10,37 +10,37 @@ 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 (..), PushType (..), WPAuth (..), WPKey (..), WPTokenParams (..), WPP256dh (..), uncompressEncodePoint, wpRequest) -import Simplex.Messaging.Notifications.Server.Push -import Control.Monad.Except +import Control.Exception (SomeException, fromException, try) import Control.Logger.Simple (logDebug) -import Simplex.Messaging.Util (tshow) -import qualified Data.ByteString.Char8 as B +import Control.Monad +import Control.Monad.Except import Control.Monad.IO.Class (liftIO) -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.ByteArray as BA -import qualified Data.ByteString.Lazy as BL -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.MAC.HMAC as HMAC import qualified Crypto.PubKey.ECC.DH as ECDH import qualified Crypto.PubKey.ECC.Types as ECC +import Crypto.Random (MonadRandom(getRandomBytes)) +import Data.Aeson ((.=)) +import qualified Data.Aeson as J +import qualified Data.Binary as Bin +import qualified Data.ByteArray as BA +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy as BL +import Network.HTTP.Client +import qualified Network.HTTP.Types as N +import qualified Simplex.Messaging.Crypto as C +import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), PushType (..), WPAuth (..), WPKey (..), WPTokenParams (..), WPP256dh (..), uncompressEncodePoint, wpRequest) +import Simplex.Messaging.Notifications.Server.Push +import Simplex.Messaging.Util (liftError', tshow) wpPushProviderClient :: Manager -> PushProviderClient 'WebPush wpPushProviderClient mg _ t@(WPDeviceToken _ params) pn = do -- TODO [webpush] this function should accept type that is restricted to WP token (so, possibly WPProvider and WPTokenParams) -- parsing will happen in DeviceToken parser, so it won't fail here r <- wpRequest t - logDebug $ "Request to " <> tshow (host r) - encBody <- body + logDebug $ "Web Push request to " <> tshow (host r) + encBody <- withExceptT PPCryptoError $ wpEncrypt (wpKey params) (BL.toStrict $ encodeWPN pn) let requestHeaders = [ ("TTL", "2592000"), -- 30 days ("Urgency", "high"), @@ -54,55 +54,47 @@ wpPushProviderClient mg _ t@(WPDeviceToken _ params) pn = do requestBody = RequestBodyBS encBody, redirectCount = 0 } - _ <- liftPPWPError $ httpNoBody req mg - pure () - where - body :: ExceptT PushProviderError IO B.ByteString - body = withExceptT PPCryptoError $ wpEncrypt (wpKey params) (BL.toStrict $ encodeWPN pn) + void $ liftError' toPPWPError $ try $ httpNoBody req mg -- | encrypt :: UA key -> clear -> cipher -- | https://www.rfc-editor.org/rfc/rfc8291#section-3.4 -wpEncrypt :: WPKey -> B.ByteString -> ExceptT C.CryptoError IO B.ByteString +wpEncrypt :: WPKey -> ByteString -> ExceptT C.CryptoError IO ByteString wpEncrypt wpKey clearT = do - salt :: B.ByteString <- liftIO $ getRandomBytes 16 + salt :: ByteString <- liftIO $ getRandomBytes 16 asPrivK <- liftIO $ ECDH.generatePrivate $ ECC.getCurveByName ECC.SEC_p256r1 wpEncrypt' wpKey asPrivK salt clearT -- | encrypt :: UA key -> AS key -> salt -> clear -> cipher -- | https://www.rfc-editor.org/rfc/rfc8291#section-3.4 -wpEncrypt' :: WPKey -> ECC.PrivateNumber -> B.ByteString -> B.ByteString -> ExceptT C.CryptoError IO B.ByteString +wpEncrypt' :: WPKey -> ECC.PrivateNumber -> ByteString -> ByteString -> ExceptT C.CryptoError IO ByteString wpEncrypt' WPKey {wpAuth, wpP256dh = WPP256dh uaPubK} asPrivK salt clearT = do - let uaPubKS = BL.toStrict . uncompressEncodePoint $ uaPubK - let asPubKS = BL.toStrict . uncompressEncodePoint . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) $ asPrivK + let uaPubKS = uncompressEncodePoint $ uaPubK + let asPubKS = uncompressEncodePoint . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) $ asPrivK ecdhSecret = ECDH.getShared (ECC.getCurveByName ECC.SEC_p256r1) asPrivK uaPubK prkKey = hmac (unWPAuth wpAuth) ecdhSecret keyInfo = "WebPush: info\0" <> uaPubKS <> asPubKS 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") + cekInfo = "Content-Encoding: aes128gcm\0" :: ByteString + cek = B.take 16 $ BA.convert $ hmac prk (cekInfo <> "\x01") + nonceInfo = "Content-Encoding: nonce\0" :: ByteString + nonce = B.take 12 $ BA.convert $ 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 <> asPubKS 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" + (C.AuthTag tag, cipherT) <- C.encryptAES128NoPad (C.Key cek) iv $ clearT <> "\x02" -- Uncomment to see intermediate values, to compare with RFC8291 example - -- liftIO . print $ strEncode (BA.convert ecdhSecret :: B.ByteString) + -- liftIO . print $ strEncode (BA.convert ecdhSecret :: ByteString) -- liftIO . print . strEncode $ takeHM 32 prkKey -- liftIO . print $ strEncode cek -- liftIO . print $ strEncode cipherT pure $ header <> cipherT <> BA.convert tag where 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 + ivFrom :: ByteString -> ExceptT C.CryptoError IO C.GCMIV + ivFrom s = liftEither $ C.gcmIV s encodeWPN :: PushNotification -> BL.ByteString encodeWPN pn = J.encode $ case pn of @@ -113,12 +105,6 @@ encodeWPN pn = J.encode $ case pn of PNMessage _ -> J.object ["checkMessages" .= True] PNCheckMessages -> J.object ["checkMessages" .= True] -liftPPWPError :: IO a -> ExceptT PushProviderError IO a -liftPPWPError = liftPPWPError' toPPWPError - -liftPPWPError' :: (SomeException -> PushProviderError) -> IO a -> ExceptT PushProviderError IO a -liftPPWPError' err a = liftIO (try @SomeException a) >>= either (throwError . err) return - toPPWPError :: SomeException -> PushProviderError toPPWPError e = case fromException e of Just (InvalidUrlException _ _) -> PPWPInvalidUrl diff --git a/tests/NtfWPTests.hs b/tests/NtfWPTests.hs index 7bcd1e03b..5d30d3b57 100644 --- a/tests/NtfWPTests.hs +++ b/tests/NtfWPTests.hs @@ -64,7 +64,7 @@ testWPEncryption = do let clearT :: B.ByteString = "When I grow up, I want to be a watermelon" let pParams :: WPTokenParams = either error id $ strDecode "/push/JzLQ3raZJfFBR0aqvOMsLrt54w4rJUsV BTBZMqHH6r4Tts7J_aSIgg BCVxsr7N_eNgVRqvHtD0zTZsEc6-VV-JvLexhqUzORcxaOzi6-AYWXvTBHm4bjyPjs7Vd8pZGH6SRpkNtoIAiw4" let salt :: B.ByteString = either error id $ strDecode "DGv6ra1nlYgDCS1FRnbzlw" - let privBS :: BL.ByteString = either error BL.fromStrict $ strDecode "yfWPiYE-n46HLnH0KqZOF1fJJU3MYrct3AELtAQ-oRw" + let privBS :: B.ByteString = either error id $ strDecode "yfWPiYE-n46HLnH0KqZOF1fJJU3MYrct3AELtAQ-oRw" asPriv :: ECC.PrivateNumber <- case uncompressDecodePrivateNumber privBS of Left e -> fail $ "Cannot decode PrivateNumber from b64 " <> show e Right p -> pure p