fcm-client-0.1.0.0: src/FCMClient.hs

{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}


-- | Firebase Cloud Messaging google client.
-- https://firebase.google.com/docs/cloud-messaging/concept-options#notifications_and_data_messages
module FCMClient (
  fcmCallJSON
, fcmJSONRequest
) where


import           Control.Exception
import qualified Data.Aeson as J
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import           Data.Monoid
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import           FCMClient.Types
import           Network.HTTP.Client
import           Network.HTTP.Simple
import           Network.HTTP.Types


-- | Makes an FCM JSON request, expects a JSON response.
--   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
            -> IO FCMResult
fcmCallJSON authKey fcmMessage =
  handle (\ (he :: HttpException) -> return $ FCMResultError . FCMClientHTTPError . T.pack . show $ he) $ do
    hRes <- httpLBS (fcmJSONRequest authKey (J.encode fcmMessage))
    return $ decodeRes (responseBody hRes) (responseStatus hRes)

  where decodeRes rb rs | rs == status200 = case J.eitherDecode' rb
                                              of Left e  -> FCMResultError $ FCMClientJSONError (T.pack e)
                                                 Right b -> FCMResultSuccess b
                        | rs == status400 = FCMResultError $ FCMErrorResponseInvalidJSON (textBody rb)
                        | rs == status401 = FCMResultError $ FCMErrorResponseInvalidAuth
                        | statusIsServerError rs = FCMResultError $ FCMServerError rs (textBody rb)
                        | otherwise              = FCMResultError $ FCMClientHTTPError $ "Unexpected response [" <> (T.pack . show $ rs) <> "]: " <> (textBody rb)

        textBody b = (T.decodeUtf8 . L.toStrict) b


-- | Constructs an 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
               -> Request
fcmJSONRequest authKey jsonBytes =
  "https://fcm.googleapis.com/fcm/send"
    { method = "POST"
    , requestHeaders = [ (hAuthorization, "key=" <> authKey)
                       , (hContentType, "application/json")
                       ]
    , requestBody = RequestBodyLBS jsonBytes
    }