{-# LANGUAGE DeriveAnyClass      #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

module Web.WebPush (
-- * Functions
  sendPushNotification
, sendPushNotifications
-- * Types
, Subscription(..)
, VapidConfig(..)
, PushNotification(..)
, PushNotificationCreated(..)
, PushNotificationError(..)
, PushP256dh
, PushAuth
, module Web.WebPush.Keys
) where

import           Web.WebPush.Internal
import           Web.WebPush.Keys

import           Control.Exception
import           Control.Exception.Safe     (tryAny)
import           Control.Monad.Except
import qualified Crypto.PubKey.ECC.DH       as ECDH
import qualified Crypto.PubKey.ECC.ECDSA    as ECDSA
import qualified Crypto.PubKey.ECC.Types    as ECC
import           Crypto.Random              (MonadRandom (getRandomBytes))
import qualified Data.Aeson                 as A
import           Data.Bifunctor
import qualified Data.ByteString            as BS
import qualified Data.ByteString.Base64.URL as B64.URL
import qualified Data.ByteString.Char8      as C8
import qualified Data.ByteString.Lazy       as BSL
import qualified Data.List                  as L
import qualified Data.Map                   as Map
import           Data.Maybe
import qualified Data.Text                  as T
import qualified Data.Text.Encoding         as TE
import qualified Data.Text.Read             as TR
import           Data.Time.Clock.POSIX      (getPOSIXTime)
import           Network.HTTP.Client        (HttpException (HttpExceptionRequest),
                                             HttpExceptionContent (StatusCodeException),
                                             Manager, RequestBody (..),
                                             Response (..), httpLbs, method,
                                             requestBody, requestFromURI,
                                             requestHeaders, responseStatus)
import           Network.HTTP.Types         (Header, hContentEncoding,
                                             hContentType)
import           Network.HTTP.Types.Status  (Status (statusCode))
import           Network.URI
import           System.Random              (randomRIO)

-- | Configuration for VAPID server identification
data VapidConfig = VapidConfig {
  VapidConfig -> Text
vapidConfigContact :: T.Text -- ^ Contact information for the application server, either a `mailto:` URI or an HTTPS URL
, VapidConfig -> VAPIDKeys
vapidConfigKeys :: VAPIDKeys -- ^ Keypair used to sign the VAPID identification
}

-- | Result of a successful push notification request
data PushNotificationCreated = PushNotificationCreated {
  PushNotificationCreated -> Maybe Int
pushNotificationCreatedTTL :: Maybe Int -- ^ Optional TTL of the notification
} deriving (PushNotificationCreated -> PushNotificationCreated -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PushNotificationCreated -> PushNotificationCreated -> Bool
$c/= :: PushNotificationCreated -> PushNotificationCreated -> Bool
== :: PushNotificationCreated -> PushNotificationCreated -> Bool
$c== :: PushNotificationCreated -> PushNotificationCreated -> Bool
Eq, Eq PushNotificationCreated
PushNotificationCreated -> PushNotificationCreated -> Bool
PushNotificationCreated -> PushNotificationCreated -> Ordering
PushNotificationCreated
-> PushNotificationCreated -> PushNotificationCreated
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PushNotificationCreated
-> PushNotificationCreated -> PushNotificationCreated
$cmin :: PushNotificationCreated
-> PushNotificationCreated -> PushNotificationCreated
max :: PushNotificationCreated
-> PushNotificationCreated -> PushNotificationCreated
$cmax :: PushNotificationCreated
-> PushNotificationCreated -> PushNotificationCreated
>= :: PushNotificationCreated -> PushNotificationCreated -> Bool
$c>= :: PushNotificationCreated -> PushNotificationCreated -> Bool
> :: PushNotificationCreated -> PushNotificationCreated -> Bool
$c> :: PushNotificationCreated -> PushNotificationCreated -> Bool
<= :: PushNotificationCreated -> PushNotificationCreated -> Bool
$c<= :: PushNotificationCreated -> PushNotificationCreated -> Bool
< :: PushNotificationCreated -> PushNotificationCreated -> Bool
$c< :: PushNotificationCreated -> PushNotificationCreated -> Bool
compare :: PushNotificationCreated -> PushNotificationCreated -> Ordering
$ccompare :: PushNotificationCreated -> PushNotificationCreated -> Ordering
Ord, Int -> PushNotificationCreated -> ShowS
[PushNotificationCreated] -> ShowS
PushNotificationCreated -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PushNotificationCreated] -> ShowS
$cshowList :: [PushNotificationCreated] -> ShowS
show :: PushNotificationCreated -> String
$cshow :: PushNotificationCreated -> String
showsPrec :: Int -> PushNotificationCreated -> ShowS
$cshowsPrec :: Int -> PushNotificationCreated -> ShowS
Show)

