diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,13 @@ +0.1.1.0 +======= + +- Let the client send alerts with no title + +0.1.0.9 +======= + +- Add "semigroups" as a dependency for older ghc versions + 0.1.0.8 ======= diff --git a/push-notify-apn.cabal b/push-notify-apn.cabal --- a/push-notify-apn.cabal +++ b/push-notify-apn.cabal @@ -1,5 +1,5 @@ name: push-notify-apn -version: 0.1.0.8 +version: 0.1.1.0 synopsis: Send push notifications to mobile iOS devices description: push-notify-apn is a library and command line utility that can be used to send @@ -32,6 +32,7 @@ , http2 , http2-client , random + , semigroups , text , time , tls @@ -48,6 +49,7 @@ , push-notify-apn , bytestring , optparse-applicative + , semigroups , text default-language: Haskell2010 @@ -57,6 +59,8 @@ main-is: Spec.hs build-depends: base , push-notify-apn + , aeson + , hspec ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 diff --git a/src/Network/PushNotify/APN.hs b/src/Network/PushNotify/APN.hs --- a/src/Network/PushNotify/APN.hs +++ b/src/Network/PushNotify/APN.hs @@ -7,8 +7,9 @@ -- Portability: portable -- -- Send push notifications using Apple's HTTP2 APN API +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TupleSections #-} module Network.PushNotify.APN ( newSession @@ -20,8 +21,10 @@ , sendSilentMessage , sendRawMessage , alertMessage + , bodyMessage , emptyMessage , setAlertMessage + , setMessageBody , setBadge , setCategory , setSound @@ -39,60 +42,60 @@ , ApnToken ) where -import Control.Concurrent -import Control.Concurrent.QSem -import Control.Exception -import Control.Monad -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.Text (Text) -import Data.Time.Clock.POSIX -import Data.X509 -import Data.X509.CertificateStore -import GHC.Generics -import Network.HTTP2.Client -import Network.HTTP2.Client.FrameConnection -import 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 Control.Concurrent +import Control.Concurrent.QSem +import Control.Exception +import Control.Monad +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.Text (Text) +import Data.Time.Clock.POSIX +import Data.X509 +import Data.X509.CertificateStore +import GHC.Generics +import Network.HTTP2.Client +import Network.HTTP2.Client.FrameConnection +import 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 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.HTTP2 as HTTP2 -import qualified Network.HPACK as HTTP2 +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 - { apnSessionPool :: !(IORef [ApnConnection]) - , apnSessionConnectionInfo :: !ApnConnectionInfo - , apnSessionConnectionManager :: !ThreadId - , apnSessionOpen :: !(IORef Bool)} + { apnSessionPool :: !(IORef [ApnConnection]) + , apnSessionConnectionInfo :: !ApnConnectionInfo + , apnSessionConnectionManager :: !ThreadId + , apnSessionOpen :: !(IORef Bool)} -- | Information about an APN connection data ApnConnectionInfo = ApnConnectionInfo - { aciCertPath :: !FilePath - , aciCertKey :: !FilePath - , aciCaPath :: !FilePath - , aciHostname :: !Text - , aciMaxConcurrentStreams :: !Int - , aciTopic :: !ByteString } + { aciCertPath :: !FilePath + , aciCertKey :: !FilePath + , aciCaPath :: !FilePath + , aciHostname :: !Text + , aciMaxConcurrentStreams :: !Int + , aciTopic :: !ByteString } -- | A connection to an APN API server data ApnConnection = ApnConnection @@ -128,6 +131,7 @@ -- | The result of a send request data ApnMessageResult = ApnMessageResultOk | ApnMessageResultFatalError + | ApnMessageResultBadDeviceToken | ApnMessageResultTemporaryError | ApnMessageResultTokenNoLongerValid deriving (Enum, Eq, Show) @@ -137,29 +141,31 @@ -- | The specification of a push notification's message body data JsonApsAlert = JsonApsAlert - { jaaTitle :: !Text + { jaaTitle :: !(Maybe Text) -- ^ A short string describing the purpose of the notification. - , jaaBody :: !Text + , jaaBody :: !Text -- ^ The text of the alert message. } deriving (Generic, Show) instance ToJSON JsonApsAlert where toJSON = genericToJSON defaultOptions - { fieldLabelModifier = drop 3 . map toLower } + { fieldLabelModifier = drop 3 . map toLower + , omitNothingFields = True + } -- | Push notification message's content data JsonApsMessage -- | Push notification message's content = JsonApsMessage - { jamAlert :: !(Maybe JsonApsAlert) + { jamAlert :: !(Maybe JsonApsAlert) -- ^ A text to display in the notification - , jamBadge :: !(Maybe Int) + , jamBadge :: !(Maybe Int) -- ^ A number to display next to the app's icon. If set to (Just 0), the number is removed. - , jamSound :: !(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. - , jamCategory :: !(Maybe Text) + , jamCategory :: !(Maybe Text) -- ^ The category of the notification. Must be registered by the app beforehand. } deriving (Generic, Show) @@ -231,6 +237,14 @@ -- ^ The modified message alertMessage title text = setAlertMessage title text 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 = setMessageBody text emptyMessage + -- | Set the alert part of an APN message setAlertMessage :: Text @@ -243,8 +257,22 @@ -- ^ The modified message setAlertMessage title text a = a { jamAlert = Just jam } where - jam = JsonApsAlert title text + jam = JsonApsAlert (Just title) 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 a = a { jamAlert = Just newJaa } + where + newJaa = case jamAlert a of + Nothing -> JsonApsAlert Nothing text + Just jaa -> jaa { jaaBody = text } + -- | Remove the alert part of an APN message clearAlertMessage :: JsonApsMessage @@ -261,9 +289,9 @@ data JsonAps -- | A push notification message = JsonAps - { jaAps :: !JsonApsMessage + { jaAps :: !JsonApsMessage -- ^ The main content of the message - , jaAppSpecificContent :: !(Maybe Text) + , jaAppSpecificContent :: !(Maybe Text) -- ^ Extra information to be used by the receiving app } deriving (Generic, Show) @@ -334,11 +362,11 @@ -- to call this function. closeSession :: ApnSession -> IO () closeSession s = do - isOpen <- atomicModifyIORef' (apnSessionOpen s) (\a -> (False, a)) + isOpen <- atomicModifyIORef' (apnSessionOpen s) (False,) unless isOpen $ error "Session is already closed" killThread (apnSessionConnectionManager s) let ioref = apnSessionPool s - openConnections <- atomicModifyIORef' ioref (\conns -> ([], conns)) + openConnections <- atomicModifyIORef' ioref ([],) mapM_ closeApnConnection openConnections -- | Check whether a session is open or has been closed @@ -529,21 +557,23 @@ let pph hStreamId hStream hHeaders hIfc hOfc = print hHeaders response <- waitStream stream isfc pph - let (errOrHeaders, _, _) = response + let (errOrHeaders, frameResponses, _) = response case errOrHeaders of Left err -> return ApnMessageResultTemporaryError Right hdrs1 -> do let Just status = DL.lookup ":status" hdrs1 return $ case status of "200" -> ApnMessageResultOk - "400" -> ApnMessageResultFatalError + "400" -> if Right "{\"reason\":\"BadDeviceToken\"}" `DL.elem` frameResponses + then ApnMessageResultBadDeviceToken + else ApnMessageResultFatalError "403" -> ApnMessageResultFatalError "405" -> ApnMessageResultFatalError "410" -> ApnMessageResultTokenNoLongerValid "413" -> ApnMessageResultFatalError "429" -> ApnMessageResultTemporaryError "500" -> ApnMessageResultTemporaryError - "503" -> ApnMessageResultTemporaryError + "503" -> ApnMessageResultTemporaryError in StreamDefinition init handler case res of Left _ -> return ApnMessageResultTemporaryError -- Too much concurrency diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,2 +1,1 @@ -main :: IO () -main = putStrLn "Test suite not yet implemented" +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}