-- | Typical use of this module:
--
-- 1. Run 'get', 'post', or 'delete' to get a 'WreqResponse'.
-- 2. Use 'wreqResponse' to convert the Wreq response to a 'Response'.
-- 3. Use 'responseValue' to obtain the response payload as an Aeson
--   'Data.Aeson.Value' (or an 'Error' if the request was not successful).
module Stripe.Wreq
  ( -- * Request

    -- ** GET
    get,
    get',
    Get (..),

    -- ** POST
    post,
    post',
    Post (..),

    -- ** DELETE
    delete,
    delete',
    Delete (..),

    -- * Response
    WreqResponse,
    Response (..),
    wreqResponse,
    responseValue,
    responseValueError,

    -- * Error
    Error (..),
    UserMessage (..),
    LogMessage (..),
    userError,
    logError,

    -- * Status code
    StatusCode (..),

    -- ** Predicates
    -- $predicates
    isSuccess,
    isError,
    isClientError,
    isServerError,

    -- ** Client error codes
    -- $constants
    badRequest400,
    unauthorized401,
    requestFailed402,
    notFound404,
    conflict409,
    tooManyRequests429,

    -- * Re-exports from Wreq
    FormParam (..),
    Session,
    Network.Wreq.Session.newAPISession,
  )
where

import Control.Exception qualified
import Control.Lens ((&), (.~), (<>~), (?~), (^.))
import Control.Monad ((>=>))
import Data.Aeson qualified
import Data.Aeson.Key qualified
import Data.Aeson.KeyMap qualified
import Data.Bifunctor qualified
import Data.ByteString qualified
import Data.ByteString.Lazy qualified
import Data.Semigroup qualified
import Data.String (fromString)
import Data.Text (Text)
import Data.Text qualified
import Network.Wreq (FormParam (..))
import Network.Wreq qualified
import Network.Wreq.Session (Session)
import Network.Wreq.Session qualified
import Stripe.Concepts (ApiSecretKey (..), ApiVersion (..), RequestApiVersion (..))
import Prelude hiding (userError)

------------------------------------------------------------

-- | An HTTP status code returned by Stripe.
--
-- "Stripe uses conventional HTTP response codes to indicate the success or failure
-- of an API request." - <https://stripe.com/docs/api#errors Stripe>
newtype StatusCode = StatusCode Int deriving (StatusCode -> StatusCode -> Bool
(StatusCode -> StatusCode -> Bool)
-> (StatusCode -> StatusCode -> Bool) -> Eq StatusCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StatusCode -> StatusCode -> Bool
== :: StatusCode -> StatusCode -> Bool
$c/= :: StatusCode -> StatusCode -> Bool
/= :: StatusCode -> StatusCode -> Bool
Eq)

-- $predicates
--
-- Some basic functions for interpreting status codes.

-- | "Codes in the 2xx range indicate success." -
-- <https://stripe.com/docs/api#errors Stripe>
isSuccess :: StatusCode -> Bool
isSuccess :: StatusCode -> Bool
isSuccess (StatusCode Int
x) = Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
200 Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
300

-- | @isError x@ is equivalent to @'isClientError' x || 'isServerError' x@.
isError :: StatusCode -> Bool
isError :: StatusCode -> Bool
isError (StatusCode Int
x) = Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
400 Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
600

-- | "Codes in the 4xx range indicate an error that failed given the information
-- provided (e.g., a required parameter was omitted, a charge failed, etc.)." -
-- <https://stripe.com/docs/api#errors Stripe>
isClientError :: StatusCode -> Bool
isClientError :: StatusCode -> Bool
isClientError (StatusCode Int
x) = Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
400 Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
500

-- | "Codes in the 5xx range indicate an error with Stripe's servers." -
-- <https://stripe.com/docs/api#errors Stripe>
isServerError :: StatusCode -> Bool
isServerError :: StatusCode -> Bool
isServerError (StatusCode Int
x) = Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
500 Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
600

-- $constants
--
-- Constants for each of the error codes enumerated in the Stripe API
-- documentation, for your convenience.

-- | 400 - Bad Request
--
-- "The request was unacceptable, often due to missing a required parameter." -
-- <https://stripe.com/docs/api#errors Stripe>
badRequest400 :: StatusCode
badRequest400 :: StatusCode
badRequest400 = Int -> StatusCode
StatusCode Int
400

