wai-middleware-rollbar-0.7.0: src/Rollbar/API.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

{-|
    Module      : Rollbar.API
    Description : Codifies Rollbar's API
    Copyright   : (c) Hardy Jones, 2017
    License     : BSD3
    Maintainer  : jones3.hardy@gmail.com
    Stability   : experimental

    Provides functions for communicating with Rollbar through the public API.

    See Rollbar's <https://rollbar.com/docs/api/ API> for more details.
-}
module Rollbar.API
    ( -- * Helpful functions
      -- | These functions are probably what you want most of the time.
      itemsPOST
    , itemsPOST'
    , itemsPOSTRaw
    , itemsPOSTRaw'
    , makeRequest
    -- * Response data types
    , ItemsPOSTResponse(..)
    , ItemsPOSTErrorMessage(..)
    , ItemsPOSTSuccessResult(..)
    -- * Impure functions
    -- | Use with caution.
    , itemsPOSTWithException
    ) where

import Control.Monad.IO.Class (MonadIO)

import Data.Aeson
    ( FromJSON(parseJSON)
    , SumEncoding(UntaggedValue)
    , ToJSON
    , defaultOptions
    , fieldLabelModifier
    , genericParseJSON
    , sumEncoding
    )
import Data.Text  (Text)

import GHC.Generics (Generic)

import Network.HTTP.Client
    ( Manager
    , Request(host, method, path, port, secure)
    , Response
    , defaultRequest
    , setRequestIgnoreStatus
    )
import Network.HTTP.Simple
    ( JSONException
    , httpJSON
    , httpJSONEither
    , setRequestBodyJSON
    , setRequestManager
    )

import Rollbar.Item (Item, RemoveHeaders, UUID4)

-- | The response received from sending an 'Rollbar.Item.Item' to Rollbar.
data ItemsPOSTResponse
    = ItemsPOSTSuccess
        { err_ItemsPOSTSuccess    :: Int
        -- ^ This `err` field is always 0.
        , result_ItemsPOSTSuccess :: ItemsPOSTSuccessResult
        -- ^ The part you probably care about.
        }
    | ItemsPOSTError
        { err_ItemsPOSTError     :: Int
        -- ^ This `err` field is always 1.
        , message_ItemsPOSTError :: Text
        -- ^ A human-readable message describing the error.
        }
    deriving (Eq, Generic, Show)

instance FromJSON ItemsPOSTResponse where
    parseJSON = genericParseJSON defaultOptions
        { fieldLabelModifier = takeWhile (/= '_')
        , sumEncoding = UntaggedValue
        }

-- | The successful response from sending an 'Rollbar.Item.Item' to Rollbar.
newtype ItemsPOSTSuccessResult
    = ItemsPOSTSuccessResult
        { uuid :: UUID4
        -- ^ 'Rollbar.Item.UUID4' of the item.
        --   Matches sent 'Rollbar.Item.UUID4' or generated by Rollbar if missing.
        }
    deriving (Eq, FromJSON, Generic, Show)

-- | The human readable error message from sending an 'Rollbar.Item.Item' to Rollbar.
newtype ItemsPOSTErrorMessage
    = ItemsPOSTErrorMessage Text
    deriving (Eq, FromJSON, Generic, Show)

-- | Sends an 'Rollbar.Item.Item' off to Rollbar.
--
--   Creates a new 'Network.HTTP.Client.Manager' to send off the request.
itemsPOST
    :: (MonadIO f, RemoveHeaders b, ToJSON a)
    => Item a b
    -> f (Response (Either JSONException ItemsPOSTResponse))
itemsPOST = itemsPOSTRaw

-- | Sends an 'Rollbar.Item.Item' off to Rollbar.
itemsPOST'
    :: (MonadIO f, RemoveHeaders b, ToJSON a)
    => Manager
    -> Item a b
    -> f (Response (Either JSONException ItemsPOSTResponse))
itemsPOST' = itemsPOSTRaw'

-- | Sends an 'Rollbar.Item.Item' off to Rollbar.
--
--   Creates a new 'Network.HTTP.Client.Manager' to send off the request.
--   Makes no claims about what you get back.
itemsPOSTRaw
    :: (FromJSON c, MonadIO f, RemoveHeaders b, ToJSON a)
    => Item a b
    -> f (Response (Either JSONException c))
itemsPOSTRaw = httpJSONEither . makeRequest

-- | Sends an 'Rollbar.Item.Item' off to Rollbar.
--
--   Makes no claims about what you get back.
itemsPOSTRaw'
    :: (FromJSON c, MonadIO f, RemoveHeaders b, ToJSON a)
    => Manager
    -> Item a b
    -> f (Response (Either JSONException c))
itemsPOSTRaw' manager = httpJSONEither . setRequestManager manager . makeRequest

-- | Sends an 'Rollbar.Item.Item' off to Rollbar.
--
--   Creates a new 'Network.HTTP.Client.Manager' to send off the request.
--   Makes no claims about what you get back.
--   Throws a 'Network.HTTP.Simple.JSONException' if it cannot parse the response.
--
--   Yes, this name is annoying, so are exceptions.
itemsPOSTWithException
    :: (FromJSON c, MonadIO f, RemoveHeaders b, ToJSON a)
    => Item a b
    -> f (Response c)
itemsPOSTWithException = httpJSON . makeRequest

-- | Converts an item into a request ready to send to Rollbar.
--
--   If you need a different scheme for sending items,
--   you'll probably want to use this along with a function like 'Network.HTTP.Client.httpLbs'
--   or 'Network.HTTP.Simple.httpLbs'.
--
--   If you want the JSON back and already have a 'Network.HTTP.Client.Manager',
--   you can use this function with 'Network.HTTP.Simple.setRequestManager'.
--   Then send off the request with something like 'Network.HTTP.Simple.httpJSONEither'.
makeRequest :: (RemoveHeaders headers, ToJSON a) => Item a headers -> Request
makeRequest payload =
    setRequestBodyJSON payload
        . setRequestIgnoreStatus
        $ defaultRequest
            { host = "api.rollbar.com"
            , method = "POST"
            , path = "api/1/item/"
            , port = 443
            , secure = True
            }