diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,25 @@ +# Changelog + +`fcm-client` uses [PVP Versioning][1]. +The changelog is available [on GitHub][2]. + +## 0.2.0.0 — Sep 18, 2019 + +* [#3](https://github.com/holmusk/fcm-client/issues/3): + Fix bug serializing the `registration_ids` field. + (by [@bitc](https://github.com/bitc)) +* [#6](https://github.com/holmusk/fcm-client/pull/6): + Add support for the `android_channel_id` field. + (by [@bitc](https://github.com/bitc)) +* [#7](https://github.com/holmusk/fcm-client/issues/7): + Support latest 3 major GHC versions (on CI as well). + (by [@chshersh](https://github.com/chshersh)) +* [#4](https://github.com/holmusk/fcm-client/pull/4): + Add support for GHC-8.2.2. + (by [@bitc](https://github.com/bitc)) +* [#2](https://github.com/Holmusk/fcm-client/pull/2): + Updated dependencies, code cleanup. + (by [@andreyk0](https://github.com/andreyk0)) + +[1]: https://pvp.haskell.org +[2]: https://github.com/holmusk/fcm-client/releases diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,4 +2,5 @@ Simple model/client for [firebase cloud messaging](https://firebase.google.com/docs/cloud-messaging/concept-options#notifications_and_data_messages). -[Example](cli/Main.hs) + * [FCM communication example](cli/Main.hs) + * [Message composition with lenses example](test/Spec.hs) diff --git a/cli/CliArgs.hs b/cli/CliArgs.hs --- a/cli/CliArgs.hs +++ b/cli/CliArgs.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE RecordWildCards #-} - module CliArgs ( CliArgs (..) , CliCmd (..) @@ -8,7 +6,9 @@ ) where import Control.Lens +import Data.Default.Class import Data.List.NonEmpty (nonEmpty) +import Data.Monoid ((<>)) import FCMClient.Types import Options.Applicative import System.Environment @@ -22,13 +22,13 @@ , cliCmd :: CliCmd } -data CliJsonBatchArgs = CliJsonBatchArgs { cliBatchInput :: (Maybe FilePath) - , cliBatchOutput :: (Maybe FilePath) +data CliJsonBatchArgs = CliJsonBatchArgs { cliBatchInput :: Maybe FilePath + , cliBatchOutput :: Maybe FilePath , cliBatchConc :: Int } data CliCmd = CliCmdSendJsonBatch CliJsonBatchArgs - | CliCmdSendMessage (FCMMessage -> FCMMessage) + | CliCmdSendMessage FCMMessage parseArgs :: Maybe String -- ^ default auth key from shell env @@ -52,30 +52,31 @@ parseCliJsonBatchArgs :: Parser CliJsonBatchArgs parseCliJsonBatchArgs = CliJsonBatchArgs - <$> (optional $ strOption + <$> optional ( strOption ( long "input" <> short 'i' <> help "Batch input file, one JSON object per line (or STDIN).")) - <*> (optional $ strOption + <*> optional ( strOption ( long "output" <> short 'o' <> help "Batch input file (or STDOUT).")) - <*> (option (auto >>= (\c -> if (c < 1) then error "Concurrency must be >= 1" else return c)) + <*> option (auto >>= (\c -> if c < 1 then error "Concurrency must be >= 1" else return c)) ( long "concurrency" <> short 'c' <> value 1 <> showDefaultWith show - <> help "How many HTTP requests to run in concurrently.")) + <> help "How many HTTP requests to run in concurrently.") parseCliCmdSendMessage :: Parser CliCmd -parseCliCmdSendMessage = CliCmdSendMessage - <$> ( ( fmap (set fcmTo) +parseCliCmdSendMessage = CliCmdSendMessage <$> + ( + ( fmap (set fcmTo) (optionalText ( long "to" <> short 't' <> help "message to (reg token, notification key or topic)")) - <|> fmap (set fcmRegistrationIDs) + <|> fmap (set fcmRegistrationIds) (textList ( long "registration-id" <> short 'r' @@ -87,46 +88,46 @@ <> help "The message target. Supported condition: Topic, formatted as \"'yourTopic' in topics\". This value is case-insensitive. Supported operators: &&, ||. Maximum two operators per topic message supported.")) ) - <..> fmap (set $ fcmCollapseKey) + <..> fmap (set fcmCollapseKey) (optionalText ( long "collapse-key" <> help "Identifies a group of messages that can be collapsed, so that only the last message gets sent when delivery can be resumed.")) - <..> fmap (set $ J.fcmPriority) + <..> fmap (set J.fcmPriority) (optionalText ( long "priority" <> help "Sets the priority of the message. Valid values are 'normal' and 'high'. On iOS, these correspond to APNs priorities 5 and 10.")) - <..> fmap (set $ fcmContentAvailable) + <..> fmap (set fcmContentAvailable) (switch ( long "content-available" <> help "On iOS, use this field to represent content-available in the APNS payload. When a notification or message is sent and this is set to true, an inactive client app is awoken. On Android, data messages wake the app by default. On Chrome, currently not supported.")) - <..> fmap (set $ fcmDelayWhileIdle) + <..> fmap (set fcmDelayWhileIdle) (switch ( long "delay-while-idle" <> help "When this parameter is set to true, it indicates that the message should not be sent until the device becomes active. The default value is false.")) - <..> fmap (set $ fcmTimeToLive) + <..> fmap (set fcmTimeToLive) (optional $ option auto ( long "time-to-live" <> help "This parameter specifies how long (in seconds) the message should be kept in FCM storage if the device is offline. The maximum time to live supported is 4 weeks, and the default value is 4 weeks. For more information, see Setting the lifespan of a message.")) - <..> fmap (set $ fcmRestrictedPackageName) + <..> fmap (set fcmRestrictedPackageName) (optionalText ( long "restricted-package-name" <> help "This parameter specifies the package name of the application where the registration tokens must match in order to receive the message.")) - <..> fmap (set $ fcmDryRun) + <..> fmap (set fcmDryRun) (switch ( long "dry-run" <> help "This parameter, when set to true, allows developers to test a request without actually sending a message. The default value is false.")) - <..> fmap (set $ fcmData) - (fmap (J.decode . LB.pack) (strOption + <..> fmap (set fcmData . J.decode . LB.pack) + (strOption ( long "data" <> short 'd' - <> help "This parameter specifies the custom key-value pairs of the message's payload. For example, with data:{\"score\":\"3x1\"}: On iOS, if the message is sent via APNS, it represents the custom data fields. If it is sent via FCM connection server, it would be represented as key value dictionary in AppDelegate application:didReceiveRemoteNotification:. On Android, this would result in an intent extra named score with the string value 3x1. The key should not be a reserved word (\"from\" or any word starting with \"google\" or \"gcm\"). Do not use any of the words defined in this table (such as collapse_key). ONLY values in string types are supported. You have to convert values in objects or other non-string data types (e.g., integers or booleans) to string."))) + <> help "This parameter specifies the custom key-value pairs of the message's payload. For example, with data:{\"score\":\"3x1\"}: On iOS, if the message is sent via APNS, it represents the custom data fields. If it is sent via FCM connection server, it would be represented as key value dictionary in AppDelegate application:didReceiveRemoteNotification:. On Android, this would result in an intent extra named score with the string value 3x1. The key should not be a reserved word (\"from\" or any word starting with \"google\" or \"gcm\"). Do not use any of the words defined in this table (such as collapse_key). ONLY values in string types are supported. You have to convert values in objects or other non-string data types (e.g., integers or booleans) to string.")) <..> fmap (set $ fcmWithNotification . fcmTitle) (optionalText @@ -140,6 +141,11 @@ <> short 'b' <> help "notification body text")) + <..> fmap (set $ fcmWithNotification . fcmAndroidChannelId) + (optionalText + ( long "android-channel-id" + <> help "Android: The notification's channel id (new in Android O). The app must create a channel with this channel ID before any notification with this channel ID is received. If you don't send this channel ID in the request, or if the channel ID provided has not yet been created by the app, FCM uses the channel ID specified in the app manifest.")) + <..> fmap (set $ fcmWithNotification . fcmIcon) (optionalText ( long "icon" @@ -189,10 +195,11 @@ (optionalText ( long "title-loc-args" <> help "IOS: Indicates the string value to replace format specifiers in the title string for localization.Corresponds to \"title-loc-args\" in the APNs payload. Android: Indicates the string value to replace format specifiers in the title string for localization. For more information, see Formatting strings.")) - ) + <*> pure def + ) where optionalText opt = fmap (fmap T.pack) $ optional $ strOption opt - textList opt = fmap nonEmpty $ many $ fmap T.pack $ strOption opt + textList opt = fmap nonEmpty $ many $ T.pack <$> strOption opt -- | Chains functions through Applicative @@ -209,8 +216,8 @@ maybeAuthKey <- lookupEnv "FCM_AUTH_KEY" let opts = info (helper <*> parseArgs maybeAuthKey) ( fullDesc - <> progDesc "Simple FCM CLI client, send a test message or a JSON batch from a file." <> header "Simple FCM CLI client, send a test message or a JSON batch from a file." + <> progDesc ("E.g. " <> " fcm-client -k AUTH_KEY message --title Test --to /topics/mytopic --color '#FF0000' -d test") ) execParser opts >>= rwa diff --git a/cli/Main.hs b/cli/Main.hs --- a/cli/Main.hs +++ b/cli/Main.hs @@ -13,7 +13,7 @@ import Data.Aeson import Data.Conduit import Data.Conduit.Async -import Data.Default.Class +import Data.Monoid ((<>)) import FCMClient import FCMClient.Types import System.IO @@ -26,16 +26,19 @@ import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL + +-- | Example of sending an individual notification +-- or a batch of pre-formatted JSON notifications +-- See CliArgs.hs for an example of payload construction with lenses main :: IO () main = runWithArgs $ \CliArgs{..} -> do - let sendMessage msgMod = do - let msg = msgMod def + let sendMessage msg = do putStrLn $ (LUTF8.toString . encode) msg res <- fcmCallJSON (UTF8.fromString cliAuthKey) msg case res of FCMResultSuccess b -> putStrLn $ (LUTF8.toString . encode) b - FCMResultError e -> putStrLn $ show e + FCMResultError e -> print e sendMessageBatch CliJsonBatchArgs{..} = do let buf c = buffer' cliBatchConc c @@ -46,9 +49,8 @@ `buf` (encodeOutputConduit .| batchOutputConduit cliBatchOutput) - case cliCmd - of CliCmdSendMessage msgMod -> sendMessage msgMod + of CliCmdSendMessage msg -> sendMessage msg CliCmdSendJsonBatch bargs -> runResourceT $ runCConduit $ sendMessageBatch bargs @@ -60,7 +62,7 @@ -- an FCM request but original input will be propagated to the output, this allows for addition -- of request tracking/debugging fields that makes it easier to interpret results. parseInputConduit :: (MonadIO m) - => Conduit BS.ByteString m (Either (BS.ByteString, String) (Value, FCMMessage)) + => ConduitT BS.ByteString (Either (BS.ByteString, String) (Value, FCMMessage)) m () parseInputConduit = CB.lines .| CL.map (\line -> do jObj <- case eitherDecode' $ LBS.fromStrict line of Right v -> Right v @@ -72,31 +74,30 @@ encodeOutputConduit :: (MonadIO m) - => Conduit Value m BS.ByteString + => ConduitT Value BS.ByteString m () encodeOutputConduit = CL.map (LBS.toStrict . encode) - =$= ( awaitForever $ \l -> do yield l - yield "\n" ) + .| awaitForever (\l -> yield l >> yield "\n") -- | Convert each input line into a JSON object containing original input and results of the call. callFCMConduit :: (MonadIO m, MonadResource m) => BS.ByteString -- ^ authorization key - -> Conduit (Either (BS.ByteString,String) (Value, FCMMessage)) m (A.Async Value) + -> ConduitT (Either (BS.ByteString,String) (Value, FCMMessage)) (A.Async Value) m () callFCMConduit authKey = CL.mapM $ \input -> liftIO . A.async $ case input of Left (i,e) -> return $ object [ ("type", "ParserError") , ("error", toJSON e) , ("input", toJSON (UTF8.toString i)) ] - Right (jm, m) -> fmap (resToVal jm) $ retrying retPolicy (const $ shouldRetry) (const $ fcmCallJSON authKey m) + Right (jm, m) -> resToVal jm <$> retrying retPolicy (const shouldRetry) (const $ fcmCallJSON authKey m) where retPolicy = constantDelay 1000000 <> limitRetries 5 shouldRetry (FCMResultSuccess _) = return False shouldRetry (FCMResultError e) = do - liftIO $ hPutStrLn stderr $ "Client error: " <> (show e) + liftIO $ hPutStrLn stderr $ "Client error: " <> show e return $ case e of FCMServerError _ _ -> True FCMClientHTTPError _ -> True @@ -116,10 +117,10 @@ runInParallel :: (MonadIO m) => Int -- ^ level - -> Conduit (A.Async a) m a + -> ConduitT (A.Async a) a m () runInParallel n = parC [] where parC !xs = do - let moreCnt = n - (length xs) + let moreCnt = n - length xs moreXs <- CL.take moreCnt let xs' = xs ++ moreXs if null xs' @@ -129,10 +130,9 @@ parC $ filter (/= a) xs' - batchInputConduit :: (MonadResource m) => Maybe FilePath - -> Producer m BS.ByteString + -> ConduitT () BS.ByteString m () batchInputConduit (Just fp) = CB.sourceFile fp batchInputConduit Nothing = do liftIO $ do hSetBinaryMode stdin True @@ -142,7 +142,7 @@ batchOutputConduit :: (MonadResource m) => Maybe FilePath - -> Consumer BS.ByteString m () + -> ConduitT BS.ByteString Void m () batchOutputConduit (Just fp) = CB.sinkFile fp batchOutputConduit Nothing = do liftIO $ do hSetBinaryMode stdout True diff --git a/fcm-client.cabal b/fcm-client.cabal --- a/fcm-client.cabal +++ b/fcm-client.cabal @@ -1,33 +1,48 @@ +cabal-version: 2.4 name: fcm-client -version: 0.1.0.0 +version: 0.2.0.0 synopsis: Admin API for Firebase Cloud Messaging -description: Please see README.md +description: This package provides data type model and functions to call FCM endpoints. homepage: https://github.com/holmusk/fcm-client#readme -license: BSD3 +license: BSD-3-Clause license-file: LICENSE author: Andrey Kartashov, Holmusk -maintainer: hi@holmusk.com -copyright: 2016-2018 Andrey Kartashov, 2018 Holmusk -category: Library +maintainer: Holmusk +copyright: 2016-2018 Andrey Kartashov, 2018-2019 Holmusk +category: Library, JSON, FCM build-type: Simple extra-doc-files: README.md -cabal-version: 2.0 -tested-with: GHC == 8.4.3 + CHANGELOG.md +tested-with: GHC == 8.2.2 + GHC == 8.4.4 + GHC == 8.6.5 source-repository head type: git location: https://github.com/holmusk/fcm-client +common common-options + build-depends: base >= 4.10.1.0 && < 4.13 + + default-language: Haskell2010 + ghc-options: -Wall + -Wincomplete-uni-patterns + -Wincomplete-record-updates + -Wcompat + -Widentities + -Wredundant-constraints + -fhide-source-paths + library + import: common-options hs-source-dirs: src exposed-modules: FCMClient - , FCMClient.JSON.Types - , FCMClient.Types + FCMClient.JSON.Types + FCMClient.Types - build-depends: base >= 4.9 && < 5.0 - , aeson + build-depends: aeson , aeson-casing - , bytestring + , bytestring ^>= 0.10 , containers , data-default-class , http-client @@ -35,19 +50,16 @@ , http-types , lens , scientific - , text + , text ^>= 1.2 , time - default-language: Haskell2010 - ghc-options: -Wall -fwarn-tabs - -executable fcm-client +executable fcm-client + import: common-options hs-source-dirs: cli main-is: Main.hs other-modules: CliArgs - build-depends: base >= 4.9 && < 5.0 - , aeson + build-depends: aeson , async , data-default-class , bytestring @@ -68,12 +80,12 @@ default-language: Haskell2010 test-suite test + import: common-options type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs - build-depends: base >= 4.9 && < 5.0 - , aeson + build-depends: aeson , containers , data-default-class , fcm-client @@ -85,5 +97,4 @@ , test-framework-quickcheck2 , text - default-language: Haskell2010 - ghc-options: -Wall -fwarn-tabs -fno-warn-orphans -fno-warn-missing-signatures + ghc-options: -fno-warn-orphans -fno-warn-missing-signatures diff --git a/src/FCMClient.hs b/src/FCMClient.hs --- a/src/FCMClient.hs +++ b/src/FCMClient.hs @@ -14,7 +14,7 @@ import qualified Data.Aeson as J import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L -import Data.Monoid +import Data.Monoid ((<>)) import qualified Data.Text as T import qualified Data.Text.Encoding as T import FCMClient.Types @@ -27,7 +27,7 @@ -- https://firebase.google.com/docs/cloud-messaging/http-server-ref#send-downstream fcmCallJSON :: (J.ToJSON req) => B.ByteString -- ^ authorization key - -> req -- ^ FCM JSON message, a typed model or a document object + -> req -- ^ FCM JSON message, a typed model or a document object, see 'FCMClient.Types' -> IO FCMResult fcmCallJSON authKey fcmMessage = handle (\ (he :: HttpException) -> return $ FCMResultError . FCMClientHTTPError . T.pack . show $ he) $ do @@ -38,14 +38,14 @@ of Left e -> FCMResultError $ FCMClientJSONError (T.pack e) Right b -> FCMResultSuccess b | rs == status400 = FCMResultError $ FCMErrorResponseInvalidJSON (textBody rb) - | rs == status401 = FCMResultError $ FCMErrorResponseInvalidAuth + | rs == status401 = FCMResultError FCMErrorResponseInvalidAuth | statusIsServerError rs = FCMResultError $ FCMServerError rs (textBody rb) - | otherwise = FCMResultError $ FCMClientHTTPError $ "Unexpected response [" <> (T.pack . show $ rs) <> "]: " <> (textBody rb) + | otherwise = FCMResultError $ FCMClientHTTPError $ "Unexpected response [" <> (T.pack . show) rs <> "]: " <> textBody rb - textBody b = (T.decodeUtf8 . L.toStrict) b + textBody = T.decodeUtf8 . L.toStrict --- | Constructs an FCM JSON request, body and additional parameters such as +-- | Constructs an authenticated FCM JSON request, body and additional parameters such as -- proxy or http manager can be set for a customized HTTP call. fcmJSONRequest :: B.ByteString -- ^ authorization key -> L.ByteString -- ^ JSON POST data diff --git a/src/FCMClient/JSON/Types.hs b/src/FCMClient/JSON/Types.hs --- a/src/FCMClient/JSON/Types.hs +++ b/src/FCMClient/JSON/Types.hs @@ -16,6 +16,7 @@ , FCMNotification , fcmTitle , fcmBody +, fcmAndroidChannelId , fcmIcon , fcmSound , fcmTag @@ -28,7 +29,7 @@ , fcmTitleLocArgs , FCMMessage , fcmTo -, fcmRegistrationIDs +, fcmRegistrationIds , fcmCondition , fcmCollapseKey , fcmPriority @@ -110,6 +111,17 @@ -- Indicates notification body text. , _fcmBody :: !(Maybe Text) + -- | android_channel_id Optional, string + -- The notification's channel id (new in Android O). + -- + -- The app must create a channel with this channel ID before any notification + -- with this channel ID is received. + -- + -- If you don't send this channel ID in the request, or if the channel ID + -- provided has not yet been created by the app, FCM uses the channel ID + -- specified in the app manifest. + , _fcmAndroidChannelId :: !(Maybe Text) + -- | icon Optional, string -- Android: Indicates notification icon. Sets value to myicon for drawable resource myicon. , _fcmIcon :: !(Maybe Text) @@ -186,7 +198,7 @@ instance Default FCMNotification where - def = FCMNotification Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing + def = FCMNotification Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing -- | FCM Message as defined in https://firebase.google.com/docs/cloud-messaging/http-server-ref#send-downstream @@ -206,7 +218,7 @@ -- Use this parameter only for multicast messaging, not for single -- recipients. Multicast messages (sending to more than 1 registration tokens) are -- allowed using HTTP JSON format only. - , _fcmRegistrationIDs :: !(Maybe (NonEmpty Text)) + , _fcmRegistrationIds :: !(Maybe (NonEmpty Text)) -- | condition Optional, string -- This parameter specifies a logical expression of conditions that determine @@ -424,12 +436,12 @@ instance Default FCMMessageResponse where def = FCMMessageResponsePayload 0 0 0 0 Nothing -data FCMTopicResponseOk = +newtype FCMTopicResponseOk = FCMTopicResponseOkPayload { -- | Optional, number The topic message ID when FCM has successfully -- received the request and will attempt to deliver to all subscribed -- devices. - _fcmTopicMessageId :: !Integer + _fcmTopicMessageId :: Integer } deriving (Eq, Show) $(makeLenses ''FCMTopicResponseOk ) diff --git a/src/FCMClient/Types.hs b/src/FCMClient/Types.hs --- a/src/FCMClient/Types.hs +++ b/src/FCMClient/Types.hs @@ -1,8 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} -- | Google Firebase Cloud Messaging model / JSON conversions. @@ -11,81 +7,30 @@ -- This module re-exports JSON types with a few convenience wrappers -- around selected fields. -- +-- Models are constructed with lenses, starting with a default value, e.g: +-- >>> encode (def & fcmBody ?~ "fcm body") +-- "{\"body\":\"fcm body\"}" +-- module FCMClient.Types ( - J.FCMData -, FCMPriority(..) + module Control.Lens +, module Data.Aeson +, module Data.Default.Class +, module Data.Scientific +, module FCMClient.JSON.Types , FCMLocValue(..) -, J.FCMNotification -, J.fcmTitle -, J.fcmBody -, J.fcmIcon -, J.fcmSound -, J.fcmTag -, J.fcmColor -, J.fcmBadge -, J.fcmClickAction -, J.fcmBodyLocKey +, FCMPriority(..) , fcmBodyLocArgs -, J.fcmTitleLocKey -, fcmTitleLocArgs -, J.FCMMessage -, J.fcmTo -, J.fcmRegistrationIDs -, J.fcmCondition -, J.fcmCollapseKey -, fcmPriority , fcmContentAvailable , fcmDelayWhileIdle -, J.fcmTimeToLive -, J.fcmRestrictedPackageName , fcmDryRun -, J.fcmData -, J.fcmNotification +, fcmPriority +, fcmTitleLocArgs , fcmWithNotification -, J.FCMResult ( J.FCMResultSuccess - , J.FCMResultError - ) -, J._FCMResultSuccess -, J._FCMResultError -, J.FCMClientError ( J.FCMErrorResponseInvalidJSON - , J.FCMErrorResponseInvalidAuth - , J.FCMServerError - , J.FCMClientJSONError - , J.FCMClientHTTPError - ) -, J.fcmErrorMessage -, J.fcmErrorHttpStatus -, J._FCMErrorResponseInvalidJSON -, J._FCMErrorResponseInvalidAuth -, J._FCMServerError -, J._FCMClientJSONError -, J._FCMClientHTTPError -, J.FCMResponseBody(..) -, J.FCMMessageResponse -, J._FCMMessageResponse -, J._FCMTopicResponse -, J.fcmCanonicalIds -, J.fcmFailure -, J.fcmMulticastId -, J.fcmResults -, J.fcmSuccess -, J.FCMMessageResponseResult(..) -, J._FCMMessageResponseResultOk -, J._FCMMessageResponseResultError -, J.FCMMessageResponseResultOk -, J.fcmMessageId -, J.fcmRegistrationId -, J.FCMTopicResponse(..) -, J.FCMTopicResponseOk -, J._FCMTopicResponseOk -, J._FCMTopicResponseError -, J.fcmTopicMessageId -, J.FCMError(..) ) where import Control.Lens -import Data.Aeson +import Data.Aeson (encode, decode) import Data.Aeson.Types as J import Data.Default.Class import Data.List.NonEmpty (nonEmpty) @@ -96,11 +41,16 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Encoding as TE +import FCMClient.JSON.Types hiding ( fcmBodyLocArgs + , fcmContentAvailable + , fcmDelayWhileIdle + , fcmDryRun + , fcmPriority + , fcmTitleLocArgs + ) import qualified FCMClient.JSON.Types as J - - data FCMPriority = FCMPriorityNormal | FCMPriorityHigh deriving (Eq, Show, Ord) @@ -137,8 +87,11 @@ => p [a] (f [a1]) -> p (Maybe Text) (f (Maybe Text)) aesonTxtPr = - (prism' (fmap (LT.toStrict . TE.decodeUtf8)) (Just . (fmap (TE.encodeUtf8 . LT.fromStrict)))) . - (prism' (fmap (encode) . nonEmpty) (Just . fromMaybe [] . decode . fromMaybe "")) + prism' (fmap (LT.toStrict . TE.decodeUtf8)) + (Just . fmap (TE.encodeUtf8 . LT.fromStrict)) + . + prism' (fmap encode . nonEmpty) + (Just . fromMaybe [] . decode . fromMaybe "") -- | Typed lens focused on localized notification body arguments. @@ -161,7 +114,7 @@ fcmPriority :: (Applicative f) => (FCMPriority -> f FCMPriority) -> J.FCMMessage -> f J.FCMMessage -fcmPriority = J.fcmPriority . (prism' fcmPriorityToText (Just .textToFcmPriority)) +fcmPriority = J.fcmPriority . prism' fcmPriorityToText (Just .textToFcmPriority) where fcmPriorityToText FCMPriorityNormal = Nothing fcmPriorityToText FCMPriorityHigh = Just "high" textToFcmPriority (Just "high") = FCMPriorityHigh @@ -171,7 +124,7 @@ maybeBoolPr :: (Applicative f) => (Bool -> f Bool) - -> (Maybe Bool) -> f (Maybe Bool) + -> Maybe Bool -> f (Maybe Bool) maybeBoolPr = prism' (\x -> if x then Just x else Nothing) (Just . fromMaybe False) diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,6 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} module Main where @@ -26,73 +24,67 @@ ] test_notificationJSON = do - (encode (def :: FCMNotification)) @?= "{}" + encode (def :: FCMNotification) @?= "{}" - (encode $ fcmBody .~ (Just "fcm body") $ def) @?= + encode (def & fcmBody ?~ "fcm body") @?= "{\"body\":\"fcm body\"}" - (encode $ fcmColor .~ (Just "#001122") $ def) @?= + encode (def & fcmColor ?~ "#001122") @?= "{\"color\":\"#001122\"}" - (encode $ fcmTitleLocKey .~ (Just $ "loc title") $ - fcmTitleLocArgs .~ ([]) $ - def) @?= + encode (def & fcmTitleLocKey ?~ "loc title" + & fcmTitleLocArgs .~ [] ) @?= "{\"title_loc_key\":\"loc title\"}" - (encode $ fcmTitleLocKey .~ (Just $ "loc title") $ - fcmTitleLocArgs .~ ([FCMLocString "locStr", FCMLocNumber 1.0, FCMLocBool True]) $ - def) @?= - "{\"title_loc_key\":\"loc title\",\"title_loc_args\":\"[\\\"locStr\\\",1,true]\"}" + encode ( def & fcmTitleLocKey ?~ "loc title" + & fcmTitleLocArgs .~ [FCMLocString "locStr", FCMLocNumber 1.0, FCMLocBool True] + ) @?= "{\"title_loc_key\":\"loc title\",\"title_loc_args\":\"[\\\"locStr\\\",1,true]\"}" - (encode $ fcmBodyLocKey .~ (Just $ "loc body") $ - fcmBodyLocArgs .~ (["locStr", FCMLocNumber 1.0, FCMLocBool True]) $ - def) @?= - "{\"body_loc_key\":\"loc body\",\"body_loc_args\":\"[\\\"locStr\\\",1,true]\"}" + encode ( def & fcmBodyLocKey ?~ "loc body" + & fcmBodyLocArgs .~ ["locStr", FCMLocNumber 1.0, FCMLocBool True] + ) @?= "{\"body_loc_key\":\"loc body\",\"body_loc_args\":\"[\\\"locStr\\\",1,true]\"}" test_messageJSON = do - (encode (def :: FCMMessage)) @?= "{}" + encode (def :: FCMMessage) @?= "{}" - (encode $ fcmCollapseKey .~ (Just "ckey") $ - fcmTimeToLive .~ (Just 3) $ - fcmData .~ (Just (Map.fromList [("foo","bar")])) $ - def) @?= - "{\"collapse_key\":\"ckey\",\"time_to_live\":3,\"data\":{\"foo\":\"bar\"}}" + encode (def & fcmCollapseKey ?~ "ckey" + & fcmTimeToLive ?~ 3 + & fcmData ?~ Map.fromList [("foo","bar")] + ) @?= "{\"collapse_key\":\"ckey\",\"time_to_live\":3,\"data\":{\"foo\":\"bar\"}}" - (encode $ fcmPriority .~ FCMPriorityHigh $ def) @?= + encode (def & fcmPriority .~ FCMPriorityHigh) @?= "{\"priority\":\"high\"}" - (encode $ fcmPriority .~ FCMPriorityNormal $ def) @?= "{}" + encode (def & fcmPriority .~ FCMPriorityNormal) @?= "{}" - (encode $ fcmContentAvailable .~ False $ def) @?= "{}" + encode (def & fcmContentAvailable .~ False) @?= "{}" - (encode $ fcmContentAvailable .~ True $ def) @?= "{\"content_available\":true}" + encode (def & fcmContentAvailable .~ True) @?= + "{\"content_available\":true}" - (decode "{\"content_available\":true}") ^.. (_Just . fcmContentAvailable) @?= [True] + decode "{\"content_available\":true}" ^.. (_Just . fcmContentAvailable) @?= [True] - (encode $ def & - ( (fcmContentAvailable .~ True) - . ( fcmWithNotification %~ ( (fcmBody .~ Just "n body") - . (fcmTitle .~ Just "n title") - ) - ) - ) - ) @?= "{\"content_available\":true,\"notification\":{\"title\":\"n title\",\"body\":\"n body\"}}" + encode ( def & fcmContentAvailable .~ True + & fcmWithNotification %~ ( (fcmBody ?~ "n body") + . (fcmTitle ?~ "n title") + ) + ) @?= "{\"content_available\":true,\"notification\":{\"title\":\"n title\",\"body\":\"n body\"}}" test_responseJSON = do - (encode (FCMMessageResponse def)) @?= "{\"multicast_id\":0,\"success\":0,\"failure\":0,\"canonical_ids\":0}" + encode (FCMMessageResponse def) @?= "{\"multicast_id\":0,\"success\":0,\"failure\":0,\"canonical_ids\":0}" - (encode (FCMTopicResponseOk def)) @?= "{\"message_id\":0}" + encode (FCMTopicResponseOk def) @?= "{\"message_id\":0}" - (decode "{\"message_id\":6538060933731373360}") ^.. + decode "{\"message_id\":6538060933731373360}" ^.. (_Just . _FCMTopicResponse . _FCMTopicResponseOk . fcmTopicMessageId ) @?= [6538060933731373360] let jRes = "{\"multicast_id\":4984205480219716339,\"success\":0,\"failure\":1,\"canonical_ids\":0,\"results\":[{\"error\":\"NotRegistered\"}]}" - (decode jRes) ^.. + decode jRes ^.. (_Just . _FCMMessageResponse . fcmResults . _Just . traverse . _FCMMessageResponseResultError ) @?= [FCMErrorNotRegistered] - (decode jRes) ^.. (_Just . _FCMMessageResponse . fcmMulticastId ) @?= [4984205480219716339] + decode jRes ^.. (_Just . _FCMMessageResponse . fcmMulticastId ) @?= [4984205480219716339]