-- |
-- Module: APN
-- Copyright: (C) 2017, memrange UG
-- License: BSD3
-- Maintainer: Hans-Christian Esperer <hc@memrange.io>
-- Stability: experimental
-- Portability: portable
--
-- Send push notifications using Apple's HTTP2 APN API
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports    #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections     #-}

module Network.PushNotify.APN
    ( newSession
    , newMessage
    , newMessageWithCustomPayload
    , hexEncodedToken
    , rawToken
    , sendMessage
    , sendSilentMessage
    , sendRawMessage
    , alertMessage
    , bodyMessage
    , emptyMessage
    , setAlertMessage
    , setMessageBody
    , setBadge
    , setCategory
    , setSound
    , clearAlertMessage
    , clearBadge
    , clearCategory
    , clearSound
    , addSupplementalField
    , closeSession
    , isOpen
    , ApnSession
    , JsonAps
    , JsonApsAlert
    , JsonApsMessage
    , ApnMessageResult(..)
    , ApnFatalError(..)
    , ApnTemporaryError(..)
    , ApnToken
    ) where

import           Control.Concurrent
import           Control.Concurrent.QSem
import           Control.Exception.Lifted (Exception, try, bracket_, throw, throwIO)
import           Control.Monad
import           Control.Monad.Except
import           Data.Aeson
import           Data.Aeson.Types
import           Data.ByteString                      (ByteString)
import           Data.Char                            (toLower)
import           Data.Default                         (def)
import           Data.Either
import           Data.Int
import           Data.IORef
import           Data.Map.Strict                      (Map)
import           Data.Maybe
import           Data.Pool
import           Data.Semigroup                       ((<>))
import           Data.Text                            (Text)
import           Data.Time.Clock
import           Data.Time.Clock.POSIX
import           Data.Typeable                        (Typeable)
import           Data.X509
import           Data.X509.CertificateStore
import           GHC.Generics
import           Network.HTTP2                        (ErrorCodeId,
                                                       toErrorCodeId)
import "http2-client" Network.HTTP2.Client
import "http2-client" Network.HTTP2.Client.FrameConnection
import "http2-client" Network.HTTP2.Client.Helpers
import           Network.TLS                          hiding (sendData)
import           Network.TLS.Extra.Cipher
import           System.IO.Error
import           System.Mem.Weak
import           System.Random

import qualified Data.ByteString                      as S
import qualified Data.ByteString.Base16               as B16
import qualified Data.ByteString.Lazy                 as L
import qualified Data.List                            as DL
import qualified Data.Map.Strict                      as M
import qualified Data.Text                            as T
import qualified Data.Text.Encoding                   as TE

import qualified Network.HPACK                        as HTTP2
import qualified Network.HTTP2                        as HTTP2

-- | A session that manages connections to Apple's push notification service
data ApnSession = ApnSession
    { ApnSession -> Pool ApnConnection
apnSessionPool :: !(Pool ApnConnection)
    , ApnSession -> IORef Bool
apnSessionOpen :: !(IORef Bool)
    }

-- | Information about an APN connection
data ApnConnectionInfo = ApnConnectionInfo
    { ApnConnectionInfo -> FilePath
aciCertPath             :: !FilePath
    , ApnConnectionInfo -> FilePath
aciCertKey              :: !FilePath
    , ApnConnectionInfo -> FilePath
aciCaPath               :: !FilePath
    , ApnConnectionInfo -> Text
aciHostname             :: !Text
    , ApnConnectionInfo -> Int
aciMaxConcurrentStreams :: !Int
    , ApnConnectionInfo -> ByteString
aciTopic                :: !ByteString }

-- | A connection to an APN API server
data ApnConnection = ApnConnection
    { ApnConnection -> Http2Client
apnConnectionConnection        :: !Http2Client
    , ApnConnection -> ApnConnectionInfo
apnConnectionInfo              :: !ApnConnectionInfo
    , ApnConnection -> QSem
apnConnectionWorkerPool        :: !QSem
    , ApnConnection -> ThreadId
apnConnectionFlowControlWorker :: !ThreadId
    , ApnConnection -> IORef Bool
apnConnectionOpen              :: !(IORef Bool)}

-- | An APN token used to uniquely identify a device
newtype ApnToken = ApnToken { ApnToken -> ByteString
unApnToken :: ByteString }

class SpecifyError a where
    isAnError :: IOError -> a

-- | Create a token from a raw bytestring
rawToken
    :: ByteString
    -- ^ The bytestring that uniquely identifies a device (APN token)
    -> ApnToken
    -- ^ The resulting token
rawToken :: ByteString -> ApnToken
rawToken = ByteString -> ApnToken
ApnToken (ByteString -> ApnToken)
-> (ByteString -> ByteString) -> ByteString -> ApnToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B16.encode

-- | Create a token from a hex encoded text
hexEncodedToken
    :: Text
    -- ^ The base16 (hex) encoded unique identifier for a device (APN token)
    -> ApnToken
    -- ^ The resulting token
hexEncodedToken :: Text -> ApnToken
hexEncodedToken = ByteString -> ApnToken
ApnToken (ByteString -> ApnToken)
-> (Text -> ByteString) -> Text -> ApnToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B16.encode (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B16.decodeLenient (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8

-- | Exceptional responses to a send request
data ApnException = ApnExceptionHTTP ErrorCodeId
                  | ApnExceptionJSON String
                  | ApnExceptionMissingHeader HTTP2.HeaderName
                  | ApnExceptionUnexpectedResponse
    deriving (Int -> ApnException -> ShowS
[ApnException] -> ShowS
ApnException -> FilePath
(Int -> ApnException -> ShowS)
-> (ApnException -> FilePath)
-> ([ApnException] -> ShowS)
-> Show ApnException
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ApnException] -> ShowS
$cshowList :: [ApnException] -> ShowS
show :: ApnException -> FilePath
$cshow :: ApnException -> FilePath
showsPrec :: Int -> ApnException -> ShowS
$cshowsPrec :: Int -> ApnException -> ShowS
Show, Typeable)

instance Exception ApnException

-- | The result of a send request
data ApnMessageResult = ApnMessageResultOk
                      | ApnMessageResultBackoff
                      | ApnMessageResultFatalError ApnFatalError
                      | ApnMessageResultTemporaryError ApnTemporaryError
                      | ApnMessageResultIOError IOError
                      | ApnMessageResultClientError ClientError
    deriving (ApnMessageResult -> ApnMessageResult -> Bool
(ApnMessageResult -> ApnMessageResult -> Bool)
-> (ApnMessageResult -> ApnMessageResult -> Bool)
-> Eq ApnMessageResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApnMessageResult -> ApnMessageResult -> Bool
$c/= :: ApnMessageResult -> ApnMessageResult -> Bool
== :: ApnMessageResult -> ApnMessageResult -> Bool
$c== :: ApnMessageResult -> ApnMessageResult -> Bool
Eq, Int -> ApnMessageResult -> ShowS
[ApnMessageResult] -> ShowS
ApnMessageResult -> FilePath
(Int -> ApnMessageResult -> ShowS)
-> (ApnMessageResult -> FilePath)
-> ([ApnMessageResult] -> ShowS)
-> Show ApnMessageResult
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ApnMessageResult] -> ShowS
$cshowList :: [ApnMessageResult] -> ShowS
show :: ApnMessageResult -> FilePath
$cshow :: ApnMessageResult -> FilePath
showsPrec :: Int -> ApnMessageResult -> ShowS
$cshowsPrec :: Int -> ApnMessageResult -> ShowS
Show)

-- | The specification of a push notification's message body
data JsonApsAlert = JsonApsAlert
    { JsonApsAlert -> Maybe Text
jaaTitle :: !(Maybe Text)
    -- ^ A short string describing the purpose of the notification.
    , JsonApsAlert -> Text
jaaBody  :: !Text
    -- ^ The text of the alert message.
    } deriving ((forall x. JsonApsAlert -> Rep JsonApsAlert x)
-> (forall x. Rep JsonApsAlert x -> JsonApsAlert)
-> Generic JsonApsAlert
forall x. Rep JsonApsAlert x -> JsonApsAlert
forall x. JsonApsAlert -> Rep JsonApsAlert x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JsonApsAlert x -> JsonApsAlert
$cfrom :: forall x. JsonApsAlert -> Rep JsonApsAlert x
Generic, Int -> JsonApsAlert -> ShowS
[JsonApsAlert] -> ShowS
JsonApsAlert -> FilePath
(Int -> JsonApsAlert -> ShowS)
-> (JsonApsAlert -> FilePath)
-> ([JsonApsAlert] -> ShowS)
-> Show JsonApsAlert
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [JsonApsAlert] -> ShowS
$cshowList :: [JsonApsAlert] -> ShowS
show :: JsonApsAlert -> FilePath
$cshow :: JsonApsAlert -> FilePath
showsPrec :: Int -> JsonApsAlert -> ShowS
$cshowsPrec :: Int -> JsonApsAlert -> ShowS
Show)