-- | 401 - Unauthorized
--
-- "No valid API key provided." - <https://stripe.com/docs/api#errors Stripe>
unauthorized401 :: StatusCode
unauthorized401 :: StatusCode
unauthorized401 = Int -> StatusCode
StatusCode Int
401

-- | 402 - Request Failed
--
-- "The parameters were valid but the request failed." -
-- <https://stripe.com/docs/api#errors Stripe>
requestFailed402 :: StatusCode
requestFailed402 :: StatusCode
requestFailed402 = Int -> StatusCode
StatusCode Int
402

-- | 404 - Not Found
--
-- "The requested resource doesn't exist." -
-- <https://stripe.com/docs/api#errors Stripe>
notFound404 :: StatusCode
notFound404 :: StatusCode
notFound404 = Int -> StatusCode
StatusCode Int
404

-- | 409 - Conflict
--
-- "The request conflicts with another request (perhaps due to using the same
-- idempotent key)." - <https://stripe.com/docs/api#errors Stripe>
conflict409 :: StatusCode
conflict409 :: StatusCode
conflict409 = Int -> StatusCode
StatusCode Int
409

-- | 429 - Too Many Requests
--
-- "Too many requests hit the API too quickly. We recommend an exponential backoff
-- of your requests." - <https://stripe.com/docs/api#errors Stripe>
tooManyRequests429 :: StatusCode
tooManyRequests429 :: StatusCode
tooManyRequests429 = Int -> StatusCode
StatusCode Int
429

------------------------------------------------------------

data Get = Get
  { -- | URL path components
    Get -> [Text]
getPath :: [Text],
    -- | Query params
    Get -> [(Text, Text)]
getParams :: [(Text, Text)]
  }

data Post = Post
  { -- | URL path components
    Post -> [Text]
postPath :: [Text],
    -- | Parameters to send in the request body
    Post -> [FormParam]
postParams :: [FormParam]
  }

data Delete = Delete
  { -- | URL path components
    Delete -> [Text]
deletePath :: [Text],
    -- | Query params
    Delete -> [(Text, Text)]
deleteParams :: [(Text, Text)]
  }

get :: Session -> ApiSecretKey -> Get -> IO WreqResponse
get :: Session -> ApiSecretKey -> Get -> IO WreqResponse
get Session
session ApiSecretKey
key Get
x = Session
-> ApiSecretKey -> RequestApiVersion -> Get -> IO WreqResponse
get' Session
session ApiSecretKey
key RequestApiVersion
DefaultApiVersion Get
x

get' :: Session -> ApiSecretKey -> RequestApiVersion -> Get -> IO WreqResponse
get' :: Session
-> ApiSecretKey -> RequestApiVersion -> Get -> IO WreqResponse
get' Session
session ApiSecretKey
key RequestApiVersion
v Get
x = Options -> Session -> String -> IO WreqResponse
Network.Wreq.Session.getWith Options
opts Session
session String
url
  where
    url :: String
url = [Text] -> String
makeUrl (Get -> [Text]
getPath Get
x)
    opts :: Options
opts =
      Options
wreqDefaults
        Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& (Maybe Auth -> Identity (Maybe Auth))
-> Options -> Identity Options
Lens' Options (Maybe Auth)
Network.Wreq.auth ((Maybe Auth -> Identity (Maybe Auth))
 -> Options -> Identity Options)
-> Auth -> Options -> Options
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ApiSecretKey -> Auth
auth ApiSecretKey
key
        Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& ([(Text, Text)] -> Identity [(Text, Text)])
-> Options -> Identity Options
Lens' Options [(Text, Text)]
Network.Wreq.params (([(Text, Text)] -> Identity [(Text, Text)])
 -> Options -> Identity Options)
-> [(Text, Text)] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Get -> [(Text, Text)]
getParams Get
x)
        Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& ([Header] -> Identity [Header]) -> Options -> Identity Options
Lens' Options [Header]
Network.Wreq.headers (([Header] -> Identity [Header]) -> Options -> Identity Options)
-> [Header] -> Options -> Options
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ (RequestApiVersion -> [Header]
forall {b} {a}.
(IsString b, IsString a) =>
RequestApiVersion -> [(a, b)]
requestApiVersionHeaders RequestApiVersion
v)

