diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -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 ======= 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.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 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 @@ -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 diff --git a/test/Network/PushNotify/APNSpec.hs b/test/Network/PushNotify/APNSpec.hs --- a/test/Network/PushNotify/APNSpec.hs +++ b/test/Network/PushNotify/APNSpec.hs @@ -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 ($)