-- |Send a push notification to multiple subscribers
-- similar to `sendPushNotification` but shares VAPID keys across multiple requests
sendPushNotifications :: (MonadIO m, A.ToJSON msg, MonadRandom m)
                      => Manager
                      -> VapidConfig
                      -> PushNotification msg
                      -> [Subscription]
                      -> m [(Subscription, Either PushNotificationError PushNotificationCreated)]
sendPushNotifications :: forall (m :: * -> *) msg.
(MonadIO m, ToJSON msg, MonadRandom m) =>
Manager
-> VapidConfig
-> PushNotification msg
-> [Subscription]
-> m [(Subscription,
       Either PushNotificationError PushNotificationCreated)]
sendPushNotifications Manager
httpManager VapidConfig
vapidConfig PushNotification msg
pushNotification [Subscription]
subscriptions = do
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall k a. Map k a -> [(k, a)]
Map.toList Map Text [Subscription]
subscriptionsMap) forall a b. (a -> b) -> a -> b
$ \(Text
host, [Subscription]
hostSubscriptions) -> do
    POSIXTime
time <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
    let serverIdentification :: ServerIdentification
serverIdentification = ServerIdentification {
              serverIdentificationAudience :: Text
serverIdentificationAudience = Text
host
            , serverIdentificationExpiration :: Int
serverIdentificationExpiration = forall a b. (RealFrac a, Integral b) => a -> b
round POSIXTime
time forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall msg. PushNotification msg -> Int
pnExpireInSeconds PushNotification msg
pushNotification)
            , serverIdentificationSubject :: Text
serverIdentificationSubject = VapidConfig -> Text
vapidConfigContact VapidConfig
vapidConfig
          }
    [Header]
headers <- forall (m :: * -> *).
(MonadIO m, MonadRandom m) =>
PrivateKey -> ServerIdentification -> m [Header]
hostHeaders PrivateKey
privateKey ServerIdentification
serverIdentification
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Subscription]
hostSubscriptions forall a b. (a -> b) -> a -> b
$ \Subscription
subscription -> do
      Either PushNotificationError PushNotificationCreated
e <- forall (m :: * -> *) msg.
(MonadIO m, ToJSON msg, MonadRandom m) =>
VAPIDKeys
-> Manager
-> [Header]
-> PushNotification msg
-> Subscription
-> m (Either PushNotificationError PushNotificationCreated)
sendPushNotification' VAPIDKeys
vapidKeys Manager
httpManager [Header]
headers PushNotification msg
pushNotification Subscription
subscription
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Subscription
subscription, Either PushNotificationError PushNotificationCreated
e)
  where
    privateKey :: PrivateKey
privateKey = KeyPair -> PrivateKey
ECDSA.toPrivateKey forall a b. (a -> b) -> a -> b
$ VAPIDKeys -> KeyPair
unVAPIDKeys VAPIDKeys
vapidKeys
    vapidKeys :: VAPIDKeys
vapidKeys = VapidConfig -> VAPIDKeys
vapidConfigKeys VapidConfig
vapidConfig
    -- Group subscriptions by host
    subscriptionsMap :: Map Text [Subscription]
