Reorganized JSON response structure.

cli/Main.hs

@@ -22,6 +22,7 @@ import           Data.Conduit
 import           Data.Conduit.Async
 import qualified Data.Conduit.Binary as CB
 import qualified Data.Conduit.List as CL
+import           Data.Default.Class
 import           Data.Monoid
 import           FCMClient
 import           FCMClient.Types
@@ -34,7 +35,7 @@ main :: IO ()
 main = runWithArgs $ \CliArgs{..} -> do
 
   let sendMessage msgMod = do
-        let msg = msgMod newFCMMessage
+        let msg = msgMod def
         putStrLn $ (LUTF8.toString . encode) msg
         res <- fcmCallJSON (UTF8.fromString cliAuthKey) msg :: IO (Response Object)
         putStrLn $ show res

fcm-client.cabal

@@ -26,6 +26,7 @@ library
                     , aeson-casing
                     , bytestring
                     , containers
+                    , data-default-class
                     , http-client
                     , http-conduit
                     , http-types
@@ -53,6 +54,7 @@ executable            fcm-client
   build-depends:      base >= 4.9 && < 5.0
                     , aeson
                     , async
+                    , data-default-class
                     , bytestring
                     , conduit
                     , conduit-extra
@@ -81,6 +83,7 @@ test-suite test
   build-depends:      base >= 4.9 && < 5.0
                     , aeson
                     , containers
+                    , data-default-class
                     , fcm-client
                     , HUnit
                     , lens

src/FCMClient/JSON/Types.hs