post :: Session -> ApiSecretKey -> Post -> IO WreqResponse
post :: Session -> ApiSecretKey -> Post -> IO WreqResponse
post Session
session ApiSecretKey
key Post
x = Session
-> ApiSecretKey -> RequestApiVersion -> Post -> IO WreqResponse
post' Session
session ApiSecretKey
key RequestApiVersion
DefaultApiVersion Post
x

post' :: Session -> ApiSecretKey -> RequestApiVersion -> Post -> IO WreqResponse
post' :: Session
-> ApiSecretKey -> RequestApiVersion -> Post -> IO WreqResponse
post' Session
session ApiSecretKey
key RequestApiVersion
v Post
x = Options -> Session -> String -> [FormParam] -> IO WreqResponse
forall a.
Postable a =>
Options -> Session -> String -> a -> IO WreqResponse
Network.Wreq.Session.postWith Options
opts Session
session String
url [FormParam]
params
  where
    url :: String
url = [Text] -> String
makeUrl (Post -> [Text]
postPath Post
x)
    params :: [FormParam]
params = Post -> [FormParam]
postParams Post
x
    opts :: Options
opts =
      Options
wreqDefaults
        Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& (Maybe Auth -> Identity (Maybe Auth))
-> Options -> Identity Options
Lens' Options (Maybe Auth)
Network.Wreq.auth ((Maybe Auth -> Identity (Maybe Auth))
 -> Options -> Identity Options)
-> Auth -> Options -> Options
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ApiSecretKey -> Auth
auth ApiSecretKey
key
        Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& ([Header] -> Identity [Header]) -> Options -> Identity Options
Lens' Options [Header]
Network.Wreq.headers (([Header] -> Identity [Header]) -> Options -> Identity Options)
-> [Header] -> Options -> Options
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ (RequestApiVersion -> [Header]
forall {b} {a}.
(IsString b, IsString a) =>
RequestApiVersion -> [(a, b)]
requestApiVersionHeaders RequestApiVersion
v)

delete :: Session -> ApiSecretKey -> Delete -> IO WreqResponse
delete :: Session -> ApiSecretKey -> Delete -> IO WreqResponse
delete Session
session ApiSecretKey
key Delete
x = Session
-> ApiSecretKey -> RequestApiVersion -> Delete -> IO WreqResponse
delete' Session
session ApiSecretKey
key RequestApiVersion
DefaultApiVersion Delete
x

delete' :: Session -> ApiSecretKey -> RequestApiVersion -> Delete -> IO WreqResponse
delete' :: Session
-> ApiSecretKey -> RequestApiVersion -> Delete -> IO WreqResponse
delete' Session
session ApiSecretKey
key RequestApiVersion
v Delete
x = Options -> Session -> String -> IO WreqResponse
Network.Wreq.Session.deleteWith Options
opts Session
session String
url
  where
    url :: String
url = [Text] -> String
makeUrl (Delete -> [Text]
deletePath Delete
x)
    opts :: Options
opts =
      Options
wreqDefaults
        Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& (Maybe Auth -> Identity (Maybe Auth))
-> Options -> Identity Options
Lens' Options (Maybe Auth)
Network.Wreq.auth ((Maybe Auth -> Identity (Maybe Auth))
 -> Options -> Identity Options)
-> Auth -> Options -> Options
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ApiSecretKey -> Auth
auth ApiSecretKey
key
        Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& ([(Text, Text)] -> Identity [(Text, Text)])
-> Options -> Identity Options
Lens' Options [(Text, Text)]
Network.Wreq.params (([(Text, Text)] -> Identity [(Text, Text)])
 -> Options -> Identity Options)
-> [(Text, Text)] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Delete -> [(Text, Text)]
deleteParams Delete
x)
        Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& ([Header] -> Identity [Header]) -> Options -> Identity Options
Lens' Options [Header]
Network.Wreq.headers (([Header] -> Identity [Header]) -> Options -> Identity Options)
-> [Header] -> Options -> Options
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ (RequestApiVersion -> [Header]
forall {b} {a}.
(IsString b, IsString a) =>
RequestApiVersion -> [(a, b)]
requestApiVersionHeaders RequestApiVersion
v)

urlBase :: Text
urlBase :: Text
urlBase = String -> Text
Data.Text.pack String
"https://api.stripe.com/v1"

makeUrl :: [Text] -> String
makeUrl :: [Text] -> String
makeUrl =
  Text -> String
