web-push 0.1.0.0 → 0.1.2.0
raw patch · 6 files changed
+528/−321 lines, 6 filesdep +hspecdep +mtldep +web-pushdep ~basedep ~cryptonitedep ~http-client
Dependencies added: hspec, mtl, web-push
Dependency ranges changed: base, cryptonite, http-client, jose, memory, transformers
Files
- README.md +20/−0
- src/Web/WebPush.hs +103/−312
- src/Web/WebPush/Internal.hs +286/−0
- test/Spec.hs +1/−0
- test/WebPushEncryptionSpec.hs +93/−0
- web-push.cabal +25/−9
README.md view
@@ -1,3 +1,23 @@ # web-push Helper functions to send messages using Web Push protocol.++## Usage++The `sendPushNotification` function encodes the message into Base64 URL form before encrypting and sending. Decode the message in Service Worker notification handler in browser before trying to read the JSON message.++Guides to using Web Push API in browsers can be found on [Mozilla's](https://developer.mozilla.org/en/docs/Web/API/Push_API) and [Google's](https://developers.google.com/web/fundamentals/engage-and-retain/push-notifications/) docs, or you can check out [this](https://gist.github.com/sarthakbagaria/c08c0d7b84e1165760bb429a4064cfff) _untested_ Yesod app demonstrating the use of this library.++## To Do++- Add recognition of more error/status codes from send notification HTTP response.+- Clearly differentiate between ByteString encodings (Raw, Base64URL etc).+- Extend tests to verify that push messages are sent properly.++## References++Current implementation is based on the following versions of the drafts:+- [https://tools.ietf.org/html/draft-ietf-webpush-encryption-04](https://tools.ietf.org/html/draft-ietf-webpush-encryption-04)+- [https://tools.ietf.org/html/draft-ietf-httpbis-encryption-encoding-02](https://tools.ietf.org/html/draft-ietf-httpbis-encryption-encoding-02)+- [https://tools.ietf.org/html/draft-ietf-webpush-protocol-10](https://tools.ietf.org/html/draft-ietf-webpush-protocol-10)+- [https://tools.ietf.org/html/draft-ietf-webpush-vapid-01](https://tools.ietf.org/html/draft-ietf-webpush-vapid-01)
src/Web/WebPush.hs view
@@ -8,71 +8,58 @@ , vapidPublicKeyBytes , sendPushNotification -- * Types- , VAPIDKeys + , VAPIDKeys , VAPIDKeysMinDetails(..) , PushNotificationDetails(..) , PushNotificationMessage(..) , PushNotificationError(..) ) where- -import Data.ByteString (ByteString)-import GHC.Int (Int64)-import qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as C8-import qualified Data.ByteString.Lazy as LB-import Data.Monoid ((<>))-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-import qualified Data.Text.Encoding.Error as TE-import qualified Data.List as L-import qualified Data.HashMap.Strict as HM-import Data.Time.Clock (getCurrentTime) -import Network.HTTP.Client (Manager, httpLbs, parseRequest, HttpException(StatusCodeException), RequestBody(..), requestBody, requestHeaders, method, host, secure)-import Network.HTTP.Types (hContentType, hAuthorization, hContentEncoding)-import Network.HTTP.Types.Status (Status(statusCode)) -import Data.Time (addUTCTime)+import Web.WebPush.Internal +import Crypto.Random (MonadRandom(getRandomBytes)) import qualified Crypto.PubKey.ECC.Types as ECC import qualified Crypto.PubKey.ECC.Generate as ECC import qualified Crypto.PubKey.ECC.ECDSA as ECDSA-import Crypto.Hash.Algorithms (SHA256(..)) import qualified Crypto.PubKey.ECC.DH as ECDH-import qualified Crypto.MAC.HMAC as HMAC-import Crypto.Random (MonadRandom(getRandomBytes))-import Crypto.Cipher.AES (AES128)-import qualified Crypto.Cipher.Types as Cipher-import Crypto.Error (CryptoFailable(CryptoPassed,CryptoFailed), CryptoError) -import Crypto.JWT (createJWSJWT, ClaimsSet(..), NumericDate(..))+import Crypto.JWT (NumericDate(..)) import qualified Crypto.JWT as JWT-import qualified Crypto.JOSE.JWK as JWK-import Crypto.JOSE.JWS (JWSHeader(..), Alg(ES256))-import qualified Crypto.JOSE.Types as JOSE-import qualified Crypto.JOSE.Compact as JOSE.Compact-import qualified Crypto.JOSE.Error as JOSE.Error -import Data.Aeson (ToJSON, toJSON, (.=))+import qualified Data.Bits as Bits+import Data.Word (Word8)++import GHC.Int (Int64)+import qualified Data.List as L+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Encoding.Error as TE+import Data.Monoid ((<>))+import qualified Data.ByteString.Lazy as LB+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as C8 import qualified Data.Aeson as A import qualified Data.ByteString.Base64.URL as B64.URL import qualified Data.ByteString.Base64.URL.Lazy as B64.URL.Lazy -import Data.Word (Word8, Word16, Word64)-import qualified Data.Binary as Binary-import qualified Data.Bits as Bits-import qualified Data.ByteArray as ByteArray -import System.Random (randomRIO)+import Data.Time.Clock (getCurrentTime)+import Data.Time (addUTCTime) +import Network.HTTP.Client (Manager, httpLbs, parseRequest, HttpException(HttpExceptionRequest), HttpExceptionContent(StatusCodeException), RequestBody(..), requestBody, requestHeaders, method, host, secure, responseStatus)+import Network.HTTP.Types (hContentType, hAuthorization, hContentEncoding)+import Network.HTTP.Types.Status (Status(statusCode))++import qualified Crypto.JOSE.Error as JOSE.Error+import Crypto.Error (CryptoError)+ import Control.Exception.Base (SomeException(..), fromException) import Control.Monad.Catch.Pure (runCatchT) import Control.Monad.IO.Class (MonadIO, liftIO) ---type VAPIDKeys = ECDSA.KeyPair+import System.Random (randomRIO) -- |Generate the 3 integers minimally representing a unique pair of public and private keys.@@ -80,6 +67,7 @@ -- Store them in configuration and use them across multiple push notification requests. generateVAPIDKeys :: MonadRandom m => m VAPIDKeysMinDetails generateVAPIDKeys = do+ -- SEC_p256r1 is the NIST P-256 (pubKey, privKey) <- ECC.generate $ ECC.getCurveByName ECC.SEC_p256r1 let ECC.Point pubX pubY = ECDSA.public_q pubKey return $ VAPIDKeysMinDetails { privateNumber = ECDSA.private_d privKey@@ -87,7 +75,7 @@ , publicCoordY = pubY } - + -- |Read VAPID key pair from the 3 integers minimally representing a unique key pair. readVAPIDKeys :: VAPIDKeysMinDetails -> VAPIDKeys readVAPIDKeys VAPIDKeysMinDetails {..} =@@ -95,16 +83,15 @@ in ECDSA.KeyPair (ECC.getCurveByName ECC.SEC_p256r1) vapidPublicKeyPoint privateNumber --- |Pass the VAPID public key bytes to front end when subscribing to push notifications.--- +-- |Pass the VAPID public key bytes to browser when subscribing to push notifications. -- Generate application server key using--- applicationServerKey = new Uint8Array(vapidPublicKeyBytes) in Javascript+-- applicationServerKey = new Uint8Array(vapidPublicKeyBytes) in Javascript. vapidPublicKeyBytes :: VAPIDKeys -> [Word8] vapidPublicKeyBytes keys = let ECC.Point vapidPublicKeyX vapidPublicKeyY = ECDSA.public_q $ ECDSA.toPublicKey keys -- First byte 04 tells that the EC key is uncompressed in 4 : ( (extract32Bytes vapidPublicKeyX) ++ (extract32Bytes vapidPublicKeyY) )- + where -- an array of bytes -- 32 steps (32 bytes)@@ -115,10 +102,16 @@ ([1..32] :: [Int]) +-- References:+-- NOTE: these references are drafts; the current implementation is based on the versions given below.+-- https://tools.ietf.org/html/draft-ietf-webpush-encryption-04+-- https://tools.ietf.org/html/draft-ietf-httpbis-encryption-encoding-02+-- https://tools.ietf.org/html/draft-ietf-webpush-protocol-10+-- https://tools.ietf.org/html/draft-ietf-webpush-vapid-01+ -- |Send a Push Message.------ The message sent is base64 URL encoded.--- Decode the message in notification handler in front end.+-- The message sent is Base64 URL encoded.+-- Decode the message in Service Worker notification handler in browser before trying to read the JSON. sendPushNotification :: MonadIO m => VAPIDKeys -> Manager@@ -127,278 +120,94 @@ sendPushNotification vapidKeys httpManager pushNotification = do eitherInitReq <- runCatchT $ parseRequest $ T.unpack $ endpoint pushNotification case eitherInitReq of- -- delete endpoint if it cannot be parsed Left exc@(SomeException _) -> return $ Left $ EndpointParseFailed exc Right initReq -> do time <- liftIO $ getCurrentTime- - -- JWT encryption for VAPID- eitherJwt <- do- let ECC.Point publicKeyX publicKeyY = ECDSA.public_q $ ECDSA.toPublicKey vapidKeys- privateKeyNumber = ECDSA.private_d $ ECDSA.toPrivateKey vapidKeys-- eitherJwtData <- liftIO $ createJWSJWT (JWK.fromKeyMaterial $ JWK.ECKeyMaterial $- JWK.ECKeyParameters { JWK.ecKty = JWK.EC- , JWK.ecCrv = JWK.P_256- , JWK.ecX = JOSE.SizedBase64Integer 32 $ publicKeyX- , JWK.ecY = JOSE.SizedBase64Integer 32 $ publicKeyY- , JWK.ecD = Just $ JOSE.SizedBase64Integer 32 $ privateKeyNumber- }- )-- ( JWSHeader { headerAlg = Just ES256- , headerJku = Nothing- , headerJwk = Nothing- , headerKid = Nothing- , headerX5u = Nothing- , headerX5c = Nothing- , headerX5t = Nothing- , headerX5tS256 = Nothing- , headerTyp = Just "JWT"- , headerCty = Nothing- , headerCrit = Nothing- }- )-- ( ClaimsSet { _claimIss = Nothing- , _claimSub = Just $ JWT.fromString $ T.append "mailto:" $ senderEmail pushNotification- , _claimAud = Just $ JWT.Special $ JWT.fromString $ TE.decodeUtf8With TE.lenientDecode $- BS.append (if secure initReq then "https://" else "http://") (host initReq)-- , _claimExp = Just $ NumericDate $ addUTCTime 3000 time- , _claimNbf = Nothing- , _claimIat = Nothing- , _claimJti = Nothing- , _unregisteredClaims = HM.empty- }- )-- case eitherJwtData of- Left err -> return $ Left err- Right jwtData -> return $ LB.toStrict <$> (JOSE.Compact.encodeCompact $ jwtData)-- ----------------------------- {-- -- Manual implementation without using the JWT libraries- -- This works as well,- -- kept here mainly to understanding the process-- -- JWT base 64 encoding is without padding- let messageForJWTSignature = let encodedJWTPayload = b64UrlNoPadding $ LB.toStrict $ A.encode $ A.object $- [ "aud" .= (TE.decodeUtf8With TE.lenientDecode $- (if secure initReq then "https://" else "http://") ++ (host initReq)- )- -- jwt expiration time- , "exp" .= (formatTime defaultTimeLocale "%s" $ addUTCTime 3000 time)- , "sub" .= ("mailto: " ++ (senderEmail pushNotification))- ]-- encodedJWTHeader = b64UrlNoPadding $ LB.toStrict $ A.encode $ A.object $- [ "typ" .= ("JWT" :: Text), "alg" .= ("ES256" :: Text) ]-- in encodedJWTHeader <> "." <> encodedJWTPayload-- -- JWT only accepts SHA256 hash with ECDSA for ES256 signed token- encodedJWTSignature <- do- -- ECDSA signing vulnerable to timing attacks- ECDSA.Signature signR signS <- liftIO $ ECDSA.sign (ECDSA.toPrivateKey vapidKeys)- SHA256- messageForJWTSignature-- -- 32 bytes of R followed by 32 bytes of S- return $ b64UrlNoPadding $ LB.toStrict $- (Binary.encode $ int32Bytes signR) <>- (Binary.encode $ int32Bytes signS)-- return $ Right $ messageForJWTSignature <> "." <> encodedJWTSignature- -}- ------------------------------+ eitherJwt <- webPushJWT vapidKeys $ VAPIDClaims { vapidAud = JWT.Audience [ JWT.fromString $ TE.decodeUtf8With TE.lenientDecode $+ BS.append (if secure initReq then "https://" else "http://") (host initReq)+ ]+ , vapidSub = JWT.fromString $ T.append "mailto:" $ senderEmail pushNotification+ , vapidExp = NumericDate $ addUTCTime 3000 time+ } case eitherJwt of Left err -> return $ Left $ JWTGenerationFailed err Right jwt -> do - -- payload encryption- -- https://tools.ietf.org/html/draft-ietf-webpush-encryption-04- -- cek = content encryption key- (cek, nonce, salt, ecdhServerPublicKeyBytes) <- do-- -- first create a new pair of ECDH keys on P-256 curve (SEC_p256r1) and get the sharedSecret- ecdhServerPrivateKey <- liftIO $ ECDH.generatePrivate $ ECC.getCurveByName ECC.SEC_p256r1- salt <- liftIO $ getRandomBytes 16-- let ecdhServerPublicKeyBytes = LB.toStrict $ ecPublicKeyToBytes $- ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) ecdhServerPrivateKey-- ecdhSecretBytes = ECDH.getShared (ECC.getCurveByName ECC.SEC_p256r1) ecdhServerPrivateKey subscriptionPublicKey- authSecretBytes = B64.URL.decodeLenient $ TE.encodeUtf8 $ auth pushNotification-- -- then use HMAC key derivation (HKDF, here expanded into HMAC steps as specified in web push encryption spec)- authInfo = "Content-Encoding: auth" <> "\x00" :: ByteString-- prkCombine = HMAC.hmac authSecretBytes ecdhSecretBytes :: HMAC.HMAC SHA256- ikm = HMAC.hmac prkCombine (authInfo <> "\x01") :: HMAC.HMAC SHA256--- context = "P-256" <> "\x00" <>- "\x00" <> "\x41" <> subscriptionPublicKeyBytes <>- "\x00" <> "\x41" <> ecdhServerPublicKeyBytes-- cekInfo = "Content-Encoding: aesgcm" <> "\x00" <> context-- prk = HMAC.hmac salt ikm :: HMAC.HMAC SHA256- cek = BS.pack $ take 16 $ ByteArray.unpack $ (HMAC.hmac prk (cekInfo <> "\x01") :: HMAC.HMAC SHA256)-- nonceInfo = "Content-Encoding: nonce" <> "\x00" <> context- nonce = BS.pack $ take 12 $ ByteArray.unpack $ (HMAC.hmac prk (nonceInfo <> "\x01") :: HMAC.HMAC SHA256)-- return (cek, nonce, salt, ecdhServerPublicKeyBytes)-- -- padding is required can't skip, add a random length padding (0 - 20 bytes)- -- NOTE: 0 length padding is allowed, it just takes 2 bytes to encode the padding length-- paddedMessage <- do- randLen <- liftIO $ randomRIO (0, 20)-- let plainMessage64Encoded = B64.URL.Lazy.encode $ A.encode $ toJSON $ message pushNotification- paddedMessage = LB.toStrict $ pad randLen plainMessage64Encoded-- return $ paddedMessage-- -- aes_gcm is aead (authenticated encryption with associated data)- -- use cek as the encryption key and nonce as the initialization vector- let eitherAesCipher = Cipher.cipherInit cek :: CryptoFailable AES128- case eitherAesCipher of- CryptoFailed err -> return $ Left $ MessageEncryptionFailed err- CryptoPassed aesCipher -> do- let eitherAeadGcmCipher = Cipher.aeadInit Cipher.AEAD_GCM aesCipher nonce- case eitherAeadGcmCipher of- CryptoFailed err -> return $ Left $ MessageEncryptionFailed err- CryptoPassed aeadGcmCipher -> do-- -- tag length 16 bytes (maximum), anything less than 16 bytes may not be secure enough- -- spec says final encrypted size is 16 bits longer than the padded text- -- NOTE: the final encrypted message must be sent as raw binary data- let encryptedMessage = let (authTag, cipherText) = Cipher.aeadSimpleEncrypt aeadGcmCipher- BS.empty- paddedMessage- 16- in cipherText <> (BS.pack $ ByteArray.unpack $ Cipher.unAuthTag authTag)+ ecdhServerPrivateKey <- liftIO $ ECDH.generatePrivate $ ECC.getCurveByName ECC.SEC_p256r1+ randSalt <- liftIO $ getRandomBytes 16+ padLen <- liftIO $ randomRIO (0, 20) - -- content-length is automtically added before making the http request- postHeaders = let authorizationHeader = "WebPush " <> jwt- cryptoKeyHeader = BS.concat [ "dh=", b64UrlNoPadding ecdhServerPublicKeyBytes- , ";"- -- this base64 should be without padding- -- according to the spec- , "p256ecdsa=", b64UrlNoPadding vapidPublicKeyBytestring- ]+ let authSecretBytes = B64.URL.decodeLenient $ TE.encodeUtf8 $ auth pushNotification+ -- extract the 65 bytes of ECDH uncompressed public key received from browser in subscription+ subscriptionPublicKeyBytes = B64.URL.decodeLenient $ TE.encodeUtf8 $ p256dh pushNotification+ -- encode the message to a safe representation like base64URL before sending it to encryption algorithms+ -- decode the message through service workers on browsers before trying to read the JSON+ plainMessage64Encoded = B64.URL.Lazy.encode $ A.encode $ A.toJSON $ message pushNotification - in [ ("TTL", C8.pack $ show (60*60*(expireInHours pushNotification)))- , (hContentType, "text/plain;charset=utf8")- , (hAuthorization, authorizationHeader)- , ("Crypto-Key", cryptoKeyHeader)- , (hContentEncoding, "aesgcm")- , ("Encryption", "salt=" <> (b64UrlNoPadding salt))- ]+ eitherEncryptionOutput = webPushEncrypt $ EncryptionInput { applicationServerPrivateKey = ecdhServerPrivateKey+ , userAgentPublicKeyBytes = subscriptionPublicKeyBytes+ , authenticationSecret = authSecretBytes+ , salt = randSalt+ , plainText = plainMessage64Encoded+ , paddingLength = padLen+ }+ case eitherEncryptionOutput of+ Left err -> return $ Left $ MessageEncryptionFailed err+ Right encryptionOutput -> do - request = initReq { method = "POST"- , requestHeaders = postHeaders ++- -- avoid duplicates- (filter (\(x, _) -> L.notElem x $ map fst postHeaders)- (requestHeaders initReq)- )- -- the body is encrypted message in raw bytes- -- without URL encoding- , requestBody = RequestBodyBS encryptedMessage- }+ let ecdhServerPublicKeyBytes = LB.toStrict $ ecPublicKeyToBytes $+ ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) $+ ecdhServerPrivateKey+ -- content-length is automtically added before making the http request+ let postHeaders = let authorizationHeader = LB.toStrict $ "WebPush " <> jwt+ cryptoKeyHeader = BS.concat [ "dh=", b64UrlNoPadding ecdhServerPublicKeyBytes+ , ";"+ , "p256ecdsa=", b64UrlNoPadding vapidPublicKeyBytestring+ ]+ in [ ("TTL", C8.pack $ show (60*60*(expireInHours pushNotification)))+ , (hContentType, "application/octet-stream")+ , (hAuthorization, authorizationHeader)+ , ("Crypto-Key", cryptoKeyHeader)+ , (hContentEncoding, "aesgcm")+ , ("Encryption", "salt=" <> (b64UrlNoPadding randSalt))+ ] + request = initReq { method = "POST"+ , requestHeaders = postHeaders +++ -- avoid duplicate headers+ (filter (\(x, _) -> L.notElem x $ map fst postHeaders)+ (requestHeaders initReq)+ )+ -- the body is encrypted message in raw bytes+ -- without URL encoding+ , requestBody = RequestBodyBS $ encryptedMessage encryptionOutput+ } - -- httpLbs from Network.HTTP.Client.Conduit takes manager from the Reader environment- eitherResp <- runCatchT $ liftIO $ httpLbs request httpManager- case eitherResp of- Left err@(SomeException _) -> case fromException err of- Just (StatusCodeException status _ _)- -- when the endpoint is invalid, we need to remove it from database- |(statusCode status == 404) -> return $ Left RecepientEndpointNotFound- _ -> return $ Left $ PushRequestFailed err- Right _ -> return $ Right ()+ eitherResp <- runCatchT $ liftIO $ httpLbs request httpManager+ case eitherResp of+ Left err@(SomeException _) -> case fromException err of+ Just (HttpExceptionRequest _ (StatusCodeException resp _))+ -- when the endpoint is invalid, we need to remove it from database+ |(statusCode (responseStatus resp) == 404) -> return $ Left RecepientEndpointNotFound+ _ -> return $ Left $ PushRequestFailed err+ Right _ -> return $ Right () where vapidPublicKeyBytestring = LB.toStrict $ ecPublicKeyToBytes $ ECDSA.public_q $ ECDSA.toPublicKey vapidKeys - -- points on elliptic curve for 256 bit algorithms are 32 bytes (256 bits) unsigned integers each- -- fixed width big endian format- -- integer to 4 Word64 (8 bytes each)- int32Bytes :: Integer -> Bytes32- int32Bytes number = let shift1 = Bits.shiftR number 64- shift2 = Bits.shiftR shift1 64- shift3 = Bits.shiftR shift2 64- in ( fromIntegral shift3- , fromIntegral shift2- , fromIntegral shift1- , fromIntegral number- ) - bytes32Int :: Bytes32 -> Integer- bytes32Int (d,c,b,a) = (Bits.shiftL (fromIntegral d) (64*3)) +- (Bits.shiftL (fromIntegral c) (64*2)) +- (Bits.shiftL (fromIntegral b) (64 )) +- (fromIntegral a) - -- extract the 65 bytes of ECDH uncompressed public key received from browser in subscription- subscriptionPublicKeyBytes = B64.URL.decodeLenient $ TE.encodeUtf8 $ p256dh pushNotification - -- the first byte is guarenteed to be \x04 which tells that the key is in uncompressed form- subscriptionPublicKey = let bothCoordBytes = BS.drop 1 $ subscriptionPublicKeyBytes- (xBytes, yBytes) = Binary.decode $ LB.fromStrict bothCoordBytes :: (Bytes32, Bytes32)- xInteger = bytes32Int xBytes- yInteger = bytes32Int yBytes- in ECC.Point xInteger yInteger - -- fixed width big endian format- -- First byte 04 tells that the EC key is uncompressed-- {-- -- DON'T use DER encoding to extract integer bytes- -- if a 32 byte number can be written in less bytes with leading zeros,- -- DER encdoing will be shorter than 32 bytes- -- and decoding to 4 word64 will fail because of short input- -}-- ecPublicKeyToBytes :: ECC.Point -> LB.ByteString- -- Point0 is the point at infinity, not sure what's the encoding for that- -- CHECK THIS- ecPublicKeyToBytes ECC.PointO = "\x04" <>- (Binary.encode $ int32Bytes 0) <>- (Binary.encode $ int32Bytes 0)- ecPublicKeyToBytes (ECC.Point x y) = "\x04" <>- (Binary.encode $ int32Bytes x) <>- (Binary.encode $ int32Bytes y)--- -- padding: scheme- -- the first 2 bytes (16bits) represent length of padding- -- followed by that many null bytes- -- padding is added at the beginning of the message- pad :: Int64 -> LB.ByteString -> LB.ByteString- pad len message = (Binary.encode (fromIntegral len :: Word16)) <> (LB.replicate len (0 :: Word8)) <> message-- b64UrlNoPadding = fst . BS.breakSubstring "=" . B64.URL.encode--- -- |Web push subscription and message details. -- -- Get subscription details from front end using -- subscription.endpoint, -- subscription.toJSON().keys.p256dh and -- subscription.toJSON().keys.auth.--- -- Save subscription details to send messages to the endpoint in future. data PushNotificationDetails = PushNotificationDetails { endpoint :: Text , p256dh :: Text@@ -407,37 +216,19 @@ , expireInHours :: Int64 , message :: PushNotificationMessage }- -data PushNotificationMessage = PushNotificationMessage { title :: Text- , body :: Text- , icon :: Text- , url :: Text- , tag :: Text- }- -instance ToJSON PushNotificationMessage where- toJSON PushNotificationMessage {..} = A.object- [ "title" .= title- , "body" .= body- , "icon" .= icon- , "url" .= url- , "tag" .= tag- ] - -- |3 integers minimally representing a unique VAPID key pair. data VAPIDKeysMinDetails = VAPIDKeysMinDetails { privateNumber :: Integer , publicCoordX :: Integer , publicCoordY :: Integer } -+-- |'RecepientEndpointNotFound' comes up when the endpoint is no longer recognized by the push service.+-- This may happen if the user has cancelled the push subscription, and hence deleted the endpoint.+-- You may want to delete the endpoint from database in this case. data PushNotificationError = EndpointParseFailed SomeException | JWTGenerationFailed JOSE.Error.Error | MessageEncryptionFailed CryptoError | RecepientEndpointNotFound | PushRequestFailed SomeException---type Bytes32 = (Word64, Word64, Word64, Word64)
+ src/Web/WebPush/Internal.hs view
@@ -0,0 +1,286 @@+{-# LANGUAGE RecordWildCards, OverloadedStrings #-}++module Web.WebPush.Internal where++import GHC.Int (Int64)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LB+import Data.Monoid ((<>))+import Data.Text (Text)+import qualified Data.HashMap.Strict as HM+++import qualified Crypto.PubKey.ECC.Types as ECC+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA+import Crypto.Hash.Algorithms (SHA256(..))+import qualified Crypto.PubKey.ECC.DH as ECDH+import qualified Crypto.MAC.HMAC as HMAC+import Crypto.Cipher.AES (AES128)+import qualified Crypto.Cipher.Types as Cipher+import Crypto.Error (CryptoFailable(CryptoPassed,CryptoFailed), CryptoError)++import Crypto.JWT (createJWSJWT, ClaimsSet(..))+import qualified Crypto.JWT as JWT+import qualified Crypto.JOSE.JWK as JWK+import Crypto.JOSE.JWS (JWSHeader(..), Alg(ES256))+import qualified Crypto.JOSE.Header as JOSE.Header+import qualified Crypto.JOSE.Types as JOSE+import qualified Crypto.JOSE.Compact as JOSE.Compact+import qualified Crypto.JOSE.Error as JOSE.Error++import Data.Aeson (ToJSON, toJSON, (.=))+import qualified Data.Aeson as A+import qualified Data.ByteString.Base64.URL as B64.URL++import Data.Word (Word8, Word16, Word64)+import qualified Data.Binary as Binary+import qualified Data.Bits as Bits+import qualified Data.ByteArray as ByteArray++import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Except (runExceptT)++++type VAPIDKeys = ECDSA.KeyPair++data VAPIDClaims = VAPIDClaims { vapidAud :: JWT.Audience+ , vapidSub :: JWT.StringOrURI+ , vapidExp :: JWT.NumericDate+ }+-- JSON Web Token for VAPID+webPushJWT :: MonadIO m => VAPIDKeys -> VAPIDClaims -> m (Either (JOSE.Error.Error) LB.ByteString)+webPushJWT vapidKeys vapidClaims = do+ let ECC.Point publicKeyX publicKeyY = ECDSA.public_q $ ECDSA.toPublicKey vapidKeys+ privateKeyNumber = ECDSA.private_d $ ECDSA.toPrivateKey vapidKeys++ liftIO $ runExceptT $ do+ jwtData <- createJWSJWT ( JWK.fromKeyMaterial $ JWK.ECKeyMaterial $+ JWK.ECKeyParameters { JWK.ecKty = JWK.EC+ , JWK.ecCrv = JWK.P_256+ , JWK.ecX = JOSE.SizedBase64Integer 32 $ publicKeyX+ , JWK.ecY = JOSE.SizedBase64Integer 32 $ publicKeyY+ , JWK.ecD = Just $ JOSE.SizedBase64Integer 32 $ privateKeyNumber+ }+ )+ ( JWSHeader { _jwsHeaderAlg = JOSE.Header.HeaderParam JOSE.Header.Protected ES256+ , _jwsHeaderJku = Nothing+ , _jwsHeaderJwk = Nothing+ , _jwsHeaderKid = Nothing+ , _jwsHeaderX5u = Nothing+ , _jwsHeaderX5c = Nothing+ , _jwsHeaderX5t = Nothing+ , _jwsHeaderX5tS256 = Nothing+ , _jwsHeaderTyp = Just (JOSE.Header.HeaderParam JOSE.Header.Protected "JWT")+ , _jwsHeaderCty = Nothing+ , _jwsHeaderCrit = Nothing+ }+ )+ ( ClaimsSet { _claimIss = Nothing+ , _claimSub = Just $ vapidSub $ vapidClaims+ , _claimAud = Just $ vapidAud $ vapidClaims+ , _claimExp = Just $ vapidExp $ vapidClaims+ , _claimNbf = Nothing+ , _claimIat = Nothing+ , _claimJti = Nothing+ , _unregisteredClaims = HM.empty+ }+ )++ JOSE.Compact.encodeCompact $ jwtData++ ----------------------------+ {-+ -- Manual implementation without using the JWT libraries.+ -- This works as well.+ -- Kept here mainly as process explanation.++ -- JWT base 64 encoding is without padding+ let messageForJWTSignature = let encodedJWTPayload = b64UrlNoPadding $ LB.toStrict $ A.encode $ A.object $+ [ "aud" .= (TE.decodeUtf8With TE.lenientDecode $+ (if secure initReq then "https://" else "http://") ++ (host initReq)+ )+ -- jwt expiration time+ , "exp" .= (formatTime defaultTimeLocale "%s" $ addUTCTime 3000 time)+ , "sub" .= ("mailto: " ++ (senderEmail pushNotification))+ ]++ encodedJWTHeader = b64UrlNoPadding $ LB.toStrict $ A.encode $ A.object $+ [ "typ" .= ("JWT" :: Text), "alg" .= ("ES256" :: Text) ]++ in encodedJWTHeader <> "." <> encodedJWTPayload++ -- JWT only accepts SHA256 hash with ECDSA for ES256 signed token+ encodedJWTSignature <- do+ -- ECDSA signing vulnerable to timing attacks+ ECDSA.Signature signR signS <- liftIO $ ECDSA.sign (ECDSA.toPrivateKey vapidKeys)+ SHA256+ messageForJWTSignature++ -- 32 bytes of R followed by 32 bytes of S+ return $ b64UrlNoPadding $ LB.toStrict $+ (Binary.encode $ int32Bytes signR) <>+ (Binary.encode $ int32Bytes signS)++ return $ Right $ messageForJWTSignature <> "." <> encodedJWTSignature+ -}+ ----------------------------++++data PushNotificationMessage = PushNotificationMessage { title :: Text+ , body :: Text+ , icon :: Text+ , url :: Text+ , tag :: Text+ }++instance ToJSON PushNotificationMessage where+ toJSON PushNotificationMessage {..} = A.object+ [ "title" .= title+ , "body" .= body+ , "icon" .= icon+ , "url" .= url+ , "tag" .= tag+ ]++-- All inputs are in raw bytes with no encoding+-- except for the plaintext for which raw bytes are the Base 64 encoded bytes+data WebPushEncryptionInput = EncryptionInput { applicationServerPrivateKey :: ECDH.PrivateNumber+ , userAgentPublicKeyBytes :: ByteString+ , authenticationSecret :: ByteString+ , salt :: ByteString+ , plainText :: LB.ByteString+ , paddingLength :: Int64+ }++-- Intermediate encryption output used in tests+-- All in raw bytes+data WebPushEncryptionOutput = EncryptionOutput { sharedECDHSecretBytes :: ByteString+ , inputKeyingMaterialBytes :: ByteString+ , contentEncryptionKeyContext :: ByteString+ , contentEncryptionKey :: ByteString+ , nonceContext :: ByteString+ , nonce :: ByteString+ , paddedPlainText :: ByteString+ , encryptedMessage :: ByteString+ }++-- payload encryption+-- https://tools.ietf.org/html/draft-ietf-webpush-encryption-04+webPushEncrypt :: WebPushEncryptionInput -> Either CryptoError WebPushEncryptionOutput+webPushEncrypt EncryptionInput {..} =+ let applicationServerPublicKeyBytes = LB.toStrict $ ecPublicKeyToBytes $+ ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) $+ applicationServerPrivateKey+ userAgentPublicKey = ecBytesToPublicKey userAgentPublicKeyBytes+ sharedECDHSecret = ECDH.getShared (ECC.getCurveByName ECC.SEC_p256r1) applicationServerPrivateKey userAgentPublicKey+++ -- HMAC key derivation (HKDF, here expanded into HMAC steps as specified in web push encryption spec)+ pseudoRandomKeyCombine = HMAC.hmac authenticationSecret sharedECDHSecret :: HMAC.HMAC SHA256+ authInfo = "Content-Encoding: auth" <> "\x00" :: ByteString+ inputKeyingMaterial = HMAC.hmac pseudoRandomKeyCombine (authInfo <> "\x01") :: HMAC.HMAC SHA256++ context = "P-256" <> "\x00" <>+ "\x00" <> "\x41" <> userAgentPublicKeyBytes <>+ "\x00" <> "\x41" <> applicationServerPublicKeyBytes++ pseudoRandomKeyEncryption = HMAC.hmac salt inputKeyingMaterial :: HMAC.HMAC SHA256+ contentEncryptionKeyContext = "Content-Encoding: aesgcm" <> "\x00" <> context+ contentEncryptionKey = BS.pack $ take 16 $ ByteArray.unpack (HMAC.hmac pseudoRandomKeyEncryption (contentEncryptionKeyContext <> "\x01") :: HMAC.HMAC SHA256)++ nonceContext = "Content-Encoding: nonce" <> "\x00" <> context+ nonce = BS.pack $ take 12 $ ByteArray.unpack (HMAC.hmac pseudoRandomKeyEncryption (nonceContext <> "\x01") :: HMAC.HMAC SHA256)+++ -- HMAC a doesn't have Show instance needed for test suite+ -- so we extract the bytes and store that in WebPushEncryptionOutput+ inputKeyingMaterialBytes = ByteArray.convert inputKeyingMaterial+ sharedECDHSecretBytes = ByteArray.convert sharedECDHSecret++ -- padding length encoded in 2 bytes, followed by+ -- padding length times '0' byte, followed by+ -- message+ paddedPlainText = LB.toStrict $+ (Binary.encode (fromIntegral paddingLength :: Word16)) <>+ (LB.replicate paddingLength (0 :: Word8)) <>+ plainText++ -- aes_gcm is aead (authenticated encryption with associated data)+ -- use cek as the encryption key and nonce as the initialization vector+ eitherAesCipher = Cipher.cipherInit contentEncryptionKey :: CryptoFailable AES128+ in case eitherAesCipher of+ CryptoFailed err -> Left err+ CryptoPassed aesCipher ->+ let eitherAeadGcmCipher = Cipher.aeadInit Cipher.AEAD_GCM aesCipher nonce+ in case eitherAeadGcmCipher of+ CryptoFailed err -> Left err+ CryptoPassed aeadGcmCipher ->+ -- tag length 16 bytes (maximum), anything less than 16 bytes may not be secure enough+ -- spec says final encrypted size is 16 bits longer than the padded text+ -- NOTE: the final encrypted message must be sent as raw binary data+ let encryptedMessage = let (authTagBytes, cipherText) = Cipher.aeadSimpleEncrypt aeadGcmCipher+ BS.empty+ paddedPlainText+ 16+ authTag = ByteArray.convert $ Cipher.unAuthTag authTagBytes+ in cipherText <> authTag++ in Right $ EncryptionOutput {..}++++-- Conversions among integers and bytes+-- The bytes are in network/big endian order.++ {-+ -- DON'T use DER encoding to extract integer bytes+ -- if a 32 byte number can be written in less bytes with leading zeros,+ -- DER encdoing will be shorter than 32 bytes+ -- and decoding to 4 word64 will fail because of short input+ -}+ecPublicKeyToBytes :: ECC.Point -> LB.ByteString+-- Point0 is the point at infinity, not sure what's the encoding for that+-- CHECK THIS+ecPublicKeyToBytes ECC.PointO = "\x04" <>+ (Binary.encode $ int32Bytes 0) <>+ (Binary.encode $ int32Bytes 0)+ecPublicKeyToBytes (ECC.Point x y) = "\x04" <>+ (Binary.encode $ int32Bytes x) <>+ (Binary.encode $ int32Bytes y)++ecBytesToPublicKey :: ByteString -> ECC.Point+-- the first byte is guarenteed to be \x04 which tells that the key is in uncompressed form+ecBytesToPublicKey bytes = let bothCoordBytes = BS.drop 1 bytes+ (xBytes, yBytes) = Binary.decode $ LB.fromStrict bothCoordBytes :: (Bytes32, Bytes32)+ xInteger = bytes32Int xBytes+ yInteger = bytes32Int yBytes+ in ECC.Point xInteger yInteger++-- Coordinates on Elliptic Curves are 32 bit integers+type Bytes32 = (Word64, Word64, Word64, Word64)++ -- points on elliptic curve for 256 bit algorithms are 32 bytes (256 bits) unsigned integers each+ -- fixed width big endian format+ -- integer to 4 Word64 (8 bytes each)+int32Bytes :: Integer -> Bytes32+int32Bytes number = let shift1 = Bits.shiftR number 64+ shift2 = Bits.shiftR shift1 64+ shift3 = Bits.shiftR shift2 64+ in ( fromIntegral shift3+ , fromIntegral shift2+ , fromIntegral shift1+ , fromIntegral number+ )++bytes32Int :: Bytes32 -> Integer+bytes32Int (d,c,b,a) = (Bits.shiftL (fromIntegral d) (64*3)) ++ (Bits.shiftL (fromIntegral c) (64*2)) ++ (Bits.shiftL (fromIntegral b) (64 )) ++ (fromIntegral a)++-- at most places we do not need the padding in base64 url encoding+b64UrlNoPadding :: ByteString -> ByteString+b64UrlNoPadding = fst . BS.breakSubstring "=" . B64.URL.encode
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/WebPushEncryptionSpec.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE OverloadedStrings #-}++module WebPushEncryptionSpec where++import Web.WebPush.Internal++import Test.Hspec++import qualified Data.Binary as Binary+import qualified Data.ByteString.Base64.URL as B64.URL+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LB+++-- Test to match input and output from the specification.+-- https://tools.ietf.org/html/draft-ietf-webpush-encryption-04+spec :: Spec+spec = describe "Web Push Encryption Test" $ do++ let encryptionInput = EncryptionInput+ { applicationServerPrivateKey = bytes32Int $ bsTo32Bytes $ BS.concat [ "nCScek-QpEjmOOlT-rQ38nZ"+ , "zvdPlqa00Zy0i6m2OJvY"+ ]+ , userAgentPublicKeyBytes = B64.URL.decodeLenient $ BS.concat [ "BCEkBjzL8Z3C-oi2Q7oE5t2Np-"+ , "p7osjGLg93qUP0wvqR"+ , "T21EEWyf0cQDQcakQMqz4hQKYOQ3il2nNZct4HgAUQU"+ ]+ , authenticationSecret = B64.URL.decodeLenient "R29vIGdvbyBnJyBqb29iIQ"+ , salt = B64.URL.decodeLenient "lngarbyKfMoi9Z75xYXmkg"+ , plainText = "I am the walrus"+ , paddingLength = 0+ }++ encryptionOutput = webPushEncrypt encryptionInput++ expectedEncryptionOutput = EncryptionOutput+ { sharedECDHSecretBytes = B64.URL.decodeLenient $ BS.concat [ "RNjC-"+ -- NOTE: the specs example might have printed this wrong+ -- there should be two consecutive hyphens and not one+ -- near the end of the encoded string, just before "NOQ6Y"+ , "NVW4BGJbxWPW7G2mowsLeDa53LYKYm4--NOQ6Y"+ ]+ , inputKeyingMaterialBytes = B64.URL.decodeLenient $ BS.concat [ "EhpZec37Ptm4IRD5-jtZ0q6r1iK5vYmY1tZwtN8"+ , "fbZY"+ ]+ , contentEncryptionKeyContext = B64.URL.decodeLenient $ BS.concat [ "Q29udGVudC1FbmNvZGluZzogYWVzZ2NtAFAtMjU2AABB BCEkBjzL8Z3C-"+ , "oi2Q7oE5t2Np-p7osjGLg93qUP0wvqR"+ , "T21EEWyf0cQDQcakQMqz4hQKYOQ3il2nNZct4HgAUQUA"+ , "QQTaEQ22_OCRpvIOWeQhcbq0qrF1iddSLX1xFmFSxPOW"+ , "OwmJA417CBHOGqsWGkNRvAapFwiegz6Q61rXVo_5roB1"+ ]+ , contentEncryptionKey = B64.URL.decodeLenient "AN2-xhvFWeYh5z0fcDu0Ww"+ , nonceContext = B64.URL.decodeLenient $ BS.concat [ "Q29udGVudC1FbmNvZGluZzogbm9uY2UAUC0yNT"+ , "YAAEEE ISQGPMvxncL6iLZDugTm3Y2n6nuiyMYuD3epQ_TC-pFP"+ , "bUQRbJ_RxANBxqRAyrPiFApg5DeKXac1ly3geABRBQBB"+ , "BNoRDbb84JGm8g5Z5CFxurSqsXWJ11ItfXEWYVLE85Y7"+ , "CYkDjXsIEc4aqxYaQ1G8BqkXCJ6DPpDrWtdWj_mugHU"+ ]+ , nonce = B64.URL.decodeLenient "JY1Okw5rw1Drkg9J"+ , paddedPlainText = B64.URL.decodeLenient "AABJIGFtIHRoZSB3YWxydXM"+ , encryptedMessage = B64.URL.decodeLenient $ BS.concat [ "6nqAQUME8hNqw5J3kl8cpVVJylXKYqZOeseZG8UueKpA" ]+ }++ it "should match the shared secret" $ do+ (sharedECDHSecretBytes <$> encryptionOutput) `shouldBe` Right (sharedECDHSecretBytes expectedEncryptionOutput)++ it "should match the input keying material" $ do+ (inputKeyingMaterialBytes <$> encryptionOutput) `shouldBe` Right (inputKeyingMaterialBytes expectedEncryptionOutput)++ it "should match the context for content encryption key derivation" $ do+ (contentEncryptionKeyContext <$> encryptionOutput) `shouldBe` Right (contentEncryptionKeyContext expectedEncryptionOutput)++ it "should match the content encryption key" $ do+ (contentEncryptionKey <$> encryptionOutput) `shouldBe` Right (contentEncryptionKey expectedEncryptionOutput)++ it "should match the context for nonce derivation" $ do+ (nonceContext <$> encryptionOutput) `shouldBe` Right (nonceContext expectedEncryptionOutput)++ it "should match the nonce" $ do+ (nonce <$> encryptionOutput) `shouldBe` Right (nonce expectedEncryptionOutput)++ it "should match the paddded plain text" $ do+ (paddedPlainText <$> encryptionOutput) `shouldBe` Right (paddedPlainText expectedEncryptionOutput)++ it "should match the encrypted message" $ do+ (encryptedMessage <$> encryptionOutput) `shouldBe` Right (encryptedMessage expectedEncryptionOutput)++++ where+ bsTo32Bytes :: ByteString -> Bytes32+ bsTo32Bytes = Binary.decode . LB.fromStrict . B64.URL.decodeLenient
web-push.cabal view
@@ -1,6 +1,6 @@ name: web-push-version: 0.1.0.0-synopsis: Helper functions to send messages using Web Push protocol.+version: 0.1.2.0+synopsis: Send messages using Web Push protocol. description: Please see README.md homepage: https://github.com/sarthakbagaria/web-push#readme license: MIT@@ -16,6 +16,7 @@ library hs-source-dirs: src exposed-modules: Web.WebPush+ Web.WebPush.Internal ghc-options: -Wall -fwarn-tabs -O2 build-depends: base >= 4.7 && < 5 , aeson@@ -23,18 +24,33 @@ , bytestring >= 0.9 && < 0.11 , base64-bytestring >= 1.0.0.1 && < 1.1 , text >= 0.11 && < 2.0- , cryptonite >= 0.6 && < 0.16+ , cryptonite >= 0.21 && < 0.22 , binary >= 0.7.5 && < 0.9- , memory >= 0.13 && < 0.14+ , memory >= 0.14.5 && < 0.15 , random >= 1.1 && < 1.2- , http-client >= 0.4.31 && < 0.5+ , http-client >= 0.5.7 && < 0.6 , http-types >= 0.8.6 && < 1.0 , exceptions >= 0.8.3 && < 0.9- , transformers >= 0.4.2.0 && < 0.5-- , jose >= 0.4.0.2 && < 0.5+ , transformers >= 0.5.2.0 && < 0.6+ , mtl >= 2.2.1 && < 2.3+ , jose >= 0.5.0.4 && < 0.6 , unordered-containers- ++ default-language: Haskell2010++test-suite web-push-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules: WebPushEncryptionSpec+ hs-source-dirs: test+ ghc-options: -Wall+ build-depends: base+ , web-push+ , hspec >= 2.4.3 && < 2.5+ , bytestring >= 0.9 && < 0.11+ , base64-bytestring >= 1.0.0.1 && < 1.1+ , binary >= 0.7.5 && < 0.9+ default-language: Haskell2010 source-repository head