{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}

module Rollbar.Client.Internal
  ( DataResponse(..)
  , ResultResponse(..)
  , rollbar
  , baseUrl
  ) where

import Data.Aeson
import Data.Proxy (Proxy)
import Network.HTTP.Req
import Rollbar.Client.Settings

newtype DataResponse a = DataResponse { forall a. DataResponse a -> a
unDataResponse :: a }
  deriving (DataResponse a -> DataResponse a -> Bool
forall a. Eq a => DataResponse a -> DataResponse a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataResponse a -> DataResponse a -> Bool
$c/= :: forall a. Eq a => DataResponse a -> DataResponse a -> Bool
== :: DataResponse a -> DataResponse a -> Bool
$c== :: forall a. Eq a => DataResponse a -> DataResponse a -> Bool
Eq, Int -> DataResponse a -> ShowS
forall a. Show a => Int -> DataResponse a -> ShowS
forall a. Show a => [DataResponse a] -> ShowS
forall a. Show a => DataResponse a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataResponse a] -> ShowS
$cshowList :: forall a. Show a => [DataResponse a] -> ShowS
show :: DataResponse a -> String
$cshow :: forall a. Show a => DataResponse a -> String
showsPrec :: Int -> DataResponse a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> DataResponse a -> ShowS
Show)

instance FromJSON a => FromJSON (DataResponse a) where
  parseJSON :: Value -> Parser (DataResponse a)
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DataResponse" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    forall a. a -> DataResponse a
DataResponse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"

data ResultResponse a = ResultResponse
  { forall a. ResultResponse a -> Integer
resultResponseErr :: Integer
  , forall a. ResultResponse a -> a
resultResponseResult :: a
  } deriving (ResultResponse a -> ResultResponse a -> Bool
forall a. Eq a => ResultResponse a -> ResultResponse a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResultResponse a -> ResultResponse a -> Bool
$c/= :: forall a. Eq a => ResultResponse a -> ResultResponse a -> Bool
== :: ResultResponse a -> ResultResponse a -> Bool
$c== :: forall a. Eq a => ResultResponse a -> ResultResponse a -> Bool
Eq, Int -> ResultResponse a -> ShowS
forall a. Show a => Int -> ResultResponse a -> ShowS
forall a. Show a => [ResultResponse a] -> ShowS
forall a. Show a => ResultResponse a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResultResponse a] -> ShowS
$cshowList :: forall a. Show a => [ResultResponse a] -> ShowS
show :: ResultResponse a -> String
$cshow :: forall a. Show a => ResultResponse a -> String
showsPrec :: Int -> ResultResponse a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ResultResponse a -> ShowS
Show)

instance FromJSON a => FromJSON (ResultResponse a) where
  parseJSON :: Value -> Parser (ResultResponse a)
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ResultResponse" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    forall a. Integer -> a -> ResultResponse a
ResultResponse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"err"
                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"result"

rollbar
  :: ( HasSettings m
     , HttpBody body
     , HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
     , HttpMethod method
     , HttpResponse response
     , MonadHttp m
     )
  => method
  -> Url 'Https
  -> body
  -> Proxy response
  -> m response
rollbar :: forall (m :: * -> *) body method response.
(HasSettings m, HttpBody body,
 HttpBodyAllowed (AllowsBody method) (ProvidesBody body),
 HttpMethod method, HttpResponse response, MonadHttp m) =>
method -> Url 'Https -> body -> Proxy response -> m response
rollbar method
method Url 'Https
url body
body Proxy response
response = do
  Token ByteString
token <- Settings -> Token
settingsToken forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). HasSettings m => m Settings
getSettings
  forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
 HttpResponse response,
 HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req method
method Url 'Https
url body
body Proxy response
response forall a b. (a -> b) -> a -> b
$ forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
header ByteString
"X-Rollbar-Access-Token" ByteString
token

baseUrl :: Url 'Https
baseUrl :: Url 'Https
baseUrl = Text -> Url 'Https
https Text
"api.rollbar.com" forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"api" forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"1"