Data.Text.unpack
    (Text -> String) -> ([Text] -> Text) -> [Text] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Data.Text.intercalate (String -> Text
Data.Text.pack String
"/")
    ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
urlBase :)

wreqDefaults :: Network.Wreq.Options
wreqDefaults :: Options
wreqDefaults = Options
Network.Wreq.defaults Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& Options -> Options
noCheckResponse

-- When using the default API version, no header is required.
requestApiVersionHeaders :: RequestApiVersion -> [(a, b)]
requestApiVersionHeaders RequestApiVersion
DefaultApiVersion = []
-- Overriding with a specific API version requires one header field.
requestApiVersionHeaders (OverrideApiVersion ApiVersion
v) = [ApiVersion -> (a, b)
forall {b} {a}. (IsString b, IsString a) => ApiVersion -> (a, b)
apiVersionHeader ApiVersion
v]

-- The header field for specifying the API version.
apiVersionHeader :: ApiVersion -> (a, b)
apiVersionHeader (ApiVersion Text
v) = (a
name, b
value)
  where
    name :: a
name = String -> a
forall a. IsString a => String -> a
fromString String
"Stripe-Version"
    value :: b
value = String -> b
forall a. IsString a => String -> a
fromString (Text -> String
Data.Text.unpack Text
v)

-- | Set a "response checker" that overrides Wreq's default one which causes
-- exceptions to be thrown for non-2xx HTTP status codes
noCheckResponse :: Network.Wreq.Options -> Network.Wreq.Options
noCheckResponse :: Options -> Options
noCheckResponse = (Maybe ResponseChecker -> Identity (Maybe ResponseChecker))
-> Options -> Identity Options
Lens' Options (Maybe ResponseChecker)
Network.Wreq.checkResponse ((Maybe ResponseChecker -> Identity (Maybe ResponseChecker))
 -> Options -> Identity Options)