instance ToJSON JsonApsAlert where
    toJSON :: JsonApsAlert -> Value
toJSON     = Options -> JsonApsAlert -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON     Options
defaultOptions
        { fieldLabelModifier :: ShowS
fieldLabelModifier = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
        , omitNothingFields :: Bool
omitNothingFields  = Bool
True
        }

-- | Push notification message's content
data JsonApsMessage
    -- | Push notification message's content
    = JsonApsMessage
    { JsonApsMessage -> Maybe JsonApsAlert
jamAlert    :: !(Maybe JsonApsAlert)
    -- ^ A text to display in the notification
    , JsonApsMessage -> Maybe Int
jamBadge    :: !(Maybe Int)
    -- ^ A number to display next to the app's icon. If set to (Just 0), the number is removed.
    , JsonApsMessage -> Maybe Text
jamSound    :: !(Maybe Text)
    -- ^ A sound to play, that's located in the Library/Sounds directory of the app
    -- This should be the name of a sound file in the application's main bundle, or
    -- in the Library/Sounds directory of the app.
    , JsonApsMessage -> Maybe Text
jamCategory :: !(Maybe Text)
    -- ^ The category of the notification. Must be registered by the app beforehand.
    } deriving ((forall x. JsonApsMessage -> Rep JsonApsMessage x)
-> (forall x. Rep JsonApsMessage x -> JsonApsMessage)
-> Generic JsonApsMessage
forall x. Rep JsonApsMessage x -> JsonApsMessage
forall x. JsonApsMessage -> Rep JsonApsMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JsonApsMessage x -> JsonApsMessage
$cfrom :: forall x. JsonApsMessage -> Rep JsonApsMessage x
Generic, Int -> JsonApsMessage -> ShowS
[JsonApsMessage] -> ShowS
JsonApsMessage -> FilePath
(Int -> JsonApsMessage -> ShowS)
-> (JsonApsMessage -> FilePath)
-> ([JsonApsMessage] -> ShowS)
-> Show JsonApsMessage
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [JsonApsMessage] -> ShowS
$cshowList :: [JsonApsMessage] -> ShowS
show :: JsonApsMessage -> FilePath
$cshow :: JsonApsMessage -> FilePath
showsPrec :: Int -> JsonApsMessage -> ShowS
$cshowsPrec :: Int -> JsonApsMessage -> ShowS
Show)

-- | Create an empty apn message
emptyMessage :: JsonApsMessage
emptyMessage :: JsonApsMessage
emptyMessage = Maybe JsonApsAlert
-> Maybe Int -> Maybe Text -> Maybe Text -> JsonApsMessage
JsonApsMessage Maybe JsonApsAlert
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing

