Wreq.hs

-- | 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 (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 x) = x >= 200 && x < 300

-- | @isError x@ is equivalent to @'isClientError' x || 'isServerError' x@.
isError :: StatusCode -> Bool
isError (StatusCode x) = x >= 400 && x < 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 x) = x >= 400 && x < 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 x) = x >= 500 && x < 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 400

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

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

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

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

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

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

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

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

get' :: Session -> ApiSecretKey -> RequestApiVersion -> Get -> IO WreqResponse
get' session key v x = Network.Wreq.Session.getWith opts session url
  where
    url = makeUrl (getPath x)
    opts =
      wreqDefaults
        & Network.Wreq.auth ?~ auth key
        & Network.Wreq.params .~ (getParams x)
        & Network.Wreq.headers <>~ (requestApiVersionHeaders v)

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

post' :: Session -> ApiSecretKey -> RequestApiVersion -> Post -> IO WreqResponse
post' session key v x = Network.Wreq.Session.postWith opts session url params
  where
    url = makeUrl (postPath x)
    params = postParams x
    opts =
      wreqDefaults
        & Network.Wreq.auth ?~ auth key
        & Network.Wreq.headers <>~ (requestApiVersionHeaders v)

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

delete' :: Session -> ApiSecretKey -> RequestApiVersion -> Delete -> IO WreqResponse
delete' session key v x = Network.Wreq.Session.deleteWith opts session url
  where
    url = makeUrl (deletePath x)
    opts =
      wreqDefaults
        & Network.Wreq.auth ?~ auth key
        & Network.Wreq.params .~ (deleteParams x)
        & Network.Wreq.headers <>~ (requestApiVersionHeaders v)

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

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

wreqDefaults :: Network.Wreq.Options
wreqDefaults = Network.Wreq.defaults & noCheckResponse

-- When using the default API version, no header is required.
requestApiVersionHeaders DefaultApiVersion = []
-- Overriding with a specific API version requires one header field.
requestApiVersionHeaders (OverrideApiVersion v) = [apiVersionHeader v]

-- The header field for specifying the API version.
apiVersionHeader (ApiVersion v) = (name, value)
  where
    name = fromString "Stripe-Version"
    value = fromString (Data.Text.unpack 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 = Network.Wreq.checkResponse ?~ (\_ _ -> 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 key) = Network.Wreq.basicAuth key Data.ByteString.empty

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

-- | An error message suitable for being shown to a user.
newtype UserMessage = UserMessage Text deriving (Eq, Show)

-- | An error message that should go into an error log, /not/ shown to a user.
newtype LogMessage = LogMessage Text deriving (Eq, Show)

data Error = Error
  { userMessages :: [UserMessage],
    logMessages :: [LogMessage]
  }
  deriving (Eq, Show)

instance Data.Semigroup.Semigroup Error where
  Error x y <> Error x' y' =
    Error
      ((Data.Semigroup.<>) x x')
      ((Data.Semigroup.<>) y y')

instance Monoid Error where
  mappend = (Data.Semigroup.<>)
  mempty = Error mempty mempty

instance Control.Exception.Exception Error

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

logError ::
  -- | An error message intended to go into a log file,
  --   /not/ to be shown to a user.
  Text ->
  Error
logError x = Error {userMessages = [], logMessages = [LogMessage 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.
    responseBody :: Either Text Data.Aeson.Value,
    -- | The status code of the HTTP response.
    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 r =
  Response
    { responseBody =
        r ^. Network.Wreq.responseBody
          & Data.Aeson.eitherDecode
          & Data.Bifunctor.first Data.Text.pack,
      responseCode =
        r
          ^. Network.Wreq.responseStatus
            . Network.Wreq.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 r =
  case (responseBody r) of
    Left e -> Left (logError e)
    Right val ->
      case isSuccess (responseCode r) of
        True -> Right val
        False -> Left (responseValueError 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 val
  | isCardError = foldMap userError (msg val)
  | otherwise = foldMap logError (msg val)
  where
    isCardError = typ val == Just (Data.Text.pack "card_error")

    msg = aesonAttr "error" >=> aesonAttr "message" >=> aesonText
    typ = aesonAttr "error" >=> aesonAttr "type" >=> aesonText

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

-- Internal Aeson decoding functions

aesonAttr :: String -> Data.Aeson.Value -> Maybe Data.Aeson.Value
aesonAttr x = aesonObject >=> Data.Aeson.KeyMap.lookup (Data.Aeson.Key.fromString x)

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

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