-> ResponseChecker -> Options -> Options
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (\Request
_ Response BodyReader
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Represent a Stripe API key as a Wreq 'Network.Wreq.Auth' value.
--
-- "Authentication to the API is performed via HTTP Basic Auth. Provide your API
-- key as the basic auth username value. You do not need to provide a password." -
-- <https://stripe.com/docs/api#authentication Stripe>
auth :: ApiSecretKey -> Network.Wreq.Auth
auth :: ApiSecretKey -> Auth
auth (ApiSecretKey ByteString
key) = ByteString -> ByteString -> Auth
Network.Wreq.basicAuth ByteString
key ByteString
Data.ByteString.empty

------------------------------------------------------------

-- | An error message suitable for being shown to a user.
newtype UserMessage = UserMessage Text deriving (UserMessage -> UserMessage -> Bool
(UserMessage -> UserMessage -> Bool)
-> (UserMessage -> UserMessage -> Bool) -> Eq UserMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserMessage -> UserMessage -> Bool
== :: UserMessage -> UserMessage -> Bool
$c/= :: UserMessage -> UserMessage -> Bool
/= :: UserMessage -> UserMessage -> Bool
Eq, Int -> UserMessage -> ShowS
[UserMessage] -> ShowS
UserMessage -> String
(Int -> UserMessage -> ShowS)
-> (UserMessage -> String)
-> ([UserMessage] -> ShowS)
-> Show UserMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserMessage -> ShowS
showsPrec :: Int -> UserMessage -> ShowS
$cshow :: UserMessage -> String
show :: UserMessage -> String
$cshowList :: [UserMessage] -> ShowS
showList :: [UserMessage] -> ShowS
Show)

-- | An error message that should go into an error log, /not/ shown to a user.
newtype LogMessage = LogMessage Text deriving (LogMessage -> LogMessage -> Bool
(LogMessage -> LogMessage -> Bool)
-> (LogMessage -> LogMessage -> Bool) -> Eq LogMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogMessage -> LogMessage -> Bool
== :: LogMessage -> LogMessage -> Bool
$c/= :: LogMessage -> LogMessage -> Bool
/= :: LogMessage -> LogMessage -> Bool
Eq, Int -> LogMessage -> ShowS
[LogMessage] -> ShowS
LogMessage -> String
(Int -> LogMessage -> ShowS)
-> (LogMessage -> String)
-> ([LogMessage] -> ShowS)
-> Show LogMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogMessage -> ShowS
showsPrec :: Int -> LogMessage -> ShowS
$cshow :: LogMessage -> String
show :: LogMessage -> String
$cshowList :: [LogMessage] -> ShowS
showList :: [LogMessage] -> ShowS
Show)

data Error = Error
  { Error -> [UserMessage]
userMessages :: [UserMessage],
    Error -> [LogMessage]
logMessages :: [LogMessage]
  }
  deriving (Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
/= :: Error -> Error -> Bool
Eq, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Error -> ShowS
showsPrec :: Int -> Error -> ShowS
$cshow :: Error -> String
show :: Error -> String
$cshowList :: [Error] -> ShowS
showList :: [Error] -> ShowS
Show)

instance Data.Semigroup.Semigroup Error where
  Error [UserMessage]
x [LogMessage]
y <> :: Error -> Error -> Error
<> Error [UserMessage]
x' [LogMessage]
y' =
    [UserMessage] -> [LogMessage] -> Error
Error
      ([UserMessage] -> [UserMessage] -> [UserMessage]
forall a. Semigroup a => a -> a -> a
(Data.Semigroup.<>) [UserMessage]
x [UserMessage]
x')
      ([LogMessage] -> [LogMessage] -> [LogMessage]
forall a. Semigroup a => a -> a -> a
(Data.Semigroup.<>) [LogMessage]
y [LogMessage]
y')

instance Monoid Error where
  mappend :: Error -> Error -> Error
mappend = Error -> Error -> Error
forall a. Semigroup a => a -> a -> a
(Data.Semigroup.<>)
  mempty :: Error
mempty = [UserMessage] -> [LogMessage] -> Error
Error [UserMessage]
forall a. Monoid a => a
mempty [LogMessage]
forall a. Monoid a => a
mempty

instance Control.Exception.Exception Error

userError ::
  -- | An error message intended to be shown to a user.
  Text ->
  Error
userError :: Text -> Error
userError Text
x = Error {userMessages :: [UserMessage]
userMessages = [Text -> UserMessage
UserMessage Text
x], logMessages :: [LogMessage]
logMessages = []}

logError ::
  -- | An error message intended to go into a log file,
  --   /not/ to be shown to a user.
  Text ->
  Error
logError :: Text -> Error
logError Text
x = Error {userMessages :: [UserMessage]
userMessages = [], logMessages :: [LogMessage]
logMessages = [Text -> LogMessage
LogMessage Text
x]}

------------------------------------------------------------

type WreqResponse = Network.Wreq.Response Data.ByteString.Lazy.ByteString

data Response = Response
  { -- | Every Stripe response should have a JSON body; but if not, this
    --   will be a 'Left' value with an error message from the JSON parser.
    Response -> Either Text Value
responseBody :: Either Text Data.Aeson.Value,
    -- | The status code of the HTTP response.
    Response -> StatusCode
responseCode :: StatusCode
  }

-- | Convert a 'WreqResponse' into a 'Response' by parsing the JSON response
-- body (the Stripe API always returns JSON) and getting the HTTP status code.
wreqResponse :: WreqResponse -> Response
wreqResponse :: WreqResponse -> Response
wreqResponse WreqResponse
r =
  Response
    { responseBody :: Either Text Value
responseBody =
        WreqResponse
r WreqResponse
-> Getting ByteString WreqResponse ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString WreqResponse ByteString
forall body0 body1 (f :: * -> *).
Functor f =>
(body0 -> f body1) -> Response body0 -> f (Response body1)
Network.Wreq.responseBody
          ByteString
-> (ByteString -> Either String Value) -> Either String Value
forall a b. a -> (a -> b) -> b
& ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecode
          Either String Value
-> (Either String Value -> Either Text Value) -> Either Text Value
forall a b. a -> (a -> b) -> b
& (String -> Text) -> Either String Value -> Either Text Value
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Data.Bifunctor.first String -> Text
Data.Text.pack,
      responseCode :: StatusCode
responseCode =
        WreqResponse
r
          WreqResponse -> Getting Int WreqResponse Int -> Int
forall s a. s -> Getting a s a -> a
^. (Status -> Const Int Status)
-> WreqResponse -> Const Int WreqResponse
forall body (f :: * -> *).
Functor f =>
(Status -> f Status) -> Response body -> f (Response body)
Network.Wreq.responseStatus
            ((Status -> Const Int Status)
 -> WreqResponse -> Const Int WreqResponse)
-> ((Int -> Const Int Int) -> Status -> Const Int Status)
-> Getting Int WreqResponse Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> Status -> Const Int Status
Lens' Status Int
Network.Wreq.statusCode
          Int -> (Int -> StatusCode) -> StatusCode
forall a b. a -> (a -> b) -> b
& Int -> StatusCode
StatusCode
    }

-- | Interpret a response, returning 'Right' with the parsed JSON payload if
-- everything is okay, or 'Left' with an error if the response contains any
-- indication that something went wrong.
responseValue :: Response -> Either Error Data.Aeson.Value
responseValue :: Response -> Either Error Value
responseValue Response
r =
  case (Response -> Either Text Value
responseBody Response
r) of
    Left Text
e -> Error -> Either Error Value
forall a b. a -> Either a b
Left (Text -> Error
logError Text
e)
    Right Value
val ->
      case StatusCode -> Bool
isSuccess (Response -> StatusCode
responseCode Response
r) of
        Bool
True -> Value -> Either Error Value
forall a b. b -> Either a b
Right Value
val
        Bool
False -> Error -> Either Error Value
forall a b. a -> Either a b
Left (Value -> Error
responseValueError Value
val)

-- | If the response object looks like this:
--
-- > {
-- >   "error": {
-- >       "type": "card_error",
-- >       "message": "..."
-- >     }
-- >   }
-- > }
--
-- then we use the value of the @message@ field as a 'UserMessage'. Otherwise it is
-- a 'LogMessage'.
--
-- "@message@: A human-readable message providing more details about the error. For
-- card errors, these messages can be shown to your users. [...] Card errors are
-- the most common type of error you should expect to handle. They result when the
-- user enters a card that can't be charged for some reason." -
-- <https://stripe.com/docs/api#errors Stripe>
responseValueError :: Data.Aeson.Value -> Error
responseValueError :: Value -> Error
responseValueError Value
val
  | Bool
isCardError = (Text -> Error) -> Maybe Text -> Error
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> Error
userError (Value -> Maybe Text
msg Value
val)
  | Bool
otherwise = (Text -> Error) -> Maybe Text -> Error
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> Error
logError (Value -> Maybe Text
msg Value
val)
  where
    isCardError :: Bool
isCardError = Value -> Maybe Text
typ Value
val Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just (String -> Text
Data.Text.pack String
"card_error")

    msg :: Value -> Maybe Text
msg = String -> Value -> Maybe Value
aesonAttr String
"error" (Value -> Maybe Value)
-> (Value -> Maybe Text) -> Value -> Maybe Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String -> Value -> Maybe Value
aesonAttr String
"message" (Value -> Maybe Value)
-> (Value -> Maybe Text) -> Value -> Maybe Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Value -> Maybe Text
aesonText
    typ :: Value -> Maybe Text
typ = String -> Value -> Maybe Value
aesonAttr String
"error" (Value -> Maybe Value)
-> (Value -> Maybe Text) -> Value -> Maybe Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String -> Value -> Maybe Value
aesonAttr String
"type" (Value -> Maybe Value)
-> (Value -> Maybe Text) -> Value -> Maybe Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Value -> Maybe Text
aesonText

------------------------------------------------------------

-- Internal Aeson decoding functions

aesonAttr :: String -> Data.Aeson.Value -> Maybe Data.Aeson.Value
aesonAttr :: String -> Value -> Maybe Value
aesonAttr String
x = Value -> Maybe Object
aesonObject (Value -> Maybe Object)
-> (Object -> Maybe Value) -> Value -> Maybe Value
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
Data.Aeson.KeyMap.lookup (String -> Key
Data.Aeson.Key.fromString String
x)

aesonObject :: Data.Aeson.Value -> Maybe Data.Aeson.Object
aesonObject :: Value -> Maybe Object
aesonObject (Data.Aeson.Object Object
x) = Object -> Maybe Object
forall a. a -> Maybe a
Just Object
x
aesonObject Value
_ = Maybe Object
forall a. Maybe a
Nothing

aesonText :: Data.Aeson.Value -> Maybe Text
aesonText :: Value -> Maybe Text
aesonText (Data.Aeson.String Text
x) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x
aesonText Value
_ = Maybe Text
forall a. Maybe a
Nothing