-- | Set a sound for an APN message
setSound
    :: Text
    -- ^ The sound to use (either "default" or something in the application's bundle)
    -> JsonApsMessage
    -- ^ The message to modify
    -> JsonApsMessage
    -- ^ The modified message
setSound :: Text -> JsonApsMessage -> JsonApsMessage
setSound Text
s JsonApsMessage
a = JsonApsMessage
a { jamSound :: Maybe Text
jamSound = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s }

-- | Clear the sound for an APN message
clearSound
    :: JsonApsMessage
    -- ^ The message to modify
    -> JsonApsMessage
    -- ^ The modified message
clearSound :: JsonApsMessage -> JsonApsMessage
clearSound JsonApsMessage
a = JsonApsMessage
a { jamSound :: Maybe Text
jamSound = Maybe Text
forall a. Maybe a
Nothing }

-- | Set the category part of an APN message
setCategory
    :: Text
    -- ^ The category to set
    -> JsonApsMessage
    -- ^ The message to modify
    -> JsonApsMessage
    -- ^ The modified message
setCategory :: Text -> JsonApsMessage -> JsonApsMessage
setCategory Text
c JsonApsMessage
a = JsonApsMessage
a { jamCategory :: Maybe Text
jamCategory = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
c }

-- | Clear the category part of an APN message
clearCategory
    :: JsonApsMessage
    -- ^ The message to modify
    -> JsonApsMessage
    -- ^ The modified message
clearCategory :: JsonApsMessage -> JsonApsMessage
clearCategory JsonApsMessage
a = JsonApsMessage
a { jamCategory :: Maybe Text
jamCategory = Maybe Text
forall a. Maybe a
Nothing }

-- | Set the badge part of an APN message
setBadge
    :: Int
    -- ^ The badge number to set. The badge number is displayed next to your app's icon. Set to 0 to remove the badge number.
    -> JsonApsMessage
    -- ^ The message to modify
    -> JsonApsMessage
    -- ^ The modified message
setBadge :: Int -> JsonApsMessage -> JsonApsMessage
setBadge Int
i JsonApsMessage
a = JsonApsMessage
a { jamBadge :: Maybe Int
jamBadge = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i }

-- | Clear the badge part of an APN message
clearBadge
    :: JsonApsMessage
    -- ^ The message to modify
    -> JsonApsMessage
    -- ^ The modified message
clearBadge :: JsonApsMessage -> JsonApsMessage
clearBadge JsonApsMessage
a = JsonApsMessage
a { jamBadge :: Maybe Int
jamBadge = Maybe Int
forall a. Maybe a
Nothing }

-- | Create a new APN message with an alert part
alertMessage
    :: Text
    -- ^ The title of the message
    -> Text
    -- ^ The body of the message
    -> JsonApsMessage
    -- ^ The modified message
alertMessage :: Text -> Text -> JsonApsMessage
alertMessage Text
title Text
text = Text -> Text -> JsonApsMessage -> JsonApsMessage
setAlertMessage Text
title Text
text JsonApsMessage
emptyMessage

-- | Create a new APN message with a body and no title
bodyMessage
    :: Text
    -- ^ The body of the message
    -> JsonApsMessage
    -- ^ The modified message
bodyMessage :: Text -> JsonApsMessage
bodyMessage Text
text = Text -> JsonApsMessage -> JsonApsMessage
setMessageBody Text
text JsonApsMessage
emptyMessage

-- | Set the alert part of an APN message
setAlertMessage
    :: Text
    -- ^ The title of the message
    -> Text
    -- ^ The body of the message
    -> JsonApsMessage
    -- ^ The message to alter
    -> JsonApsMessage
    -- ^ The modified message
setAlertMessage :: Text -> Text -> JsonApsMessage -> JsonApsMessage
setAlertMessage Text
title Text
text JsonApsMessage
a = JsonApsMessage
a { jamAlert :: Maybe JsonApsAlert
jamAlert = JsonApsAlert -> Maybe JsonApsAlert
forall a. a -> Maybe a
Just JsonApsAlert
jam }
  where
    jam :: JsonApsAlert
jam = Maybe Text -> Text -> JsonApsAlert
JsonApsAlert (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
title) Text
text

-- | Set the body of an APN message without affecting the title
setMessageBody
    :: Text
    -- ^ The body of the message
    -> JsonApsMessage
    -- ^ The message to alter
    -> JsonApsMessage
    -- ^ The modified message
setMessageBody :: Text -> JsonApsMessage -> JsonApsMessage
setMessageBody Text
text JsonApsMessage
a = JsonApsMessage
a { jamAlert :: Maybe JsonApsAlert
jamAlert = JsonApsAlert -> Maybe JsonApsAlert
forall a. a -> Maybe a
Just JsonApsAlert
newJaa }
  where
    newJaa :: JsonApsAlert
newJaa = case JsonApsMessage -> Maybe JsonApsAlert
jamAlert JsonApsMessage
a of
                Maybe JsonApsAlert
Nothing  -> Maybe Text -> Text -> JsonApsAlert
JsonApsAlert Maybe Text
forall a. Maybe a
Nothing Text
text
                Just JsonApsAlert
jaa -> JsonApsAlert
jaa { jaaBody :: Text
jaaBody = Text
text }

-- | Remove the alert part of an APN message
clearAlertMessage
    :: JsonApsMessage
    -- ^ The message to modify
    -> JsonApsMessage
    -- ^ The modified message
clearAlertMessage :: JsonApsMessage -> JsonApsMessage
clearAlertMessage JsonApsMessage
a = JsonApsMessage
a { jamAlert :: Maybe JsonApsAlert
jamAlert = Maybe JsonApsAlert
forall a. Maybe a
Nothing }

instance ToJSON JsonApsMessage where
    toJSON :: JsonApsMessage -> Value
toJSON     = Options -> JsonApsMessage -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON     Options
defaultOptions
        { fieldLabelModifier :: ShowS
fieldLabelModifier = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower }

-- | A push notification message
data JsonAps
    -- | A push notification message
    = JsonAps
    { JsonAps -> JsonApsMessage
jaAps                :: !JsonApsMessage
    -- ^ The main content of the message
    , JsonAps -> Maybe Text
jaAppSpecificContent :: !(Maybe Text)
    -- ^ Extra information to be used by the receiving app
    , JsonAps -> Map Text Value
jaSupplementalFields :: !(Map Text Value)
    -- ^ Additional fields to be used by the receiving app
    } deriving ((forall x. JsonAps -> Rep JsonAps x)
-> (forall x. Rep JsonAps x -> JsonAps) -> Generic JsonAps
forall x. Rep JsonAps x -> JsonAps
forall x. JsonAps -> Rep JsonAps x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JsonAps x -> JsonAps
$cfrom :: forall x. JsonAps -> Rep JsonAps x
Generic, Int -> JsonAps -> ShowS
[JsonAps] -> ShowS
JsonAps -> FilePath
(Int -> JsonAps -> ShowS)
-> (JsonAps -> FilePath) -> ([JsonAps] -> ShowS) -> Show JsonAps
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [JsonAps] -> ShowS
$cshowList :: [JsonAps] -> ShowS
show :: JsonAps -> FilePath
$cshow :: JsonAps -> FilePath
showsPrec :: Int -> JsonAps -> ShowS
$cshowsPrec :: Int -> JsonAps -> ShowS
Show)

instance ToJSON JsonAps where
    toJSON :: JsonAps -> Value
toJSON JsonAps{Maybe Text
Map Text Value
JsonApsMessage
jaSupplementalFields :: Map Text Value
jaAppSpecificContent :: Maybe Text
jaAps :: JsonApsMessage
jaSupplementalFields :: JsonAps -> Map Text Value
jaAppSpecificContent :: JsonAps -> Maybe Text
jaAps :: JsonAps -> JsonApsMessage
..} = [Pair] -> Value
object ([Pair]
staticFields [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair]
dynamicFields)
        where
            dynamicFields :: [Pair]
dynamicFields = Map Text Value -> [Pair]
forall k a. Map k a -> [(k, a)]
M.toList Map Text Value
jaSupplementalFields
            staticFields :: [Pair]
staticFields = [ Text
"aps" Text -> JsonApsMessage -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= JsonApsMessage
jaAps
                           , Text
"appspecificcontent" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
jaAppSpecificContent
                           ]

-- | Prepare a new apn message consisting of a
-- standard message without a custom payload
newMessage
    :: JsonApsMessage
    -- ^ The standard message to include
    -> JsonAps
    -- ^ The resulting APN message
newMessage :: JsonApsMessage -> JsonAps
newMessage JsonApsMessage
aps = JsonApsMessage -> Maybe Text -> Map Text Value -> JsonAps
JsonAps JsonApsMessage
aps Maybe Text
forall a. Maybe a
Nothing Map Text Value
forall k a. Map k a
M.empty

-- | Prepare a new apn message consisting of a
-- standard message and a custom payload
newMessageWithCustomPayload
    :: JsonApsMessage
    -- ^ The message
    -> Text
    -- ^ The custom payload
    -> JsonAps
    -- ^ The resulting APN message
newMessageWithCustomPayload :: JsonApsMessage -> Text -> JsonAps
newMessageWithCustomPayload JsonApsMessage
message Text
payload =
    JsonApsMessage -> Maybe Text -> Map Text Value -> JsonAps
JsonAps JsonApsMessage
message (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
payload) Map Text Value
forall k a. Map k a
M.empty

-- | Add a supplemental field to be sent over with the notification
--
-- NB: The field 'aps' must not be modified; attempting to do so will
-- cause a crash.
addSupplementalField :: ToJSON record =>
       Text
    -- ^ The field name
    -> record
    -- ^ The value
    -> JsonAps
    -- ^ The APN message to modify
    -> JsonAps
    -- ^ The resulting APN message
addSupplementalField :: Text -> record -> JsonAps -> JsonAps
addSupplementalField Text
"aps"     record
_          JsonAps
_      = FilePath -> JsonAps
forall a. HasCallStack => FilePath -> a
error FilePath
"The 'aps' field may not be overwritten by user code"
addSupplementalField Text
fieldName record
fieldValue JsonAps
oldAPN = JsonAps
oldAPN { jaSupplementalFields :: Map Text Value
jaSupplementalFields = Map Text Value
newSupplemental }
    where
        oldSupplemental :: Map Text Value
oldSupplemental = JsonAps -> Map Text Value
jaSupplementalFields JsonAps
oldAPN
        newSupplemental :: Map Text Value
newSupplemental = Text -> Value -> Map Text Value -> Map Text Value
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
fieldName (record -> Value
forall a. ToJSON a => a -> Value
toJSON record
fieldValue) Map Text Value
oldSupplemental

-- | Start a new session for sending APN messages. A session consists of a
-- connection pool of connections to the APN servers, while each connection has a
-- pool of workers that create HTTP2 streams to send individual push
-- notifications.
newSession
    :: FilePath
    -- ^ Path to the client certificate key
    -> FilePath
    -- ^ Path to the client certificate
    -> FilePath
    -- ^ Path to the CA
    -> Bool
    -- ^ True if the apn development servers should be used, False to use the production servers
    -> Int
    -- ^ How many messages will be sent in parallel? This corresponds to the number of http2 streams open in parallel; 100 seems to be a default value.
    -> Int
    -- ^ How many connections to be opened at maximum.
    -> ByteString
    -- ^ Topic (bundle name of the app)
    -> IO ApnSession
    -- ^ The newly created session
newSession :: FilePath
-> FilePath
-> FilePath
-> Bool
-> Int
-> Int
-> ByteString
-> IO ApnSession
newSession FilePath
certKey FilePath
certPath FilePath
caPath Bool
dev Int
maxparallel Int
maxConnectionCount ByteString
topic = do
    let hostname :: Text
hostname = if Bool
dev
            then Text
"api.development.push.apple.com"
            else Text
"api.push.apple.com"
        connInfo :: ApnConnectionInfo
connInfo = FilePath
-> FilePath
-> FilePath
-> Text
-> Int
-> ByteString
-> ApnConnectionInfo
ApnConnectionInfo FilePath
certPath FilePath
certKey FilePath
caPath Text
hostname Int
maxparallel ByteString
topic
    Bool
certsOk <- ApnConnectionInfo -> IO Bool
checkCertificates ApnConnectionInfo
connInfo
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
certsOk (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
"Unable to load certificates and/or the private key"
    IORef Bool
isOpen <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
True

    let connectionUnusedTimeout :: NominalDiffTime
        connectionUnusedTimeout :: NominalDiffTime
connectionUnusedTimeout = NominalDiffTime
600
    Pool ApnConnection
pool <-
        IO ApnConnection
-> (ApnConnection -> IO ())
-> Int
-> NominalDiffTime
-> Int
-> IO (Pool ApnConnection)
forall a.
IO a
-> (a -> IO ()) -> Int -> NominalDiffTime -> Int -> IO (Pool a)
createPool
            (ApnConnectionInfo -> IO ApnConnection
newConnection ApnConnectionInfo
connInfo) ApnConnection -> IO ()
closeApnConnection Int
1 NominalDiffTime
connectionUnusedTimeout Int
maxConnectionCount
    let session :: ApnSession
session =
            ApnSession :: Pool ApnConnection -> IORef Bool -> ApnSession
ApnSession
            { apnSessionPool :: Pool ApnConnection
apnSessionPool = Pool ApnConnection
pool
            , apnSessionOpen :: IORef Bool
apnSessionOpen = IORef Bool
isOpen
            }
    ApnSession -> IO () -> IO ()
forall key. key -> IO () -> IO ()
addFinalizer ApnSession
session (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        ApnSession -> IO ()
closeSession ApnSession
session
    ApnSession -> IO ApnSession
forall (m :: * -> *) a. Monad m => a -> m a
return ApnSession
session

-- | Manually close a session. The session must not be used anymore
-- after it has been closed. Calling this function will close
-- the worker thread, and all open connections to the APN service
-- that belong to the given session. Note that sessions will be closed
-- automatically when they are garbage collected, so it is not necessary
-- to call this function.
closeSession :: ApnSession -> IO ()
closeSession :: ApnSession -> IO ()
closeSession ApnSession
s = do
    Bool
isOpen <- IORef Bool -> (Bool -> (Bool, Bool)) -> IO Bool
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (ApnSession -> IORef Bool
apnSessionOpen ApnSession
s) (Bool
False,)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isOpen (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
"Session is already closed"
    Pool ApnConnection -> IO ()
forall a. Pool a -> IO ()
destroyAllResources (ApnSession -> Pool ApnConnection
apnSessionPool ApnSession
s)

-- | Check whether a session is open or has been closed
-- by a call to closeSession
isOpen :: ApnSession -> IO Bool
isOpen :: ApnSession -> IO Bool
isOpen = IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (IORef Bool -> IO Bool)
-> (ApnSession -> IORef Bool) -> ApnSession -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApnSession -> IORef Bool
apnSessionOpen

withConnection :: ApnSession -> (ApnConnection -> ClientIO a) -> ClientIO a
withConnection :: ApnSession -> (ApnConnection -> ClientIO a) -> ClientIO a
withConnection ApnSession
s ApnConnection -> ClientIO a
action = do
    IO () -> ExceptT ClientError IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ExceptT ClientError IO ())
-> IO () -> ExceptT ClientError IO ()
forall a b. (a -> b) -> a -> b
$ ApnSession -> IO ()
ensureOpen ApnSession
s
    IO (Either ClientError a) -> ClientIO a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ClientError a) -> ClientIO a)
-> (IO a -> IO (Either ClientError a)) -> IO a -> ClientIO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO (Either ClientError a)
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> m (Either e a)
try (IO a -> ClientIO a) -> IO a -> ClientIO a
forall a b. (a -> b) -> a -> b
$
        Pool ApnConnection -> (ApnConnection -> IO a) -> IO a
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Pool a -> (a -> m b) -> m b
withResource (ApnSession -> Pool ApnConnection
apnSessionPool ApnSession
s) ((ApnConnection -> IO a) -> IO a)
-> (ApnConnection -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ApnConnection
conn -> do
        Either ClientError a
res <- ClientIO a -> IO (Either ClientError a)
forall a. ClientIO a -> IO (Either ClientError a)
runClientIO (ApnConnection -> ClientIO a
action ApnConnection
conn)
        case Either ClientError a
res of
          Left ClientError
clientError ->
              -- When there is a clientError, we think that the connetion is broken.
              -- Throwing an exception is the way we inform the resource pool.
              ClientError -> IO a
forall a e. Exception e => e -> a
throw ClientError
clientError
          Right a
res -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

checkCertificates :: ApnConnectionInfo -> IO Bool
checkCertificates :: ApnConnectionInfo -> IO Bool
checkCertificates ApnConnectionInfo
aci = do
    Maybe CertificateStore
castore <- FilePath -> IO (Maybe CertificateStore)
readCertificateStore (FilePath -> IO (Maybe CertificateStore))
-> FilePath -> IO (Maybe CertificateStore)
forall a b. (a -> b) -> a -> b
$ ApnConnectionInfo -> FilePath
aciCaPath ApnConnectionInfo
aci
    Either FilePath Credential
credential <- FilePath -> FilePath -> IO (Either FilePath Credential)
credentialLoadX509 (ApnConnectionInfo -> FilePath
aciCertPath ApnConnectionInfo
aci) (ApnConnectionInfo -> FilePath
aciCertKey ApnConnectionInfo
aci)
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Maybe CertificateStore -> Bool
forall a. Maybe a -> Bool
isJust Maybe CertificateStore
castore Bool -> Bool -> Bool
&& Either FilePath Credential -> Bool
forall a b. Either a b -> Bool
isRight Either FilePath Credential
credential

newConnection :: ApnConnectionInfo -> IO ApnConnection
newConnection :: ApnConnectionInfo -> IO ApnConnection
newConnection ApnConnectionInfo
aci = do
    Just CertificateStore
castore <- FilePath -> IO (Maybe CertificateStore)
readCertificateStore (FilePath -> IO (Maybe CertificateStore))
-> FilePath -> IO (Maybe CertificateStore)
forall a b. (a -> b) -> a -> b
$ ApnConnectionInfo -> FilePath
aciCaPath ApnConnectionInfo
aci
    Right Credential
credential <- FilePath -> FilePath -> IO (Either FilePath Credential)
credentialLoadX509 (ApnConnectionInfo -> FilePath
aciCertPath ApnConnectionInfo
aci) (ApnConnectionInfo -> FilePath
aciCertKey ApnConnectionInfo
aci)
    let credentials :: Credentials
credentials = [Credential] -> Credentials
Credentials [Credential
credential]
        shared :: Shared
shared      = Shared
forall a. Default a => a
def { sharedCredentials :: Credentials
sharedCredentials = Credentials
credentials
                          , sharedCAStore :: CertificateStore
sharedCAStore=CertificateStore
castore }
        maxConcurrentStreams :: Int
maxConcurrentStreams = ApnConnectionInfo -> Int
aciMaxConcurrentStreams ApnConnectionInfo
aci
        clip :: ClientParams
clip = ClientParams :: Maybe MaxFragmentEnum
-> (FilePath, ByteString)
-> Bool
-> Maybe (ByteString, SessionData)
-> Shared
-> ClientHooks
-> Supported
-> DebugParams
-> Maybe ByteString
-> ClientParams
ClientParams
            { clientUseMaxFragmentLength :: Maybe MaxFragmentEnum
clientUseMaxFragmentLength=Maybe MaxFragmentEnum
forall a. Maybe a
Nothing
            , clientServerIdentification :: (FilePath, ByteString)
clientServerIdentification=(Text -> FilePath
T.unpack Text
hostname, ByteString
forall a. HasCallStack => a
undefined)
            , clientUseServerNameIndication :: Bool
clientUseServerNameIndication=Bool
True
            , clientWantSessionResume :: Maybe (ByteString, SessionData)
clientWantSessionResume=Maybe (ByteString, SessionData)
forall a. Maybe a
Nothing
            , clientShared :: Shared
clientShared=Shared
shared
            , clientHooks :: ClientHooks
clientHooks=ClientHooks
forall a. Default a => a
def
                { onCertificateRequest :: OnCertificateRequest
onCertificateRequest=IO (Maybe Credential) -> OnCertificateRequest
forall a b. a -> b -> a
const (IO (Maybe Credential) -> OnCertificateRequest)
-> (Credential -> IO (Maybe Credential))
-> Credential
-> OnCertificateRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Credential -> IO (Maybe Credential)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Credential -> IO (Maybe Credential))
-> (Credential -> Maybe Credential)
-> Credential
-> IO (Maybe Credential)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential -> Maybe Credential
forall a. a -> Maybe a
Just (Credential -> OnCertificateRequest)
-> Credential -> OnCertificateRequest
forall a b. (a -> b) -> a -> b
$ Credential
credential }
            , clientDebug :: DebugParams
clientDebug=DebugParams :: Maybe Seed
-> (Seed -> IO ())
-> Maybe Version
-> (FilePath -> IO ())
-> DebugParams
DebugParams { debugSeed :: Maybe Seed
debugSeed=Maybe Seed
forall a. Maybe a
Nothing, debugPrintSeed :: Seed -> IO ()
debugPrintSeed=IO () -> Seed -> IO ()
forall a b. a -> b -> a
const (IO () -> Seed -> IO ()) -> IO () -> Seed -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () }
            , clientSupported :: Supported
clientSupported=Supported
forall a. Default a => a
def
                { supportedVersions :: [Version]
supportedVersions=[ Version
TLS12 ]
                , supportedCiphers :: [Cipher]
supportedCiphers=[Cipher]
ciphersuite_strong }
            }

        conf :: [(SettingsKeyId, Int)]
conf = [ (SettingsKeyId
HTTP2.SettingsMaxFrameSize, Int
16384)
               , (SettingsKeyId
HTTP2.SettingsMaxConcurrentStreams, Int
maxConcurrentStreams)
               , (SettingsKeyId
HTTP2.SettingsMaxHeaderBlockSize, Int
4096)
               , (SettingsKeyId
HTTP2.SettingsInitialWindowSize, Int
65536)
               , (SettingsKeyId
HTTP2.SettingsEnablePush, Int
1)
               ]

        hostname :: Text
hostname = ApnConnectionInfo -> Text
aciHostname ApnConnectionInfo
aci
    IORef Bool
isOpen <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
True
    let handleGoAway :: p -> t IO ()
handleGoAway p
rsgaf = do
            IO () -> t IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> t IO ()) -> IO () -> t IO ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
