push-notify-apn 0.4.0.3 → 0.5.0.0
raw patch · 5 files changed
+246/−31 lines, 5 filesdep ~http2
Dependency ranges changed: http2
Files
- app/Main.hs +5/−5
- changelog.md +8/−0
- push-notify-apn.cabal +1/−1
- src/Network/PushNotify/APN.hs +162/−20
- test/Network/PushNotify/APNSpec.hs +70/−5
app/Main.hs view
@@ -90,9 +90,9 @@ text = T.intercalate ":" (drop 3 parts) title = parts !! 2 sound = parts !! 1- payload = setSound sound . alertMessage title $ text- message = newMessage payload- in (sendMessage sess token (jwt o) message >>= TI.putStrLn . T.pack . show) >> loop sess+ payload = setSound sound . alertMessage title text $ Nothing+ message = newMessage payload + in (sendMessage sess token (jwt o) Nothing message >>= TI.putStrLn . T.pack . show) >> loop sess else case line of "close" -> closeSession sess >> loop sess "reset" -> mkSession >>= loop@@ -101,8 +101,8 @@ in loop session else do when (isNothing $ text o) $ error "You need to specify a message with -m"- let payload = alertMessage "push-notify-apn" (T.pack $ fromJust $ text o)+ let payload = alertMessage "push-notify-apn" (T.pack $ fromJust $ text o) Nothing message = newMessage payload forM_ (tokens o) $ \token -> let apntoken = hexEncodedToken . T.pack $ token- in sendMessage session apntoken (jwt o) message >>= print+ in sendMessage session apntoken (jwt o) Nothing message >>= print
changelog.md view
@@ -1,3 +1,11 @@+0.5.0.0+=======++- Add newWidgetMessage function for creating widget notifications with content-changed flag+- Add sendWidgetNotification convenience function for sending widget notifications+- Add ApnPushType enum for specifying push type (currently supports alert, background, and widgets)+- Add ApnPriority enum for specifying push priority, with defaults based on the push type+ 0.4.0.3 =======
push-notify-apn.cabal view
@@ -1,5 +1,5 @@ name: push-notify-apn-version: 0.4.0.3+version: 0.5.0.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
src/Network/PushNotify/APN.hs view
@@ -39,22 +39,30 @@ , clearCategory , setMutableContent , clearMutableContent+ , setInterruptionLevel+ , clearInterruptionLevel , clearSound , addSupplementalField , closeSession , isConnectionOpen , isSessionOpen , isOpen+ , sendWidgetNotification+ , newWidgetMessage , ApnSession- , JsonAps+ , JsonAps(..) , JsonApsAlert , JsonApsMessage , ApnMessageResult(..) , ApnFatalError(..) , ApnTemporaryError(..) , ApnToken(..)+ , InterruptionLevel(..)+ , ApnPushType(..)+ , ApnPriority(..) ) where +import Control.Applicative import Control.Concurrent import Control.Exception.Lifted (Exception, try, bracket_, throw, throwIO) import Control.Monad@@ -164,6 +172,8 @@ -- ^ A short string describing the purpose of the notification. , jaaBody :: !Text -- ^ The text of the alert message.+ , jaaSubtitle :: !(Maybe Text)+ -- ^ Additional information that explains the purpose of the notification. } deriving (Generic, Show) instance ToJSON JsonApsAlert where@@ -178,6 +188,58 @@ , omitNothingFields = True } +-- | The interruption level (urgency) of the notification.+data InterruptionLevel = InterruptionLevelPassive+ | InterruptionLevelActive+ | InterruptionLevelTimeSensitive+ | InterruptionLevelCritical+ deriving (Enum, Eq, Show, Generic)++instance ToJSON InterruptionLevel where+ toJSON = String . T.pack . hyphenate . drop 17 . show+ where+ hyphenate "TimeSensitive" = "time-sensitive"+ hyphenate other = map toLower other++instance FromJSON InterruptionLevel where+ parseJSON = withText "InterruptionLevel" $ \t -> case t of+ "passive" -> pure InterruptionLevelPassive+ "active" -> pure InterruptionLevelActive+ "time-sensitive" -> pure InterruptionLevelTimeSensitive+ "critical" -> pure InterruptionLevelCritical+ _ -> fail "Invalid interruption level"++-- | The push type for the notification (for HTTP/2 apns-push-type header).+data ApnPushType = ApnPushTypeAlert+ | ApnPushTypeBackground+ | ApnPushTypeWidgets+ deriving (Enum, Eq, Show, Generic)++-- | The priority of the notification (for HTTP/2 apns-priority header).+data ApnPriority = ApnPriorityImmediate -- ^ 10: Send immediately, triggers alerts/sounds/badges+ | ApnPriorityPowerEfficient -- ^ 5: Send based on power considerations, required for background notifications+ | ApnPriorityLow -- ^ 1: Prioritize device power over delivery+ deriving (Enum, Eq, Show, Generic)++-- | Get the default priority for a push type according to APNS spec+-- Returns Nothing for widgets (no priority header should be sent)+defaultPriorityForPushType :: ApnPushType -> Maybe ApnPriority+defaultPriorityForPushType ApnPushTypeBackground = Just ApnPriorityPowerEfficient -- Required by spec+defaultPriorityForPushType ApnPushTypeAlert = Just ApnPriorityImmediate+defaultPriorityForPushType ApnPushTypeWidgets = Nothing -- No priority header for widgets++instance ToJSON ApnPushType where+ toJSON ApnPushTypeAlert = String "alert"+ toJSON ApnPushTypeBackground = String "background" + toJSON ApnPushTypeWidgets = String "widgets"++instance FromJSON ApnPushType where+ parseJSON = withText "ApnPushType" $ \t -> case t of+ "alert" -> pure ApnPushTypeAlert+ "background" -> pure ApnPushTypeBackground+ "widgets" -> pure ApnPushTypeWidgets+ _ -> fail "Invalid push type"+ -- | Push notification message's content data JsonApsMessage -- | Push notification message's content@@ -194,11 +256,15 @@ -- ^ The category of the notification. Must be registered by the app beforehand. , jamMutableContent :: !(Maybe Int) -- ^ Whether the message has mutable content.+ , jamInterruptionLevel :: !(Maybe InterruptionLevel)+ -- ^ The interruption level of the notification.+ , jamContentChanged :: !(Maybe Bool)+ -- ^ Whether the content has changed (for widgets). } deriving (Generic, Show) -- | Create an empty apn message emptyMessage :: JsonApsMessage-emptyMessage = JsonApsMessage Nothing Nothing Nothing Nothing Nothing+emptyMessage = JsonApsMessage Nothing Nothing Nothing Nothing Nothing Nothing Nothing -- | Set a sound for an APN message setSound@@ -254,6 +320,24 @@ -- ^ The modified message clearMutableContent a = a { jamMutableContent = Nothing } +-- | Set the interruption level part of an APN message+setInterruptionLevel+ :: InterruptionLevel+ -- ^ The interruption level to set+ -> JsonApsMessage+ -- ^ The message to modify+ -> JsonApsMessage+ -- ^ The modified message+setInterruptionLevel i a = a { jamInterruptionLevel = Just i }++-- | Clear the interruption level part of an APN message+clearInterruptionLevel+ :: JsonApsMessage+ -- ^ The message to modify+ -> JsonApsMessage+ -- ^ The modified message+clearInterruptionLevel a = a { jamInterruptionLevel = Nothing }+ -- | Set the badge part of an APN message setBadge :: Int@@ -278,9 +362,11 @@ -- ^ The title of the message -> Text -- ^ The body of the message+ -> Maybe Text+ -- ^ The subtitle of the message -> JsonApsMessage -- ^ The modified message-alertMessage title text = setAlertMessage title text emptyMessage+alertMessage title text subtitle = setAlertMessage title text subtitle emptyMessage -- | Create a new APN message with a body and no title bodyMessage@@ -296,13 +382,15 @@ -- ^ The title of the message -> Text -- ^ The body of the message+ -> Maybe Text+ -- ^ The subtitle of the message -> JsonApsMessage -- ^ The message to alter -> JsonApsMessage -- ^ The modified message-setAlertMessage title text a = a { jamAlert = Just jam }+setAlertMessage title text subtitle a = a { jamAlert = Just jam } where- jam = JsonApsAlert (Just title) text+ jam = JsonApsAlert (Just title) text subtitle -- | Set the body of an APN message without affecting the title setMessageBody@@ -315,7 +403,7 @@ setMessageBody text a = a { jamAlert = Just newJaa } where newJaa = case jamAlert a of- Nothing -> JsonApsAlert Nothing text+ Nothing -> JsonApsAlert Nothing text Nothing Just jaa -> jaa { jaaBody = text } -- | Remove the alert part of an APN message@@ -330,6 +418,8 @@ toJSON = genericToJSON defaultOptions { fieldLabelModifier = \s -> case drop 3 s of "MutableContent" -> "mutable-content"+ "InterruptionLevel" -> "interruption-level"+ "ContentChanged" -> "content-changed" other -> map toLower other } @@ -337,6 +427,8 @@ parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = \s -> case drop 3 s of "mutable-content" -> "MutableContent"+ "interruption-level" -> "InterruptionLevel"+ "content-changed" -> "ContentChanged" other -> map toLower other } @@ -387,6 +479,12 @@ newMessageWithCustomPayload message payload = JsonAps message (Just payload) M.empty +-- | Create a new APN message for widget notifications with content-changed flag+newWidgetMessage :: JsonAps+newWidgetMessage = JsonAps widgetMessage Nothing M.empty+ where+ widgetMessage = emptyMessage { jamContentChanged = Just True }+ -- | Add a supplemental field to be sent over with the notification -- -- NB: The field 'aps' must not be modified; attempting to do so will@@ -620,13 +718,15 @@ -- ^ Device to send the message to -> Maybe ByteString -- ^ JWT Bearer Token+ -> Maybe ApnPriority+ -- ^ Priority (Nothing uses default) -> ByteString -- ^ The message to send -> IO ApnMessageResult -- ^ The response from the APN server-sendRawMessage s deviceToken mJwtToken payload = catchErrors $+sendRawMessage s deviceToken mJwtToken mPriority payload = catchErrors $ withConnection s $ \c ->- sendApnRaw c deviceToken mJwtToken payload+ sendApnRaw c deviceToken mJwtToken ApnPushTypeAlert mPriority payload -- | Send a push notification message. sendMessage@@ -636,16 +736,19 @@ -- ^ Device to send the message to -> Maybe ByteString -- ^ JWT Bearer Token+ -> Maybe ApnPriority+ -- ^ Priority (Nothing uses default) -> JsonAps -- ^ The message to send -> IO ApnMessageResult -- ^ The response from the APN server-sendMessage s token mJwt payload = catchErrors $+sendMessage s token mJwt mPriority payload = catchErrors $ withConnection s $ \c ->- sendApnRaw c token mJwt message+ sendApnRaw c token mJwt ApnPushTypeAlert mPriority message where message = L.toStrict $ encode payload -- | Send a silent push notification+-- Note: This function automatically uses priority 5 as required by APNS spec for background notifications sendSilentMessage :: ApnSession -- ^ Session to use@@ -657,9 +760,27 @@ -- ^ The response from the APN server sendSilentMessage s token mJwt = catchErrors $ withConnection s $ \c ->- sendApnRaw c token mJwt message+ sendApnRaw c token mJwt ApnPushTypeBackground (Just ApnPriorityPowerEfficient) message where message = "{\"aps\":{\"content-available\":1}}" +-- | Send a widget notification+-- Note: This function omits priority header by default (as per Apple's widget documentation)+sendWidgetNotification+ :: ApnSession+ -- ^ Session to use+ -> ApnToken+ -- ^ Device to send the message to+ -> Maybe ByteString+ -- ^ JWT Bearer Token+ -> Maybe ApnPriority+ -- ^ Priority (Nothing omits priority header, following Apple's widget example)+ -> IO ApnMessageResult+ -- ^ The response from the APN server+sendWidgetNotification s token mJwt mPriority = catchErrors $+ withConnection s $ \c ->+ sendApnRaw c token mJwt ApnPushTypeWidgets mPriority message+ where message = L.toStrict $ encode newWidgetMessage+ ensureSessionOpen :: ApnSession -> IO () ensureSessionOpen s = do open <- isSessionOpen s@@ -678,15 +799,20 @@ -- ^ Device to send the message to -> Maybe ByteString -- ^ JWT Bearer Token+ -> ApnPushType+ -- ^ Push type (alert, background, widgets)+ -> Maybe ApnPriority+ -- ^ Priority (Nothing uses default for push type) -> ByteString -- ^ The message to send -> ClientIO ApnMessageResult-sendApnRaw connection deviceToken mJwtBearerToken message = bracket_+sendApnRaw connection deviceToken mJwtBearerToken pushType mPriority message = bracket_ (lift $ waitQSem (apnConnectionWorkerPool connection)) (lift $ signalQSem (apnConnectionWorkerPool connection)) $ do let aci = apnConnectionInfo connection- requestHeaders = maybe (defaultHeaders hostname token1 topic)- (\bearerToken -> (defaultHeaders hostname token1 topic) <> [ ( "authorization", "bearer " <> bearerToken ) ])+ priority = mPriority <|> (defaultPriorityForPushType pushType)+ requestHeaders = maybe (defaultHeaders hostname token1 topic pushType priority)+ (\bearerToken -> (defaultHeaders hostname token1 topic pushType priority) <> [ ( "authorization", "bearer " <> bearerToken ) ]) mJwtBearerToken hostname = aciHostname aci topic = aciTopic aci@@ -742,12 +868,28 @@ getHeaderEx :: HTTP.HeaderName -> [HTTP2.Header] -> ByteString getHeaderEx name headers = fromMaybe (throw $ ApnExceptionMissingHeader name) (DL.lookup name headers) - defaultHeaders :: Text -> ByteString -> ByteString -> [(HTTP.HeaderName, ByteString)]- defaultHeaders hostname token topic = [ ( ":method", "POST" )- , ( ":scheme", "https" )- , ( ":authority", TE.encodeUtf8 hostname )- , ( ":path", "/3/device/" `S.append` token )- , ( "apns-topic", topic ) ]+ defaultHeaders :: Text -> ByteString -> ByteString -> ApnPushType -> Maybe ApnPriority -> [(HTTP.HeaderName, ByteString)]+ defaultHeaders hostname token topic pushType mPriority = + [ ( ":method", "POST" )+ , ( ":scheme", "https" )+ , ( ":authority", TE.encodeUtf8 hostname )+ , ( ":path", "/3/device/" `S.append` token )+ , ( "apns-topic", adjustedTopic )+ , ( "apns-push-type", pushTypeHeader )+ ] <> maybe [] (\p -> [("apns-priority", priorityValue p)]) mPriority+ where+ pushTypeHeader = case pushType of+ ApnPushTypeAlert -> "alert"+ ApnPushTypeBackground -> "background" + ApnPushTypeWidgets -> "widgets"+ adjustedTopic = case pushType of+ ApnPushTypeWidgets -> topic `S.append` ".push-type.widgets"+ ApnPushTypeAlert -> topic+ ApnPushTypeBackground -> topic+ priorityValue :: ApnPriority -> ByteString+ priorityValue ApnPriorityImmediate = "10"+ priorityValue ApnPriorityPowerEfficient = "5"+ priorityValue ApnPriorityLow = "1" catchErrors :: ClientIO ApnMessageResult -> IO ApnMessageResult
test/Network/PushNotify/APNSpec.hs view
@@ -11,17 +11,34 @@ describe "JsonApsMessage" $ context "JSON encoder" $ do it "encodes an APNS message with a title and body" $- toJSON (alertMessage "hello" "world") `shouldBe`+ toJSON (alertMessage "hello" "world" Nothing) `shouldBe` object [ "category" .= Null, "sound" .= Null, "badge" .= Null, "mutable-content" .= Null,+ "interruption-level" .= Null,+ "content-changed" .= Null, "alert" .= object [ "title" .= String "hello", "body" .= String "world" ] ]+ it "encodes an APNS message with a title, subtitle and body" $+ toJSON (alertMessage "hello" "world" (Just "there")) `shouldBe`+ object [+ "category" .= Null,+ "sound" .= Null,+ "badge" .= Null,+ "mutable-content" .= Null,+ "interruption-level" .= Null,+ "content-changed" .= Null,+ "alert" .= object [+ "title" .= String "hello",+ "subtitle" .= String "there",+ "body" .= String "world"+ ]+ ] it "encodes an APNS message with a title and no body" $ toJSON (bodyMessage "hello world") `shouldBe` object [@@ -29,25 +46,27 @@ "sound" .= Null, "badge" .= Null, "mutable-content" .= Null,+ "interruption-level" .= Null,+ "content-changed" .= Null, "alert" .= object [ "body" .= String "hello world" ] ] describe "JsonAps" $ context "JSON encoder" $ do it "encodes normally when there are no supplemental fields" $- toJSON (newMessage (alertMessage "hello" "world")) `shouldBe` object [- "aps" .= alertMessage "hello" "world",+ toJSON (newMessage (alertMessage "hello" "world" Nothing)) `shouldBe` object [+ "aps" .= alertMessage "hello" "world" Nothing, "appspecificcontent" .= Null, "data" .= object [] ] it "encodes supplemental fields" $ do- let msg = newMessage (alertMessage "hello" "world")+ let msg = newMessage (alertMessage "hello" "world" Nothing) & addSupplementalField "foo" ("bar" :: String) & addSupplementalField "aaa" ("qux" :: String) toJSON msg `shouldBe` object [- "aps" .= alertMessage "hello" "world",+ "aps" .= alertMessage "hello" "world" Nothing, "appspecificcontent" .= Null, "data" .= object ["aaa" .= String "qux", "foo" .= String "bar"] ]@@ -64,5 +83,51 @@ context "JSON decoder" $ it "decodes the error correctly" $ eitherDecode "\"TooManyProviderTokenUpdates\"" `shouldBe` Right ApnTemporaryErrorTooManyProviderTokenUpdates++ describe "Widget notifications" $+ context "JSON encoder" $ do+ it "encodes widget message with content-changed flag" $+ let (JsonAps widgetMsg _ _) = newWidgetMessage+ in toJSON widgetMsg `shouldBe`+ object [+ "category" .= Null,+ "sound" .= Null,+ "badge" .= Null,+ "mutable-content" .= Null,+ "interruption-level" .= Null,+ "content-changed" .= Bool True,+ "alert" .= Null+ ]+ + it "encodes complete widget message" $+ toJSON newWidgetMessage `shouldBe` object [+ "aps" .= object [+ "category" .= Null,+ "sound" .= Null,+ "badge" .= Null,+ "mutable-content" .= Null,+ "interruption-level" .= Null,+ "content-changed" .= Bool True,+ "alert" .= Null+ ],+ "appspecificcontent" .= Null,+ "data" .= object []+ ]++ describe "ApnPushType" $ do+ context "JSON encoder" $ do+ it "encodes alert push type" $+ toJSON ApnPushTypeAlert `shouldBe` String "alert"+ it "encodes background push type" $+ toJSON ApnPushTypeBackground `shouldBe` String "background"+ it "encodes widgets push type" $+ toJSON ApnPushTypeWidgets `shouldBe` String "widgets"+ context "JSON decoder" $ do+ it "decodes alert push type" $+ eitherDecode "\"alert\"" `shouldBe` Right ApnPushTypeAlert+ it "decodes background push type" $+ eitherDecode "\"background\"" `shouldBe` Right ApnPushTypeBackground+ it "decodes widgets push type" $+ eitherDecode "\"widgets\"" `shouldBe` Right ApnPushTypeWidgets where (&) = flip ($)