subscriptionsMap =
      forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes ((\Subscription
sub -> (,[Subscription
sub]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URI -> Maybe Text
uriHost (Subscription -> URI
subscriptionEndpoint Subscription
sub)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Subscription]
subscriptions)

-- | Send a Push Message. Read the message in Service Worker notification handler in browser:
--
-- > self.addEventListener('push', function(event){ console.log(event.data.json()); });
sendPushNotification :: (MonadIO m, A.ToJSON msg, MonadRandom m)
                      => Manager
                      -> VapidConfig
                      -> PushNotification msg
                      -> Subscription
                      -> m (Either PushNotificationError PushNotificationCreated)
sendPushNotification :: forall (m :: * -> *) msg.
(MonadIO m, ToJSON msg, MonadRandom m) =>
Manager
-> VapidConfig
-> PushNotification msg
-> Subscription
-> m (Either PushNotificationError PushNotificationCreated)
sendPushNotification Manager
httpManager VapidConfig
vapidConfig PushNotification msg
pushNotification Subscription
subscription =
  case URI -> Maybe Text
uriHost (Subscription -> URI
subscriptionEndpoint Subscription
subscription) of
    Maybe Text
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ URI -> PushNotificationError
PushNotificationBadHost (Subscription -> URI
subscriptionEndpoint Subscription
subscription)
    Just Text
host -> do
      POSIXTime
time <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
      let serverIdentification :: ServerIdentification
serverIdentification = ServerIdentification {
                serverIdentificationAudience :: Text
serverIdentificationAudience = Text
host
              , serverIdentificationExpiration :: Int
serverIdentificationExpiration = forall a b. (RealFrac a, Integral b) => a -> b
round POSIXTime
time forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall msg. PushNotification msg -> Int
pnExpireInSeconds PushNotification msg
pushNotification)
              , serverIdentificationSubject :: Text
serverIdentificationSubject = VapidConfig -> Text
vapidConfigContact VapidConfig
vapidConfig
            }
      [Header]
headers <- forall (m :: * -> *).
(MonadIO m, MonadRandom m) =>
PrivateKey -> ServerIdentification -> m [Header]
hostHeaders PrivateKey
privateKey ServerIdentification
serverIdentification
      forall (m :: * -> *) msg.
(MonadIO m, ToJSON msg, MonadRandom m) =>
VAPIDKeys
-> Manager
-> [Header]
-> PushNotification msg
-> Subscription
-> m (Either PushNotificationError PushNotificationCreated)
sendPushNotification' VAPIDKeys
vapidKeys Manager
httpManager [Header]
headers PushNotification msg
pushNotification Subscription
subscription
  where
    privateKey :: PrivateKey
privateKey = KeyPair -> PrivateKey
ECDSA.toPrivateKey forall a b. (a -> b) -> a -> b
$ VAPIDKeys -> KeyPair
unVAPIDKeys VAPIDKeys
vapidKeys
    vapidKeys :: VAPIDKeys
vapidKeys = VapidConfig -> VAPIDKeys
vapidConfigKeys VapidConfig
vapidConfig

-- | Internal function to send a single push notification
sendPushNotification' :: (MonadIO m, A.ToJSON msg, MonadRandom m)
                      => VAPIDKeys
                      -> Manager
                      -> [Header]
                      -> PushNotification msg
                      -> Subscription
                      -> m (Either PushNotificationError PushNotificationCreated)
sendPushNotification' :: forall (m :: * -> *) msg.
(MonadIO m, ToJSON msg, MonadRandom m) =>
VAPIDKeys
-> Manager
-> [Header]
-> PushNotification msg
-> Subscription
-> m (Either PushNotificationError PushNotificationCreated)
sendPushNotification' VAPIDKeys
vapidKeys Manager
httpManager [Header]
headers PushNotification msg
pushNotification Subscription
subscription = do
  forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
    -- TODO application should check a whitelist of allowed endpoints
    Request
initReq <- forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT HttpException -> PushNotificationError
EndpointParseFailed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => IO a -> IO (Either e a)
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadThrow m => URI -> m Request
requestFromURI forall a b. (a -> b) -> a -> b
$ Subscription -> URI
subscriptionEndpoint Subscription
subscription
    PrivateNumber
ecdhServerPrivateKey <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadRandom m => Curve -> m PrivateNumber
ECDH.generatePrivate forall a b. (a -> b) -> a -> b
$ CurveName -> Curve
ECC.getCurveByName CurveName
ECC.SEC_p256r1
    ByteString
randSalt <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
16
    Int64
padLen <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int64
0, Int64
20)

    let encryptionInput :: WebPushEncryptionInput
encryptionInput = EncryptionInput {
              applicationServerPrivateKey :: PrivateNumber
applicationServerPrivateKey = PrivateNumber
ecdhServerPrivateKey
            , userAgentPublicKeyBytes :: ByteString
userAgentPublicKeyBytes = ByteString
subscriptionPublicKeyBytes
            , authenticationSecret :: ByteString
authenticationSecret = ByteString
authSecretBytes
            , salt :: ByteString
salt = ByteString
randSalt
            , plainText :: ByteString
plainText = ByteString
plainMessage64Encoded
            , paddingLength :: Int64
paddingLength = Int64
padLen
          }
    WebPushEncryptionOutput