isOpen Bool
False
            () -> t IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Http2Client
client <-
        (Either ClientError Http2Client -> Http2Client)
-> IO (Either ClientError Http2Client) -> IO Http2Client
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ClientError -> Http2Client)
-> (Http2Client -> Http2Client)
-> Either ClientError Http2Client
-> Http2Client
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ClientError -> Http2Client
forall a e. Exception e => e -> a
throw Http2Client -> Http2Client
forall a. a -> a
id) (IO (Either ClientError Http2Client) -> IO Http2Client)
-> (ClientIO Http2Client -> IO (Either ClientError Http2Client))
-> ClientIO Http2Client
-> IO Http2Client
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientIO Http2Client -> IO (Either ClientError Http2Client)
forall a. ClientIO a -> IO (Either ClientError a)
runClientIO (ClientIO Http2Client -> IO Http2Client)
-> ClientIO Http2Client -> IO Http2Client
forall a b. (a -> b) -> a -> b
$ do
        Http2FrameConnection
httpFrameConnection <- FilePath
-> PortNumber
-> Maybe ClientParams
-> ClientIO Http2FrameConnection
newHttp2FrameConnection (Text -> FilePath
T.unpack Text
hostname) PortNumber
443 (ClientParams -> Maybe ClientParams
forall a. a -> Maybe a
Just ClientParams
clip)
        Http2Client
