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 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)
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 :)
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