{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
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
fcmCallJSON :: (J.ToJSON req)
=> B.ByteString
-> req
-> 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
fcmJSONRequest :: B.ByteString
-> L.ByteString
-> Request
fcmJSONRequest authKey jsonBytes =
"https://fcm.googleapis.com/fcm/send"
{ method = "POST"
, requestHeaders = [ (hAuthorization, "key=" <> authKey)
, (hContentType, "application/json")
]
, requestBody = RequestBodyLBS jsonBytes
}