client <-
            Http2FrameConnection
-> Int
-> Int
-> [(SettingsKeyId, Int)]
-> GoAwayHandler
-> FallBackFrameHandler
-> ClientIO Http2Client
newHttp2Client Http2FrameConnection
httpFrameConnection Int
4096 Int
4096 [(SettingsKeyId, Int)]
conf GoAwayHandler
forall (t :: (* -> *) -> * -> *) p.
(Monad (t IO), MonadTrans t) =>
p -> t IO ()
handleGoAway FallBackFrameHandler
ignoreFallbackHandler
        Http2Client -> ExceptT ClientError IO ()
linkAsyncs Http2Client
client
        Http2Client -> ClientIO Http2Client
forall (m :: * -> *) a. Monad m => a -> m a
return Http2Client
client
    ThreadId
flowWorker <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Either ClientError Bool
updated <- ClientIO Bool -> IO (Either ClientError Bool)
forall a. ClientIO a -> IO (Either ClientError a)
runClientIO (ClientIO Bool -> IO (Either ClientError Bool))
-> ClientIO Bool -> IO (Either ClientError Bool)
forall a b. (a -> b) -> a -> b
$ IncomingFlowControl -> ClientIO Bool
_updateWindow (IncomingFlowControl -> ClientIO Bool)
-> IncomingFlowControl -> ClientIO Bool
forall a b. (a -> b) -> a -> b
$ Http2Client -> IncomingFlowControl
_incomingFlowControl Http2Client
client
        Int -> IO ()
threadDelay Int
1000000
    QSem
workersem <- Int -> IO QSem
newQSem Int
maxConcurrentStreams
    ApnConnection -> IO ApnConnection
forall (m :: * -> *) a. Monad m => a -> m a
return (ApnConnection -> IO ApnConnection)
-> ApnConnection -> IO ApnConnection
forall a b. (a -> b) -> a -> b
$ Http2Client
-> ApnConnectionInfo
-> QSem
-> ThreadId
-> IORef Bool
-> ApnConnection
ApnConnection Http2Client
client ApnConnectionInfo
aci QSem
workersem ThreadId
flowWorker IORef Bool
isOpen


closeApnConnection :: ApnConnection -> IO ()
closeApnConnection :: ApnConnection -> IO ()
closeApnConnection ApnConnection
connection =
    -- Ignoring ClientErrors in this place. We want to close our session, so we do not need to
    -- fail on this kind of errors.
    IO (Either ClientError ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either ClientError ()) -> IO ())
-> IO (Either ClientError ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ExceptT ClientError IO () -> IO (Either ClientError ())
forall a. ClientIO a -> IO (Either ClientError a)
runClientIO (ExceptT ClientError IO () -> IO (Either ClientError ()))
-> ExceptT ClientError IO () -> IO (Either ClientError ())
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ExceptT ClientError IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ExceptT ClientError IO ())
-> IO () -> ExceptT ClientError IO ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (ApnConnection -> IORef Bool
apnConnectionOpen ApnConnection
connection) Bool
False
    let flowWorker :: ThreadId
flowWorker = ApnConnection -> ThreadId
apnConnectionFlowControlWorker ApnConnection
connection
    IO () -> ExceptT ClientError IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ExceptT ClientError IO ())
-> IO () -> ExceptT ClientError IO ()
forall a b. (a -> b) -> a -> b
$ ThreadId -> IO ()
killThread ThreadId
flowWorker
    Http2Client
-> ErrorCodeId -> ByteString -> ExceptT ClientError IO ()
_gtfo (ApnConnection -> Http2Client
apnConnectionConnection ApnConnection
connection) ErrorCodeId
HTTP2.NoError ByteString
""
    Http2Client -> ExceptT ClientError IO ()
_close (ApnConnection -> Http2Client
apnConnectionConnection ApnConnection
connection)


-- | Send a raw payload as a push notification message (advanced)
sendRawMessage
    :: ApnSession
    -- ^ Session to use
    -> ApnToken
    -- ^ Device to send the message to
    -> ByteString
    -- ^ The message to send
    -> IO ApnMessageResult
    -- ^ The response from the APN server
sendRawMessage :: ApnSession -> ApnToken -> ByteString -> IO ApnMessageResult
sendRawMessage ApnSession
s ApnToken
token ByteString
payload = ClientIO ApnMessageResult -> IO ApnMessageResult
catchErrors (ClientIO ApnMessageResult -> IO ApnMessageResult)
-> ClientIO ApnMessageResult -> IO ApnMessageResult
forall a b. (a -> b) -> a -> b
$
    ApnSession
-> (ApnConnection -> ClientIO ApnMessageResult)
-> ClientIO ApnMessageResult
forall a. ApnSession -> (ApnConnection -> ClientIO a) -> ClientIO a
withConnection ApnSession
s ((ApnConnection -> ClientIO ApnMessageResult)
 -> ClientIO ApnMessageResult)
-> (ApnConnection -> ClientIO ApnMessageResult)
-> ClientIO ApnMessageResult
forall a b. (a -> b) -> a -> b
$ \ApnConnection
c ->
        ApnConnection
-> ApnToken -> ByteString -> ClientIO ApnMessageResult
sendApnRaw ApnConnection
c ApnToken
token ByteString
payload

-- | Send a push notification message.
sendMessage
    :: ApnSession
    -- ^ Session to use
    -> ApnToken
    -- ^ Device to send the message to
    -> JsonAps
    -- ^ The message to send
    -> IO ApnMessageResult
    -- ^ The response from the APN server
sendMessage :: ApnSession -> ApnToken -> JsonAps -> IO ApnMessageResult
sendMessage ApnSession
s ApnToken
token JsonAps
payload = ClientIO ApnMessageResult -> IO ApnMessageResult
catchErrors (ClientIO ApnMessageResult -> IO ApnMessageResult)
-> ClientIO ApnMessageResult -> IO ApnMessageResult
forall a b. (a -> b) -> a -> b
$
    ApnSession
-> (ApnConnection -> ClientIO ApnMessageResult)
-> ClientIO ApnMessageResult
forall a. ApnSession -> (ApnConnection -> ClientIO a) -> ClientIO a
withConnection ApnSession
s ((ApnConnection -> ClientIO ApnMessageResult)
 -> ClientIO ApnMessageResult)
-> (ApnConnection -> ClientIO ApnMessageResult)
-> ClientIO ApnMessageResult
forall a b. (a -> b) -> a -> b
$ \ApnConnection
c ->
        ApnConnection
-> ApnToken -> ByteString -> ClientIO ApnMessageResult
sendApnRaw ApnConnection
c ApnToken
token ByteString
message
  where message :: ByteString