encryptionOutput <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncryptError -> PushNotificationError
PushEncryptError) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ WebPushEncryptionInput
-> Either EncryptError WebPushEncryptionOutput
webPushEncrypt WebPushEncryptionInput
encryptionInput
    -- TODO could this be cached
    let serverPublic :: PublicPoint
serverPublic = Curve -> PrivateNumber -> PublicPoint
ECDH.calculatePublic (CurveName -> Curve
ECC.getCurveByName CurveName
ECC.SEC_p256r1) forall a b. (a -> b) -> a -> b
$ PrivateNumber
ecdhServerPrivateKey
    ByteString
cryptoKeyHeaderContents <- forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> PushNotificationError
ApplicationKeyEncodeError forall a b. (a -> b) -> a -> b
$ PublicKey -> PublicPoint -> Either String ByteString
cryptoKeyHeader (VAPIDKeys -> PublicKey
vapidPublicKey VAPIDKeys
vapidKeys) PublicPoint
serverPublic
    let postHeaders :: [Header]
postHeaders = [Header]
headers forall a. Semigroup a => a -> a -> a
<> [   (HeaderName
"TTL", String -> ByteString
C8.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall msg. PushNotification msg -> Int
pnExpireInSeconds PushNotification msg
pushNotification)
                        , (HeaderName
hContentType, ByteString
"application/octet-stream")
                        , (HeaderName
"Crypto-Key", ByteString
cryptoKeyHeaderContents)
                        , (HeaderName
hContentEncoding, ByteString
"aesgcm")
                        , (HeaderName
"Encryption", ByteString
"salt=" forall a. Semigroup a => a -> a -> a
<> (ByteString -> ByteString
B64.URL.encodeBase64Unpadded' ByteString
randSalt))
                      ]

        request :: Request
request = Request
initReq {
                      method :: ByteString
method = ByteString
"POST"
                    , requestHeaders :: [Header]
requestHeaders = [Header]
postHeaders forall a. [a] -> [a] -> [a]
++
                                            -- avoid duplicate headers
                                            (forall a. (a -> Bool) -> [a] -> [a]
filter (\(HeaderName
x, ByteString
_) -> forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
L.notElem HeaderName
x forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [Header]
postHeaders)
                                                    (Request -> [Header]
requestHeaders Request
initReq)
                                            )
                        -- the body is encrypted message in raw bytes
                        -- without URL encoding
                    , requestBody :: RequestBody
requestBody = ByteString -> RequestBody
RequestBodyBS forall a b. (a -> b) -> a -> b
$ WebPushEncryptionOutput -> ByteString
encryptedMessage WebPushEncryptionOutput
encryptionOutput
                  }
    Response ByteString
resp <- forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT SomeException -> PushNotificationError
onError forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAny forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
httpLbs Request
request forall a b. (a -> b) -> a -> b
$ Manager
httpManager
    case Status -> Int
statusCode (forall body. Response body -> Status
responseStatus Response ByteString
resp) of
      Int
201 -> do
        let ttl :: Maybe Int
ttl = ByteString -> Maybe Int
parseTTLHeader forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup HeaderName
"ttl" (forall body. Response body -> [Header]
responseHeaders Response ByteString
resp)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe Int -> PushNotificationCreated
PushNotificationCreated Maybe Int
ttl
            
      Int
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Response ByteString -> PushNotificationError
PushRequestNotCreated Response ByteString
resp
  where
    cryptoKeyHeader :: ECDSA.PublicKey -> ECC.Point -> Either String C8.ByteString
    cryptoKeyHeader :: PublicKey -> PublicPoint -> Either String ByteString
cryptoKeyHeader PublicKey
vapidPublic PublicPoint
ecdhServerPublic = do
      let encodePublic :: PublicPoint -> Either String ByteString
encodePublic = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
B64.URL.encodeBase64Unpadded' forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicPoint -> Either String ByteString
ecPublicKeyToBytes
      ByteString
dh <- PublicPoint -> Either String ByteString
encodePublic PublicPoint
ecdhServerPublic
      ByteString
