{-# OPTIONS_GHC -Wall #-}
module Stripe.Wreq
(
get, Get (..)
, post, Post (..)
, delete, Delete (..)
, WreqResponse, Response (..)
, wreqResponse, responseValue, responseValueError
, Error (..), UserMessage (..), LogMessage (..), userError, logError
, StatusCode (..)
, isSuccess, isError, isClientError, isServerError
, badRequest400, unauthorized401, requestFailed402
, notFound404, conflict409, tooManyRequests429
, FormParam (..), Session, Network.Wreq.Session.newAPISession
) where
import qualified Data.Aeson
import qualified Control.Exception
import Control.Monad ((>=>))
import qualified Data.Bifunctor
import qualified Data.Semigroup
import Prelude hiding (userError)
import qualified Data.ByteString
import qualified Data.ByteString.Lazy
import Control.Lens ((&), (.~), (?~), (^.))
import Stripe.Concepts (ApiSecretKey (..))
import Data.Text (Text)
import qualified Data.Text
import qualified Data.HashMap.Strict
import Network.Wreq (FormParam (..))
import qualified Network.Wreq
import Network.Wreq.Session (Session)
import qualified Network.Wreq.Session
newtype StatusCode = StatusCode Int deriving Eq
isSuccess :: StatusCode -> Bool
isSuccess (StatusCode x) = x >= 200 && x < 300
isError :: StatusCode -> Bool
isError (StatusCode x) = x >= 400 && x < 600
isClientError :: StatusCode -> Bool
isClientError (StatusCode x) = x >= 400 && x < 500
isServerError :: StatusCode -> Bool
isServerError (StatusCode x) = x >= 500 && x < 600
badRequest400 :: StatusCode
badRequest400 = StatusCode 400
unauthorized401 :: StatusCode
unauthorized401 = StatusCode 401
requestFailed402 :: StatusCode
requestFailed402 = StatusCode 402
notFound404 :: StatusCode
notFound404 = StatusCode 404
conflict409 :: StatusCode
conflict409 = StatusCode 409
tooManyRequests429 :: StatusCode
tooManyRequests429 = StatusCode 429
data Get =
Get
{ getPath :: [Text]
, getParams :: [(Text, Text)]
}
data Post =
Post
{ postPath :: [Text]
, postParams :: [FormParam]
}
data Delete =
Delete
{ deletePath :: [Text]
, deleteParams :: [(Text, Text)]
}
get :: Session -> ApiSecretKey -> Get -> IO WreqResponse
get session key 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)
post :: Session -> ApiSecretKey -> Post -> IO WreqResponse
post session key x = Network.Wreq.Session.postWith opts session url params
where
url = makeUrl (postPath x)
params = postParams x
opts = wreqDefaults & Network.Wreq.auth ?~ auth key
delete :: Session -> ApiSecretKey -> Delete -> IO WreqResponse
delete session key 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)
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
noCheckResponse :: Network.Wreq.Options -> Network.Wreq.Options
noCheckResponse = Network.Wreq.checkResponse ?~ (\_ _ -> return ())
auth :: ApiSecretKey -> Network.Wreq.Auth
auth (ApiSecretKey key) = Network.Wreq.basicAuth key Data.ByteString.empty
newtype UserMessage = UserMessage Text deriving (Eq, Show)
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
:: Text
-> Error
userError x = Error { userMessages = [UserMessage x], logMessages = [] }
logError
:: Text
-> Error
logError x = Error { userMessages = [], logMessages = [LogMessage x] }
type WreqResponse = Network.Wreq.Response Data.ByteString.Lazy.ByteString
data Response =
Response
{ responseBody :: Either Text Data.Aeson.Value
, responseCode :: StatusCode
}
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
}
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)
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
aesonAttr :: String -> Data.Aeson.Value -> Maybe Data.Aeson.Value
aesonAttr x = aesonObject >=> Data.HashMap.Strict.lookup (Data.Text.pack 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