message = ByteString -> ByteString
L.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ JsonAps -> ByteString
forall a. ToJSON a => a -> ByteString
encode JsonAps
payload

-- | Send a silent push notification
sendSilentMessage
    :: ApnSession
    -- ^ Session to use
    -> ApnToken
    -- ^ Device to send the message to
    -> IO ApnMessageResult
    -- ^ The response from the APN server
sendSilentMessage :: ApnSession -> ApnToken -> IO ApnMessageResult
sendSilentMessage ApnSession
s ApnToken
token = ClientIO ApnMessageResult -> IO ApnMessageResult
catchErrors (ClientIO ApnMessageResult -> IO ApnMessageResult)
-> ClientIO ApnMessageResult -> IO ApnMessageResult
forall a b. (a -> b) -> a -> b
$
    ApnSession
-> (ApnConnection -> ClientIO ApnMessageResult)
-> ClientIO ApnMessageResult
forall a. ApnSession -> (ApnConnection -> ClientIO a) -> ClientIO a
withConnection ApnSession
s ((ApnConnection -> ClientIO ApnMessageResult)
 -> ClientIO ApnMessageResult)
-> (ApnConnection -> ClientIO ApnMessageResult)
-> ClientIO ApnMessageResult
forall a b. (a -> b) -> a -> b
$ \ApnConnection
c ->
        ApnConnection
-> ApnToken -> ByteString -> ClientIO ApnMessageResult
sendApnRaw ApnConnection
c ApnToken
token ByteString
message
  where message :: ByteString
message = ByteString
"{\"aps\":{\"content-available\":1}}"

ensureOpen :: ApnSession -> IO ()
ensureOpen :: ApnSession -> IO ()
ensureOpen ApnSession
s = do
    Bool
open <- ApnSession -> IO Bool
isOpen ApnSession
s
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
open (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
"Session is closed"

-- | Send a push notification message.
sendApnRaw
    :: ApnConnection
    -- ^ Connection to use
    -> ApnToken
    -- ^ Device to send the message to
    -> ByteString
    -- ^ The message to send
    -> ClientIO ApnMessageResult
sendApnRaw :: ApnConnection
-> ApnToken -> ByteString -> ClientIO ApnMessageResult
sendApnRaw ApnConnection
connection ApnToken
token ByteString
message = ExceptT ClientError IO ()
-> ExceptT ClientError IO ()
-> ClientIO ApnMessageResult
-> ClientIO ApnMessageResult
forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> m b -> m c -> m c
bracket_
  (IO () -> ExceptT ClientError IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ExceptT ClientError IO ())
-> IO () -> ExceptT ClientError IO ()
forall a b. (a -> b) -> a -> b
$ QSem -> IO ()
waitQSem (ApnConnection -> QSem
apnConnectionWorkerPool ApnConnection
connection))
  (IO () -> ExceptT ClientError IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ExceptT ClientError IO ())
-> IO () -> ExceptT ClientError IO ()
forall a b. (a -> b) -> a -> b
$ QSem -> IO ()
signalQSem (ApnConnection -> QSem
apnConnectionWorkerPool ApnConnection
connection)) (ClientIO ApnMessageResult -> ClientIO ApnMessageResult)
-> ClientIO ApnMessageResult -> ClientIO ApnMessageResult
forall a b. (a -> b) -> a -> b
$ do
    let requestHeaders :: [(ByteString, ByteString)]
requestHeaders = [ ( ByteString
":method", ByteString
"POST" )
                  , ( ByteString
":scheme", ByteString
"https" )
                  , ( ByteString
":authority", Text -> ByteString
TE.encodeUtf8 Text
hostname )
                  , ( ByteString
":path", ByteString
"/3/device/" ByteString -> ByteString -> ByteString
`S.append` ByteString
token1 )
                  , ( ByteString
"apns-topic", ByteString
topic ) ]
        aci :: ApnConnectionInfo
aci = ApnConnection -> ApnConnectionInfo
apnConnectionInfo ApnConnection
connection
        hostname :: Text
hostname = ApnConnectionInfo -> Text
aciHostname ApnConnectionInfo
aci
        topic :: ByteString
topic = ApnConnectionInfo -> ByteString
aciTopic ApnConnectionInfo
aci
        client :: Http2Client
client = ApnConnection -> Http2Client
apnConnectionConnection ApnConnection
connection
        token1 :: ByteString
token1 = ApnToken -> ByteString
unApnToken ApnToken
token

    Either TooMuchConcurrency ApnMessageResult
res <- Http2Client -> forall a. StreamStarter a
_startStream Http2Client
client StreamStarter ApnMessageResult -> StreamStarter ApnMessageResult
forall a b. (a -> b) -> a -> b
$ \Http2Stream
stream ->
        let init :: ClientIO StreamThread
init = Http2Stream
-> [(ByteString, ByteString)]
-> FlagSetter
-> ClientIO StreamThread
headers Http2Stream
stream [(ByteString, ByteString)]
requestHeaders FlagSetter
forall a. a -> a
id
            handler :: IncomingFlowControl
-> OutgoingFlowControl -> ClientIO ApnMessageResult
handler IncomingFlowControl
isfc OutgoingFlowControl
osfc = do
                -- sendData client stream (HTTP2.setEndStream) message
                ByteString
-> FlagSetter
-> Http2Client
-> OutgoingFlowControl
-> Http2Stream
-> OutgoingFlowControl
-> ExceptT ClientError IO ()
upload ByteString
message (FlagSetter
HTTP2.setEndHeader FlagSetter -> FlagSetter -> FlagSetter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlagSetter
HTTP2.setEndStream) Http2Client
client (Http2Client -> OutgoingFlowControl
_outgoingFlowControl Http2Client
client) Http2Stream
stream OutgoingFlowControl
osfc
                let pph :: p -> p -> a -> p -> p -> t IO ()
pph p
hStreamId p
hStream a
hHeaders p
hIfc p
hOfc =
                        IO () -> t IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> t IO ()) -> IO () -> t IO ()
forall a b. (a -> b) -> a -> b
$ a -> IO ()
forall a. Show a => a -> IO ()
print a
hHeaders
                StreamResult
response <- Http2Stream
-> IncomingFlowControl
-> PushPromiseHandler
-> ClientIO StreamResult
waitStream Http2Stream
stream IncomingFlowControl
isfc PushPromiseHandler
forall (t :: (* -> *) -> * -> *) a p p p p.
(MonadTrans t, Show a) =>
p -> p -> a -> p -> p -> t IO ()
pph
                let (Either ErrorCode [(ByteString, ByteString)]
errOrHeaders, [Either ErrorCode ByteString]
frameResponses, Maybe [(ByteString, ByteString)]
_) = StreamResult
response
                case Either ErrorCode [(ByteString, ByteString)]
errOrHeaders of
                    Left ErrorCode
err -> ApnException -> ClientIO ApnMessageResult
forall (m :: * -> *) e a. (MonadBase IO m, Exception e) => e -> m a
throwIO (ErrorCodeId -> ApnException
ApnExceptionHTTP (ErrorCodeId -> ApnException) -> ErrorCodeId -> ApnException
forall a b. (a -> b) -> a -> b
$ ErrorCode -> ErrorCodeId
toErrorCodeId ErrorCode
err)
                    Right [(ByteString, ByteString)]
hdrs1 -> do
                        let status :: ByteString
status       = ByteString -> [(ByteString, ByteString)] -> ByteString
getHeaderEx ByteString
":status" [(ByteString, ByteString)]
hdrs1
                            [Right ByteString
body] = [Either ErrorCode ByteString]
frameResponses

                        ApnMessageResult -> ClientIO ApnMessageResult
forall (m :: * -> *) a. Monad m => a -> m a
return (ApnMessageResult -> ClientIO ApnMessageResult)
-> ApnMessageResult -> ClientIO ApnMessageResult
forall a b. (a -> b) -> a -> b
$ case ByteString
status of
                            ByteString
"200" -> ApnMessageResult
ApnMessageResultOk
                            ByteString
"400" -> (ApnFatalError -> ApnMessageResult)
-> ByteString -> ApnMessageResult
forall response.
FromJSON response =>
(response -> ApnMessageResult) -> ByteString -> ApnMessageResult
decodeReason ApnFatalError -> ApnMessageResult
ApnMessageResultFatalError ByteString
body
                            ByteString