ecdsa <- PublicPoint -> Either String ByteString
encodePublic (PublicKey -> PublicPoint
ECDSA.public_q PublicKey
vapidPublic)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat [ ByteString
"dh=", ByteString
dh, ByteString
";", ByteString
"p256ecdsa=", ByteString
ecdsa]
    parseTTLHeader :: BS.ByteString -> Maybe Int
    parseTTLHeader :: ByteString -> Maybe Int
parseTTLHeader ByteString
bs = do
      Text
decoded <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> Either UnicodeException Text
TE.decodeUtf8' ByteString
bs
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall a. Integral a => Reader a
TR.decimal Text
decoded
    onError :: SomeException -> PushNotificationError
    onError :: SomeException -> PushNotificationError
onError SomeException
err
      | Just (HttpExceptionRequest Request
_ (StatusCodeException Response ()
resp ByteString
_)) <- forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err = case Status -> Int
statusCode (forall body. Response body -> Status
responseStatus Response ()
resp) of
          -- when the endpoint is invalid, we need to remove it from database
          Int
404 -> PushNotificationError
RecepientEndpointNotFound
          Int
410 -> PushNotificationError
RecepientEndpointNotFound
          Int
_   -> SomeException -> PushNotificationError
PushRequestFailed SomeException
err
      | Bool
otherwise = SomeException -> PushNotificationError
PushRequestFailed SomeException
err
    authSecretBytes :: ByteString
authSecretBytes = ByteString -> ByteString
B64.URL.decodeBase64Lenient forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8 forall a b. (a -> b) -> a -> b
$ Subscription -> Text
subscriptionAuth Subscription
subscription
    -- extract the 65 bytes of ECDH uncompressed public key received from browser in subscription
    subscriptionPublicKeyBytes :: ByteString
subscriptionPublicKeyBytes = ByteString -> ByteString
B64.URL.decodeBase64Lenient forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8 forall a b. (a -> b) -> a -> b
$ Subscription -> Text
subscriptionP256dh Subscription
subscription
    -- 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 :: ByteString
plainMessage64Encoded = forall a. ToJSON a => a -> ByteString
A.encode forall a b. (a -> b) -> a -> b
$ forall msg. PushNotification msg -> msg
pnMessage PushNotification msg
pushNotification

type PushP256dh = T.Text
type PushAuth = T.Text

-- | Subscription information for a push notification
data Subscription = Subscription {
  Subscription -> URI
subscriptionEndpoint :: URI -- ^ Endpoint URI to remote push service
, Subscription -> Text
subscriptionP256dh :: PushP256dh -- ^ Public key of the client
, Subscription -> Text
subscriptionAuth :: PushAuth -- ^ Authentication secret of the client
} deriving (Subscription -> Subscription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Subscription -> Subscription -> Bool
$c/= :: Subscription -> Subscription -> Bool
== :: Subscription -> Subscription -> Bool
$c== :: Subscription -> Subscription -> Bool
Eq, Eq Subscription
Subscription -> Subscription -> Bool
Subscription -> Subscription -> Ordering
Subscription -> Subscription -> Subscription
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Subscription -> Subscription -> Subscription
$cmin :: Subscription -> Subscription -> Subscription
max :: Subscription -> Subscription -> Subscription
$cmax :: Subscription -> Subscription -> Subscription
>= :: Subscription -> Subscription -> Bool
$c>= :: Subscription -> Subscription -> Bool
> :: Subscription -> Subscription -> Bool
$c> :: Subscription -> Subscription -> Bool
<= :: Subscription -> Subscription -> Bool
$c<= :: Subscription -> Subscription -> Bool
< :: Subscription -> Subscription -> Bool
$c< :: Subscription -> Subscription -> Bool
compare :: Subscription -> Subscription -> Ordering
$ccompare :: Subscription -> Subscription -> Ordering
Ord, Int -> Subscription -> ShowS
[Subscription] -> ShowS
Subscription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Subscription] -> ShowS
$cshowList :: [Subscription] -> ShowS
show :: Subscription -> String
$cshow :: Subscription -> String
showsPrec :: Int -> Subscription -> ShowS
$cshowsPrec :: Int -> Subscription -> ShowS
Show)

