{-# OPTIONS_GHC -Wall -fno-warn-missing-signatures #-}
module Stripe.Wreq
(
get, get', Get (..)
, post, post', Post (..)
, delete, 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 Data.Aeson.Key
import qualified Data.Aeson.KeyMap
import qualified Control.Exception
import Control.Monad ((>=>))
import qualified Data.Bifunctor
import qualified Data.Semigroup
import Data.String (fromString)
import Prelude hiding (userError)
import qualified Data.ByteString
import qualified Data.ByteString.Lazy
import Control.Lens ((&), (.~), (?~), (^.), (<>~))
import Stripe.Concepts (ApiSecretKey (..), RequestApiVersion (..), ApiVersion (..))
import Data.Text (Text)
import qualified Data.Text
import Network.Wreq (FormParam (..))
import qualified Network.Wreq
import Network.Wreq.Session (Session)
import qualified Network.Wreq.Session
newtype StatusCode = StatusCode Int deriving StatusCode -> StatusCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatusCode -> StatusCode -> Bool
$c/= :: StatusCode -> StatusCode -> Bool
== :: StatusCode -> StatusCode -> Bool
$c== :: StatusCode -> StatusCode -> Bool
Eq
isSuccess :: StatusCode -> Bool
isSuccess :: StatusCode -> Bool
isSuccess (StatusCode Int
x) = Int
x forall a. Ord a => a -> a -> Bool
>= Int
200 Bool -> Bool -> Bool
&& Int
x forall a. Ord a => a -> a -> Bool
< Int
300
isError :: StatusCode -> Bool
isError :: StatusCode -> Bool
isError (StatusCode Int
x) = Int
x forall a. Ord a => a -> a -> Bool
>= Int
400 Bool -> Bool -> Bool
&& Int
x forall a. Ord a => a -> a -> Bool
< Int
600
isClientError :: StatusCode -> Bool
isClientError :: StatusCode -> Bool
isClientError (StatusCode Int
x) = Int
x forall a. Ord a => a -> a -> Bool
>= Int
400 Bool -> Bool -> Bool
&& Int
x forall a. Ord a => a -> a -> Bool
< Int
500
isServerError :: StatusCode -> Bool
isServerError :: StatusCode -> Bool
isServerError (StatusCode Int
x) = Int
x forall a. Ord a => a -> a -> Bool
>= Int
500 Bool -> Bool -> Bool
&& Int
x forall a. Ord a => a -> a -> Bool
< Int
600
badRequest400 :: StatusCode
badRequest400 :: StatusCode
badRequest400 = Int -> StatusCode
StatusCode Int
400
unauthorized401 :: StatusCode
unauthorized401 :: StatusCode
unauthorized401 = Int -> StatusCode
StatusCode Int
401
requestFailed402 :: StatusCode
requestFailed402 :: StatusCode
requestFailed402 = Int -> StatusCode
StatusCode Int
402
notFound404 :: StatusCode
notFound404 :: StatusCode
notFound404 = Int -> StatusCode
StatusCode Int
404
conflict409 :: StatusCode
conflict409 :: StatusCode
conflict409 = Int -> StatusCode
StatusCode Int
409
tooManyRequests429 :: StatusCode
tooManyRequests429 :: StatusCode
tooManyRequests429 = Int -> StatusCode
StatusCode Int
429
data Get =
Get
{ Get -> [Text]
getPath :: [Text]
, Get -> [(Text, Text)]
getParams :: [(Text, Text)]
}
data Post =
Post
{ Post -> [Text]
postPath :: [Text]
, Post -> [FormParam]
postParams :: [FormParam]
}
data Delete =
Delete
{ Delete -> [Text]
deletePath :: [Text]
, 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 forall a b. a -> (a -> b) -> b
& Lens' Options (Maybe Auth)
Network.Wreq.auth forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ApiSecretKey -> Auth
auth ApiSecretKey
key
forall a b. a -> (a -> b) -> b
& Lens' Options [(Text, Text)]
Network.Wreq.params forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Get -> [(Text, Text)]
getParams Get
x)
forall a b. a -> (a -> b) -> b
& Lens' Options [Header]
Network.Wreq.headers forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ (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 = 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 forall a b. a -> (a -> b) -> b
& Lens' Options (Maybe Auth)
Network.Wreq.auth forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ApiSecretKey -> Auth
auth ApiSecretKey
key
forall a b. a -> (a -> b) -> b
& Lens' Options [Header]
Network.Wreq.headers forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ (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 forall a b. a -> (a -> b) -> b
& Lens' Options (Maybe Auth)
Network.Wreq.auth forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ApiSecretKey -> Auth
auth ApiSecretKey
key
forall a b. a -> (a -> b) -> b
& Lens' Options [(Text, Text)]
Network.Wreq.params forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Delete -> [(Text, Text)]
deleteParams Delete
x)
forall a b. a -> (a -> b) -> b
& Lens' Options [Header]
Network.Wreq.headers forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ (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
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Data.Text.intercalate (String -> Text
Data.Text.pack String
"/")
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
urlBase forall a. a -> [a] -> [a]
:)
wreqDefaults :: Network.Wreq.Options
wreqDefaults :: Options
wreqDefaults = Options
Network.Wreq.defaults forall a b. a -> (a -> b) -> b
& Options -> Options
noCheckResponse
RequestApiVersion
DefaultApiVersion = []
requestApiVersionHeaders (OverrideApiVersion ApiVersion
v) = [forall {b} {a}. (IsString b, IsString a) => ApiVersion -> (a, b)
apiVersionHeader ApiVersion
v]
(ApiVersion Text
v) = (a
name, b
value)
where
name :: a
name = forall a. IsString a => String -> a
fromString String
"Stripe-Version"
value :: b
value = forall a. IsString a => String -> a
fromString (Text -> String
Data.Text.unpack Text
v)
noCheckResponse :: Network.Wreq.Options -> Network.Wreq.Options
noCheckResponse :: Options -> Options
noCheckResponse = Lens' Options (Maybe ResponseChecker)
Network.Wreq.checkResponse forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (\Request
_ Response BodyReader
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ())
auth :: ApiSecretKey -> Network.Wreq.Auth
auth :: ApiSecretKey -> Auth
auth (ApiSecretKey ByteString
key) = ByteString -> ByteString -> Auth
Network.Wreq.basicAuth ByteString
key ByteString
Data.ByteString.empty
newtype UserMessage = UserMessage Text deriving (UserMessage -> UserMessage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserMessage -> UserMessage -> Bool
$c/= :: UserMessage -> UserMessage -> Bool
== :: UserMessage -> UserMessage -> Bool
$c== :: UserMessage -> UserMessage -> Bool
Eq, Int -> UserMessage -> ShowS
[UserMessage] -> ShowS
UserMessage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserMessage] -> ShowS
$cshowList :: [UserMessage] -> ShowS
show :: UserMessage -> String
$cshow :: UserMessage -> String
showsPrec :: Int -> UserMessage -> ShowS
$cshowsPrec :: Int -> UserMessage -> ShowS
Show)
newtype LogMessage = LogMessage Text deriving (LogMessage -> LogMessage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogMessage -> LogMessage -> Bool
$c/= :: LogMessage -> LogMessage -> Bool
== :: LogMessage -> LogMessage -> Bool
$c== :: LogMessage -> LogMessage -> Bool
Eq, Int -> LogMessage -> ShowS
[LogMessage] -> ShowS
LogMessage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogMessage] -> ShowS
$cshowList :: [LogMessage] -> ShowS
show :: LogMessage -> String
$cshow :: LogMessage -> String
showsPrec :: Int -> LogMessage -> ShowS
$cshowsPrec :: Int -> LogMessage -> ShowS
Show)
data Error =
Error
{ Error -> [UserMessage]
userMessages :: [UserMessage]
, Error -> [LogMessage]
logMessages :: [LogMessage]
}
deriving (Error -> Error -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> 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
(forall a. Semigroup a => a -> a -> a
(Data.Semigroup.<>) [UserMessage]
x [UserMessage]
x')
(forall a. Semigroup a => a -> a -> a
(Data.Semigroup.<>) [LogMessage]
y [LogMessage]
y')
instance Monoid Error
where
mappend :: Error -> Error -> Error
mappend = forall a. Semigroup a => a -> a -> a
(Data.Semigroup.<>)
mempty :: Error
mempty = [UserMessage] -> [LogMessage] -> Error
Error forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
instance Control.Exception.Exception Error
userError
:: Text
-> Error
userError :: Text -> Error
userError Text
x = Error { userMessages :: [UserMessage]
userMessages = [Text -> UserMessage
UserMessage Text
x], logMessages :: [LogMessage]
logMessages = [] }
logError
:: 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
{ Response -> Either Text Value
responseBody :: Either Text Data.Aeson.Value
, Response -> StatusCode
responseCode :: StatusCode
}
wreqResponse :: WreqResponse -> Response
wreqResponse :: WreqResponse -> Response
wreqResponse WreqResponse
r =
Response
{ responseBody :: Either Text Value
responseBody =
WreqResponse
r forall s a. s -> Getting a s a -> a
^. forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
Network.Wreq.responseBody
forall a b. a -> (a -> b) -> b
& forall a. FromJSON a => ByteString -> Either String a
Data.Aeson.eitherDecode
forall a b. a -> (a -> b) -> b
& 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 forall s a. s -> Getting a s a -> a
^. forall body. Lens' (Response body) Status
Network.Wreq.responseStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Status Int
Network.Wreq.statusCode
forall a b. a -> (a -> b) -> b
& Int -> StatusCode
StatusCode
}
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 -> 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 -> forall a b. b -> Either a b
Right Value
val
Bool
False -> forall a b. a -> Either a b
Left (Value -> Error
responseValueError Value
val)
responseValueError :: Data.Aeson.Value -> Error
responseValueError :: Value -> Error
responseValueError Value
val
| Bool
isCardError = 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 = 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 forall a. Eq a => a -> a -> Bool
== 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" forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String -> Value -> Maybe Value
aesonAttr String
"message" 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" forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String -> Value -> Maybe Value
aesonAttr String
"type" forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Value -> Maybe Text
aesonText
aesonAttr :: String -> Data.Aeson.Value -> Maybe Data.Aeson.Value
aesonAttr :: String -> Value -> Maybe Value
aesonAttr String
x = Value -> Maybe Object
aesonObject forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> 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) = forall a. a -> Maybe a
Just Object
x
aesonObject Value
_ = forall a. Maybe a
Nothing
aesonText :: Data.Aeson.Value -> Maybe Text
aesonText :: Value -> Maybe Text
aesonText (Data.Aeson.String Text
x) = forall a. a -> Maybe a
Just Text
x
aesonText Value
_ = forall a. Maybe a
Nothing