"403" -> (ApnFatalError -> ApnMessageResult)
-> ByteString -> ApnMessageResult
forall response.
FromJSON response =>
(response -> ApnMessageResult) -> ByteString -> ApnMessageResult
decodeReason ApnFatalError -> ApnMessageResult
ApnMessageResultFatalError ByteString
body
                            ByteString
"405" -> (ApnFatalError -> ApnMessageResult)
-> ByteString -> ApnMessageResult
forall response.
FromJSON response =>
(response -> ApnMessageResult) -> ByteString -> ApnMessageResult
decodeReason ApnFatalError -> ApnMessageResult
ApnMessageResultFatalError ByteString
body
                            ByteString
"410" -> (ApnFatalError -> ApnMessageResult)
-> ByteString -> ApnMessageResult
forall response.
FromJSON response =>
(response -> ApnMessageResult) -> ByteString -> ApnMessageResult
decodeReason ApnFatalError -> ApnMessageResult
ApnMessageResultFatalError ByteString
body
                            ByteString
"413" -> (ApnFatalError -> ApnMessageResult)
-> ByteString -> ApnMessageResult
forall response.
FromJSON response =>
(response -> ApnMessageResult) -> ByteString -> ApnMessageResult
decodeReason ApnFatalError -> ApnMessageResult
ApnMessageResultFatalError ByteString
body
                            ByteString
"429" -> (ApnTemporaryError -> ApnMessageResult)
-> ByteString -> ApnMessageResult
forall response.
FromJSON response =>
(response -> ApnMessageResult) -> ByteString -> ApnMessageResult
decodeReason ApnTemporaryError -> ApnMessageResult
ApnMessageResultTemporaryError ByteString
body
                            ByteString
"500" -> (ApnTemporaryError -> ApnMessageResult)
-> ByteString -> ApnMessageResult
forall response.
FromJSON response =>
(response -> ApnMessageResult) -> ByteString -> ApnMessageResult
decodeReason ApnTemporaryError -> ApnMessageResult
ApnMessageResultTemporaryError ByteString
body
                            ByteString
"503" -> (ApnTemporaryError -> ApnMessageResult)
-> ByteString -> ApnMessageResult
forall response.
FromJSON response =>
(response -> ApnMessageResult) -> ByteString -> ApnMessageResult
decodeReason ApnTemporaryError -> ApnMessageResult
ApnMessageResultTemporaryError ByteString
body
        in ClientIO StreamThread
-> (IncomingFlowControl
    -> OutgoingFlowControl -> ClientIO ApnMessageResult)
-> StreamDefinition ApnMessageResult
forall a.
ClientIO StreamThread
-> (IncomingFlowControl -> OutgoingFlowControl -> ClientIO a)
-> StreamDefinition a
StreamDefinition ClientIO StreamThread
init IncomingFlowControl
-> OutgoingFlowControl -> ClientIO ApnMessageResult
handler
    case Either TooMuchConcurrency ApnMessageResult
res of
        Left TooMuchConcurrency
_     -> ApnMessageResult -> ClientIO ApnMessageResult
forall (m :: * -> *) a. Monad m => a -> m a
return ApnMessageResult
ApnMessageResultBackoff -- Too much concurrency
        Right ApnMessageResult
res1 -> ApnMessageResult -> ClientIO ApnMessageResult
forall (m :: * -> *) a. Monad m => a -> m a
return ApnMessageResult
res1

    where
        decodeReason :: FromJSON response => (response -> ApnMessageResult) -> ByteString -> ApnMessageResult
        decodeReason :: (response -> ApnMessageResult) -> ByteString -> ApnMessageResult
decodeReason response -> ApnMessageResult
ctor = (FilePath -> ApnMessageResult)
-> (ApnMessageResult -> ApnMessageResult)
-> Either FilePath ApnMessageResult
-> ApnMessageResult
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ApnException -> ApnMessageResult
forall a e. Exception e => e -> a
throw (ApnException -> ApnMessageResult)
-> (FilePath -> ApnException) -> FilePath -> ApnMessageResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ApnException
ApnExceptionJSON) ApnMessageResult -> ApnMessageResult
forall a. a -> a
id (Either FilePath ApnMessageResult -> ApnMessageResult)
-> (ByteString -> Either FilePath ApnMessageResult)
-> ByteString
-> ApnMessageResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either FilePath ApnMessageResult
decodeBody (ByteString -> Either FilePath ApnMessageResult)
-> (ByteString -> ByteString)
-> ByteString
-> Either FilePath ApnMessageResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.fromStrict
            where
                decodeBody :: ByteString -> Either FilePath ApnMessageResult
decodeBody ByteString
body =
                    ByteString -> Either FilePath Object
forall a. FromJSON a => ByteString -> Either FilePath a
eitherDecode ByteString
body
                        Either FilePath Object
-> (Object -> Either FilePath ApnMessageResult)
-> Either FilePath ApnMessageResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Parser ApnMessageResult)
-> Object -> Either FilePath ApnMessageResult
forall a b. (a -> Parser b) -> a -> Either FilePath b
parseEither (\Object
obj -> response -> ApnMessageResult
ctor (response -> ApnMessageResult)
-> Parser response -> Parser ApnMessageResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser response
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"reason")

        getHeaderEx :: HTTP2.HeaderName -> [HTTP2.Header] -> HTTP2.HeaderValue
        getHeaderEx :: ByteString -> [(ByteString, ByteString)] -> ByteString