-- | Web push notification expiration and message to send
data PushNotification msg = PushNotification {
  forall msg. PushNotification msg -> Int
pnExpireInSeconds :: Int -- ^ Expiration time in seconds
, forall msg. PushNotification msg -> msg
pnMessage :: msg -- ^ Message to send
} deriving (PushNotification msg -> PushNotification msg -> Bool
forall msg.
Eq msg =>
PushNotification msg -> PushNotification msg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PushNotification msg -> PushNotification msg -> Bool
$c/= :: forall msg.
Eq msg =>
PushNotification msg -> PushNotification msg -> Bool
== :: PushNotification msg -> PushNotification msg -> Bool
$c== :: forall msg.
Eq msg =>
PushNotification msg -> PushNotification msg -> Bool
Eq, PushNotification msg -> PushNotification msg -> Bool
PushNotification msg -> PushNotification msg -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {msg}. Ord msg => Eq (PushNotification msg)
forall msg.
Ord msg =>
PushNotification msg -> PushNotification msg -> Bool
forall msg.
Ord msg =>
PushNotification msg -> PushNotification msg -> Ordering
forall msg.
Ord msg =>
PushNotification msg
-> PushNotification msg -> PushNotification msg
min :: PushNotification msg
-> PushNotification msg -> PushNotification msg
$cmin :: forall msg.
Ord msg =>
PushNotification msg
-> PushNotification msg -> PushNotification msg
max :: PushNotification msg
-> PushNotification msg -> PushNotification msg
$cmax :: forall msg.
Ord msg =>
PushNotification msg
-> PushNotification msg -> PushNotification msg
>= :: PushNotification msg -> PushNotification msg -> Bool
$c>= :: forall msg.
Ord msg =>
PushNotification msg -> PushNotification msg -> Bool
> :: PushNotification msg -> PushNotification msg -> Bool
$c> :: forall msg.
Ord msg =>
PushNotification msg -> PushNotification msg -> Bool
<= :: PushNotification msg -> PushNotification msg -> Bool
$c<= :: forall msg.
Ord msg =>
PushNotification msg -> PushNotification msg -> Bool
< :: PushNotification msg -> PushNotification msg -> Bool
$c< :: forall msg.
Ord msg =>
PushNotification msg -> PushNotification msg -> Bool
compare :: PushNotification msg -> PushNotification msg -> Ordering
$ccompare :: forall msg.
Ord msg =>
PushNotification msg -> PushNotification msg -> Ordering
Ord, Int -> PushNotification msg -> ShowS
forall msg. Show msg => Int -> PushNotification msg -> ShowS
forall msg. Show msg => [PushNotification msg] -> ShowS
forall msg. Show msg => PushNotification msg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PushNotification msg] -> ShowS
$cshowList :: forall msg. Show msg => [PushNotification msg] -> ShowS
show :: PushNotification msg -> String
$cshow :: forall msg. Show msg => PushNotification msg -> String
showsPrec :: Int -> PushNotification msg -> ShowS
$cshowsPrec :: forall msg. Show msg => Int -> PushNotification msg -> ShowS
Show)

-- | '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, or if 'EndpointParseFailed'.
data PushNotificationError = EndpointParseFailed HttpException -- ^ Endpoint URL could not be parsed
                           | PushNotificationBadHost URI
                           | PushEncryptError EncryptError
                           | ApplicationKeyEncodeError String -- ^ Application server key encoding failed
                           | RecepientEndpointNotFound -- ^ The endpoint is no longer recognized by the push service
                           | PushRequestFailed SomeException -- ^ Push request failed
                           | PushRequestNotCreated (Response BSL.ByteString) -- ^ Push request failed with non-201 status code
                            deriving (Int -> PushNotificationError -> ShowS
[PushNotificationError] -> ShowS
PushNotificationError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PushNotificationError] -> ShowS
$cshowList :: [PushNotificationError] -> ShowS
show :: PushNotificationError -> String
$cshow :: PushNotificationError -> String
showsPrec :: Int -> PushNotificationError -> ShowS
$cshowsPrec :: Int -> PushNotificationError -> ShowS
Show, Show PushNotificationError
Typeable PushNotificationError
SomeException -> Maybe PushNotificationError
PushNotificationError -> String
PushNotificationError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: PushNotificationError -> String
$cdisplayException :: PushNotificationError -> String
fromException :: SomeException -> Maybe PushNotificationError
$cfromException :: SomeException -> Maybe PushNotificationError
toException :: PushNotificationError -> SomeException
$ctoException :: PushNotificationError -> SomeException
Exception)