@@ -14,7 +14,6 @@
 module FCMClient.JSON.Types (
   FCMData
 , FCMNotification
-, newFCMNotification
 , fcmTitle
 , fcmBody
 , fcmIcon
@@ -28,7 +27,6 @@ module FCMClient.JSON.Types (
 , fcmTitleLocKey
 , fcmTitleLocArgs
 , FCMMessage
-, newFCMMessage
 , fcmTo
 , fcmRegistrationIDs
 , fcmCondition
@@ -45,12 +43,15 @@ module FCMClient.JSON.Types (
              , FCMResponseInvalidJSON
              , FCMResponseInvalidAuth
              , FCMResponseServerError )
+, _FCMResponseOk
+, _FCMResponseInvalidJSON
+, _FCMResponseInvalidAuth
+, _FCMResponseServerError
 , fcmResponseBody
 , fcmResponseErrorMessage
 , fcmResponseRetryAfter
 , FCMResponseBody(..)
-, FCMMessageResponseBody
-, _FCMResponseBody
+, FCMMessageResponse
 , _FCMMessageResponse
 , _FCMTopicResponse
 , fcmCanonicalIds
@@ -59,12 +60,16 @@ module FCMClient.JSON.Types (
 , fcmResults
 , fcmSuccess
 , FCMMessageResponseResult(..)
-, _FCMMessageResponseResult
 , _FCMMessageResponseResultOk
 , _FCMMessageResponseResultError
-, FCMMessageResponseResultOkBody
+, FCMMessageResponseResultOk
 , fcmMessageId
 , fcmRegistrationId
+, FCMTopicResponse(..)
+, FCMTopicResponseOk
+, _FCMTopicResponseOk
+, _FCMTopicResponseError
+, fcmTopicMessageId
 , FCMError(..)
 ) where
 
@@ -75,6 +80,7 @@ import           Data.Aeson
 import           Data.Aeson.Casing
 import           Data.Aeson.TH
 import           Data.Aeson.Types
+import           Data.Default.Class
 import           Data.List.NonEmpty (NonEmpty)
 import           Data.Map (Map)
 import           Data.Text (Text)
@@ -172,9 +178,8 @@ $(makeLenses ''FCMNotification)
 $(deriveJSON (aesonPrefix snakeCase) { omitNothingFields = True } ''FCMNotification)
 
 
-
-newFCMNotification :: FCMNotification
-newFCMNotification = FCMNotification Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+instance Default FCMNotification where
+  def = FCMNotification 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
@@ -286,8 +291,8 @@ $(makeLenses ''FCMMessage)
 $(deriveJSON (aesonPrefix snakeCase) { omitNothingFields = True } ''FCMMessage)
 
 
-newFCMMessage :: FCMMessage
-newFCMMessage = FCMMessage Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+instance Default FCMMessage where
+  def = FCMMessage Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
 
 
 -- | String specifying the error that occurred when processing the message
@@ -347,8 +352,8 @@ instance FromJSON FCMError where
 
 
 
-data FCMMessageResponseResultOkBody =
-  FCMMessageResponseResultOkBody {
+data FCMMessageResponseResultOk =
+  FCMMessageResponseResultOkPayload {
     -- | String specifying a unique ID for each successfully processed message.
     _fcmMessageId :: !Text
 
@@ -359,16 +364,18 @@ data FCMMessageResponseResultOkBody =
   , _fcmRegistrationId :: !(Maybe Text)
   } deriving (Eq, Show)
 
-$(makeLenses ''FCMMessageResponseResultOkBody)
-$(deriveJSON (aesonPrefix snakeCase) { omitNothingFields = True } ''FCMMessageResponseResultOkBody)
+$(makeLenses ''FCMMessageResponseResultOk)
+$(deriveJSON (aesonPrefix snakeCase) { omitNothingFields = True } ''FCMMessageResponseResultOk)
 
+instance Default FCMMessageResponseResultOk where
+  def = FCMMessageResponseResultOkPayload "" Nothing
 
 data FCMMessageResponseResult =
-    FCMMessageResponseResultOk !FCMMessageResponseResultOkBody
+    FCMMessageResponseResultOk !FCMMessageResponseResultOk
   | FCMMessageResponseResultError !FCMError
   deriving (Eq, Show)
 
-$(makeClassyPrisms ''FCMMessageResponseResult)
+$(makePrisms ''FCMMessageResponseResult)
 
 instance ToJSON FCMMessageResponseResult where
   toJSON (FCMMessageResponseResultOk    b) = toJSON b
@@ -381,8 +388,8 @@ instance FromJSON FCMMessageResponseResult where
              <|> (FCMMessageResponseResultError <$> parseJSON o)
 
 
-data FCMMessageResponseBody =
-  FCMMessageResponseBody {
+data FCMMessageResponse =
+  FCMMessageResponsePayload {
     -- | Required, number  Unique ID (number) identifying the multicast message.
     _fcmMulticastId :: !Integer
 
@@ -404,15 +411,51 @@ data FCMMessageResponseBody =
   , _fcmResults :: !(Maybe (NonEmpty FCMMessageResponseResult))
   } deriving (Eq, Show)
 
-$(makeLenses ''FCMMessageResponseBody)
-$(deriveJSON (aesonPrefix snakeCase) { omitNothingFields = True } ''FCMMessageResponseBody)
+$(makeLenses ''FCMMessageResponse)
+$(deriveJSON (aesonPrefix snakeCase) { omitNothingFields = True } ''FCMMessageResponse)
+
+instance Default FCMMessageResponse where
+  def = FCMMessageResponsePayload 0 0 0 0 Nothing
+
+data 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
+  } deriving (Eq, Show)
+
+$(makeLenses ''FCMTopicResponseOk )
+$(deriveJSON (aesonDrop 9 snakeCase) { omitNothingFields = True } ''FCMTopicResponseOk)
+
+instance Default FCMTopicResponseOk where
+  def = FCMTopicResponseOkPayload 0
+
+data FCMTopicResponse =
+    FCMTopicResponseOk !FCMTopicResponseOk
+  | FCMTopicResponseError !FCMError
+  deriving (Eq, Show)
+
+$(makePrisms ''FCMTopicResponse)
+
+
+instance ToJSON FCMTopicResponse where
+  toJSON (FCMTopicResponseOk    o) = toJSON o
+  toJSON (FCMTopicResponseError e) = toJSON e
 
+  toEncoding (FCMTopicResponseOk    o) = toEncoding o
+  toEncoding (FCMTopicResponseError e) = toEncoding e
 
-data FCMResponseBody = FCMMessageResponse !FCMMessageResponseBody
-                     | FCMTopicResponse !FCMMessageResponseResult
+instance FromJSON FCMTopicResponse where
+  parseJSON o =  (FCMTopicResponseOk <$> parseJSON o)
+             <|> (FCMTopicResponseError <$> parseJSON o)
+
+
+data FCMResponseBody = FCMMessageResponse !FCMMessageResponse
+                     | FCMTopicResponse !FCMTopicResponse
                      deriving (Eq, Show)
 
-$(makeClassyPrisms ''FCMResponseBody)
+$(makePrisms ''FCMResponseBody)
 
 instance ToJSON FCMResponseBody where
   toJSON (FCMMessageResponse m) = toJSON m
@@ -422,20 +465,26 @@ instance ToJSON FCMResponseBody where
   toEncoding (FCMTopicResponse t) = toEncoding t
 
 instance FromJSON FCMResponseBody where
-  parseJSON o =  (FCMTopicResponse <$> parseJSON o)
-             <|> (FCMMessageResponse <$> parseJSON o)
+  parseJSON o =  (FCMMessageResponse <$> parseJSON o)
+             <|> (FCMTopicResponse <$> parseJSON o)
 
 
 data FCMResponse = FCMResponseOk          { _fcmResponseBody :: !FCMResponseBody
-                                          , _fcmResponseRetryAfter :: !(Maybe UTCTime) -- ^ response and value of the Retry-After header
+
+                                            -- | value of the Retry-After header
+                                            -- could be set if some of the messages exceeded rate
+                                          , _fcmResponseRetryAfter :: !(Maybe UTCTime)
                                           }
                  | FCMResponseInvalidJSON { _fcmResponseErrorMessage :: !Text
                                           }
                  | FCMResponseInvalidAuth { _fcmResponseErrorMessage :: !Text
                                           }
                  | FCMResponseServerError { _fcmResponseErrorMessage :: !Text
-                                          , _fcmResponseRetryAfter :: !(Maybe UTCTime) -- ^ response and value of the Retry-After header
+                                            -- | value of the Retry-After header
+                                            -- could be set if topic or some of the messages exceeded rate
+                                          , _fcmResponseRetryAfter :: !(Maybe UTCTime)
                                           }
                  deriving (Eq, Show)
 
 $(makeLenses ''FCMResponse)
+$(makePrisms ''FCMResponse)

src/FCMClient/Types.hs

@@ -16,7 +16,6 @@ module FCMClient.Types (
 , FCMPriority(..)
 , FCMLocValue(..)
 , J.FCMNotification
-, J.newFCMNotification
 , J.fcmTitle
 , J.fcmBody
 , J.fcmIcon
@@ -30,7 +29,6 @@ module FCMClient.Types (
 , J.fcmTitleLocKey
 , fcmTitleLocArgs
 , J.FCMMessage
-, J.newFCMMessage
 , J.fcmTo
 , J.fcmRegistrationIDs
 , J.fcmCondition
@@ -44,12 +42,46 @@ module FCMClient.Types (
 , J.fcmData
 , J.fcmNotification
 , fcmWithNotification
+
+, J.FCMResponse( J.FCMResponseOk
+               , J.FCMResponseInvalidJSON
+               , J.FCMResponseInvalidAuth
+               , J.FCMResponseServerError )
+, J._FCMResponseOk
+, J._FCMResponseInvalidJSON
+, J._FCMResponseInvalidAuth
+, J._FCMResponseServerError
+, J.fcmResponseBody
+, J.fcmResponseErrorMessage
+, J.fcmResponseRetryAfter
+, 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.Types as J
+import           Data.Default.Class
 import           Data.List.NonEmpty (nonEmpty)
 import           Data.Maybe
 import           Data.Scientific (Scientific)
@@ -164,5 +196,5 @@ fcmWithNotification :: (Applicative f)
                     -> J.FCMMessage -> f J.FCMMessage
 fcmWithNotification = J.fcmNotification . justNotif
   where justNotif f maybeN = case maybeN
-                               of Nothing -> fmap Just (f J.newFCMNotification)
+                               of Nothing -> fmap Just (f def)
                                   Just n  -> fmap Just (f n)