getHeaderEx ByteString
name [(ByteString, ByteString)]
headers = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe (ApnException -> ByteString
forall a e. Exception e => e -> a
throw (ApnException -> ByteString) -> ApnException -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ApnException
ApnExceptionMissingHeader ByteString
name) (ByteString -> [(ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
DL.lookup ByteString
name [(ByteString, ByteString)]
headers)


catchErrors :: ClientIO ApnMessageResult -> IO ApnMessageResult
catchErrors :: ClientIO ApnMessageResult -> IO ApnMessageResult
catchErrors = IO ApnMessageResult -> IO ApnMessageResult
catchIOErrors (IO ApnMessageResult -> IO ApnMessageResult)
-> (ClientIO ApnMessageResult -> IO ApnMessageResult)
-> ClientIO ApnMessageResult
-> IO ApnMessageResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientIO ApnMessageResult -> IO ApnMessageResult
catchClientErrors
    where
        catchIOErrors :: IO ApnMessageResult -> IO ApnMessageResult
        catchIOErrors :: IO ApnMessageResult -> IO ApnMessageResult
catchIOErrors = (IO ApnMessageResult
 -> (IOError -> IO ApnMessageResult) -> IO ApnMessageResult)
-> (IOError -> IO ApnMessageResult)
-> IO ApnMessageResult
-> IO ApnMessageResult
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO ApnMessageResult
-> (IOError -> IO ApnMessageResult) -> IO ApnMessageResult
forall a. IO a -> (IOError -> IO a) -> IO a
catchIOError (ApnMessageResult -> IO ApnMessageResult
forall (m :: * -> *) a. Monad m => a -> m a
return (ApnMessageResult -> IO ApnMessageResult)
-> (IOError -> ApnMessageResult) -> IOError -> IO ApnMessageResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> ApnMessageResult
ApnMessageResultIOError)

        catchClientErrors :: ClientIO ApnMessageResult -> IO ApnMessageResult
        catchClientErrors :: ClientIO ApnMessageResult -> IO ApnMessageResult
catchClientErrors ClientIO ApnMessageResult
act =
            (ClientError -> ApnMessageResult)
-> (ApnMessageResult -> ApnMessageResult)
-> Either ClientError ApnMessageResult
-> ApnMessageResult
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ClientError -> ApnMessageResult
ApnMessageResultClientError ApnMessageResult -> ApnMessageResult
forall a. a -> a
id (Either ClientError ApnMessageResult -> ApnMessageResult)
-> IO (Either ClientError ApnMessageResult) -> IO ApnMessageResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientIO ApnMessageResult
-> IO (Either ClientError ApnMessageResult)
forall a. ClientIO a -> IO (Either ClientError a)
runClientIO ClientIO ApnMessageResult
act


-- The type of permanent error indicated by APNS
-- See https://apple.co/2RDCdWC table 8-6 for the meaning of each value.
data ApnFatalError = ApnFatalErrorBadCollapseId
                   | ApnFatalErrorBadDeviceToken
                   | ApnFatalErrorBadExpirationDate
                   | ApnFatalErrorBadMessageId
                   | ApnFatalErrorBadPriority
                   | ApnFatalErrorBadTopic
                   | ApnFatalErrorDeviceTokenNotForTopic
                   | ApnFatalErrorDuplicateHeaders
                   | ApnFatalErrorIdleTimeout
                   | ApnFatalErrorMissingDeviceToken
                   | ApnFatalErrorMissingTopic
                   | ApnFatalErrorPayloadEmpty
                   | ApnFatalErrorTopicDisallowed
                   | ApnFatalErrorBadCertificate
                   | ApnFatalErrorBadCertificateEnvironment
                   | ApnFatalErrorExpiredProviderToken
                   | ApnFatalErrorForbidden
                   | ApnFatalErrorInvalidProviderToken
                   | ApnFatalErrorMissingProviderToken
                   | ApnFatalErrorBadPath
                   | ApnFatalErrorMethodNotAllowed
                   | ApnFatalErrorUnregistered
                   | ApnFatalErrorPayloadTooLarge
                   | ApnFatalErrorOther Text
    deriving (ApnFatalError -> ApnFatalError -> Bool
(ApnFatalError -> ApnFatalError -> Bool)
-> (ApnFatalError -> ApnFatalError -> Bool) -> Eq ApnFatalError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApnFatalError -> ApnFatalError -> Bool
$c/= :: ApnFatalError -> ApnFatalError -> Bool
== :: ApnFatalError -> ApnFatalError -> Bool
$c== :: ApnFatalError -> ApnFatalError -> Bool
Eq, Int -> ApnFatalError -> ShowS
[ApnFatalError] -> ShowS
ApnFatalError -> FilePath
(Int -> ApnFatalError -> ShowS)
-> (ApnFatalError -> FilePath)
-> ([ApnFatalError] -> ShowS)
-> Show ApnFatalError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ApnFatalError] -> ShowS
$cshowList :: [ApnFatalError] -> ShowS
show :: ApnFatalError -> FilePath
$cshow :: ApnFatalError -> FilePath
showsPrec :: Int -> ApnFatalError -> ShowS
$cshowsPrec :: Int -> ApnFatalError -> ShowS
Show, (forall x. ApnFatalError -> Rep ApnFatalError x)
-> (forall x. Rep ApnFatalError x -> ApnFatalError)
-> Generic ApnFatalError
forall x. Rep ApnFatalError x -> ApnFatalError
forall x. ApnFatalError -> Rep ApnFatalError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApnFatalError x -> ApnFatalError
$cfrom :: forall x. ApnFatalError -> Rep ApnFatalError x
Generic)

instance FromJSON ApnFatalError where
    parseJSON :: Value -> Parser ApnFatalError
parseJSON Value
json =
        let result :: Result ApnFatalError
result = (Value -> Parser ApnFatalError) -> Value -> Result ApnFatalError
forall a b. (a -> Parser b) -> a -> Result b
parse Value -> Parser ApnFatalError
genericParser Value
json
        in
            case Result ApnFatalError
result of
                Success ApnFatalError
success -> ApnFatalError -> Parser ApnFatalError
forall (m :: * -> *) a. Monad m => a -> m a
return ApnFatalError
success
                Error FilePath
err -> case Value
json of
                                String Text
other -> ApnFatalError -> Parser ApnFatalError
forall (m :: * -> *) a. Monad m => a -> m a
return (ApnFatalError -> Parser ApnFatalError)
-> ApnFatalError -> Parser ApnFatalError
forall a b. (a -> b) -> a -> b
$ Text -> ApnFatalError
ApnFatalErrorOther Text
other
                                Value
_            -> FilePath -> Parser ApnFatalError
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
err

        where
            genericParser :: Value -> Parser ApnFatalError
genericParser = Options -> Value -> Parser ApnFatalError
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {
                                constructorTagModifier :: ShowS
constructorTagModifier = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
13,
                                sumEncoding :: SumEncoding
sumEncoding = SumEncoding
UntaggedValue
                            }

-- The type of transient error indicated by APNS
-- See https://apple.co/2RDCdWC table 8-6 for the meaning of each value.
data ApnTemporaryError = ApnTemporaryErrorTooManyProviderTokenUpdates
                       | ApnTemporaryErrorTooManyRequests
                       | ApnTemporaryErrorInternalServerError
                       | ApnTemporaryErrorServiceUnavailable
                       | ApnTemporaryErrorShutdown
    deriving (Int -> ApnTemporaryError
ApnTemporaryError -> Int
ApnTemporaryError -> [ApnTemporaryError]
ApnTemporaryError -> ApnTemporaryError
ApnTemporaryError -> ApnTemporaryError -> [ApnTemporaryError]
ApnTemporaryError
-> ApnTemporaryError -> ApnTemporaryError -> [ApnTemporaryError]
(ApnTemporaryError -> ApnTemporaryError)
-> (ApnTemporaryError -> ApnTemporaryError)
-> (Int -> ApnTemporaryError)
-> (ApnTemporaryError -> Int)
-> (ApnTemporaryError -> [ApnTemporaryError])
-> (ApnTemporaryError -> ApnTemporaryError -> [ApnTemporaryError])
-> (ApnTemporaryError -> ApnTemporaryError -> [ApnTemporaryError])
-> (ApnTemporaryError
    -> ApnTemporaryError -> ApnTemporaryError -> [ApnTemporaryError])
-> Enum ApnTemporaryError
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ApnTemporaryError
-> ApnTemporaryError -> ApnTemporaryError -> [ApnTemporaryError]
$cenumFromThenTo :: ApnTemporaryError
-> ApnTemporaryError -> ApnTemporaryError -> [ApnTemporaryError]
enumFromTo :: ApnTemporaryError -> ApnTemporaryError -> [ApnTemporaryError]
$cenumFromTo :: ApnTemporaryError -> ApnTemporaryError -> [ApnTemporaryError]
enumFromThen :: ApnTemporaryError -> ApnTemporaryError -> [ApnTemporaryError]
$cenumFromThen :: ApnTemporaryError -> ApnTemporaryError -> [ApnTemporaryError]
enumFrom :: ApnTemporaryError -> [ApnTemporaryError]
$cenumFrom :: ApnTemporaryError -> [ApnTemporaryError]
fromEnum :: ApnTemporaryError -> Int
$cfromEnum :: ApnTemporaryError -> Int
toEnum :: Int -> ApnTemporaryError
$ctoEnum :: Int -> ApnTemporaryError
pred :: ApnTemporaryError -> ApnTemporaryError
$cpred :: ApnTemporaryError -> ApnTemporaryError
succ :: ApnTemporaryError -> ApnTemporaryError
$csucc :: ApnTemporaryError -> ApnTemporaryError
Enum, ApnTemporaryError -> ApnTemporaryError -> Bool
(ApnTemporaryError -> ApnTemporaryError -> Bool)
-> (ApnTemporaryError -> ApnTemporaryError -> Bool)
-> Eq ApnTemporaryError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApnTemporaryError -> ApnTemporaryError -> Bool
$c/= :: ApnTemporaryError -> ApnTemporaryError -> Bool
== :: ApnTemporaryError -> ApnTemporaryError -> Bool
$c== :: ApnTemporaryError -> ApnTemporaryError -> Bool
Eq, Int -> ApnTemporaryError -> ShowS
[ApnTemporaryError] -> ShowS
ApnTemporaryError -> FilePath
(Int -> ApnTemporaryError -> ShowS)
-> (ApnTemporaryError -> FilePath)
-> ([ApnTemporaryError] -> ShowS)
-> Show ApnTemporaryError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ApnTemporaryError] -> ShowS
$cshowList :: [ApnTemporaryError] -> ShowS
show :: ApnTemporaryError -> FilePath
$cshow :: ApnTemporaryError -> FilePath
showsPrec :: Int -> ApnTemporaryError -> ShowS
$cshowsPrec :: Int -> ApnTemporaryError -> ShowS
Show, (forall x. ApnTemporaryError -> Rep ApnTemporaryError x)
-> (forall x. Rep ApnTemporaryError x -> ApnTemporaryError)
-> Generic ApnTemporaryError
forall x. Rep ApnTemporaryError x -> ApnTemporaryError
forall x. ApnTemporaryError -> Rep ApnTemporaryError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApnTemporaryError x -> ApnTemporaryError
$cfrom :: forall x. ApnTemporaryError -> Rep ApnTemporaryError x
Generic)

instance FromJSON ApnTemporaryError where
    parseJSON :: Value -> Parser ApnTemporaryError
parseJSON = Options -> Value -> Parser ApnTemporaryError
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions { constructorTagModifier :: ShowS
constructorTagModifier = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
17 }