diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,12 @@ Changelog ========= +1.0.1.16 - 2023-06-26 +-------------------------------------------------- + +Update stuff + + 1.0.1.15 - 2023-02-01 -------------------------------------------------- diff --git a/library/Stripe/Wreq.hs b/library/Stripe/Wreq.hs --- a/library/Stripe/Wreq.hs +++ b/library/Stripe/Wreq.hs @@ -1,185 +1,187 @@ -{-# OPTIONS_GHC -Wall -fno-warn-missing-signatures #-} - -{- | 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). -} - +-- | 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 + ( -- * Request - -- * Status code - , StatusCode (..) - -- ** Predicates - -- $predicates - , isSuccess, isError, isClientError, isServerError - -- ** Client error codes - -- $constants - , badRequest400, unauthorized401, requestFailed402 - , notFound404, conflict409, tooManyRequests429 + -- ** GET + get, + get', + Get (..), - -- * Re-exports from Wreq - , FormParam (..), Session, Network.Wreq.Session.newAPISession + -- ** POST + post, + post', + Post (..), - ) where + -- ** DELETE + delete, + delete', + Delete (..), --- aeson -import qualified Data.Aeson -import qualified Data.Aeson.Key -import qualified Data.Aeson.KeyMap + -- * Response + WreqResponse, + Response (..), + wreqResponse, + responseValue, + responseValueError, --- base -import qualified Control.Exception -import Control.Monad ((>=>)) -import qualified Data.Bifunctor -import qualified Data.Semigroup -import Data.String (fromString) -import Prelude hiding (userError) + -- * Error + Error (..), + UserMessage (..), + LogMessage (..), + userError, + logError, --- bytestring -import qualified Data.ByteString -import qualified Data.ByteString.Lazy + -- * Status code + StatusCode (..), --- lens -import Control.Lens ((&), (.~), (?~), (^.), (<>~)) + -- ** Predicates + -- $predicates + isSuccess, + isError, + isClientError, + isServerError, --- stripe-concepts -import Stripe.Concepts (ApiSecretKey (..), RequestApiVersion (..), ApiVersion (..)) + -- ** Client error codes + -- $constants + badRequest400, + unauthorized401, + requestFailed402, + notFound404, + conflict409, + tooManyRequests429, --- text -import Data.Text (Text) -import qualified Data.Text + -- * Re-exports from Wreq + FormParam (..), + Session, + Network.Wreq.Session.newAPISession, + ) +where --- wreq -import Network.Wreq (FormParam (..)) -import qualified Network.Wreq -import Network.Wreq.Session (Session) -import qualified Network.Wreq.Session +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." - -} - -newtype StatusCode = StatusCode Int deriving Eq - -{- $predicates - -Some basic functions for interpreting status codes. -} +-- | An HTTP status code returned by Stripe. +-- +-- "Stripe uses conventional HTTP response codes to indicate the success or failure +-- of an API request." - +newtype StatusCode = StatusCode Int deriving (Eq) -{- | "Codes in the 2xx range indicate success." - - -} +-- $predicates +-- +-- Some basic functions for interpreting status codes. +-- | "Codes in the 2xx range indicate success." - +-- isSuccess :: StatusCode -> Bool isSuccess (StatusCode x) = x >= 200 && x < 300 -{- | @isError x@ is equivalent to @'isClientError' x || 'isServerError' x@. -} - +-- | @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.)." - - -} - +-- | "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.)." - +-- isClientError :: StatusCode -> Bool isClientError (StatusCode x) = x >= 400 && x < 500 -{- | "Codes in the 5xx range indicate an error with Stripe's servers." - - -} - +-- | "Codes in the 5xx range indicate an error with Stripe's servers." - +-- 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." - - -} +-- $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." - +-- badRequest400 :: StatusCode badRequest400 = StatusCode 400 -{- | 401 - Unauthorized - -"No valid API key provided." - -} - +-- | 401 - Unauthorized +-- +-- "No valid API key provided." - unauthorized401 :: StatusCode unauthorized401 = StatusCode 401 -{- | 402 - Request Failed - -"The parameters were valid but the request failed." - - -} - +-- | 402 - Request Failed +-- +-- "The parameters were valid but the request failed." - +-- requestFailed402 :: StatusCode requestFailed402 = StatusCode 402 -{- | 404 - Not Found - -"The requested resource doesn't exist." - - -} - +-- | 404 - Not Found +-- +-- "The requested resource doesn't exist." - +-- notFound404 :: StatusCode notFound404 = StatusCode 404 -{- | 409 - Conflict - -"The request conflicts with another request (perhaps due to using the same -idempotent key)." - -} - +-- | 409 - Conflict +-- +-- "The request conflicts with another request (perhaps due to using the same +-- idempotent key)." - 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." - -} - +-- | 429 - Too Many Requests +-- +-- "Too many requests hit the API too quickly. We recommend an exponential backoff +-- of your requests." - tooManyRequests429 :: StatusCode tooManyRequests429 = StatusCode 429 ------------------------------------------------------------ -data Get = - Get - { getPath :: [Text] -- ^ URL path components - , getParams :: [(Text, Text)] -- ^ Query params - } +data Get = Get + { -- | URL path components + getPath :: [Text], + -- | Query params + getParams :: [(Text, Text)] + } -data Post = - Post - { postPath :: [Text] -- ^ URL path components - , postParams :: [FormParam] -- ^ Parameters to send in the request body - } +data Post = Post + { -- | URL path components + postPath :: [Text], + -- | Parameters to send in the request body + postParams :: [FormParam] + } -data Delete = - Delete - { deletePath :: [Text] -- ^ URL path components - , deleteParams :: [(Text, Text)] -- ^ Query params - } +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 @@ -188,9 +190,11 @@ 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) + 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 @@ -200,8 +204,10 @@ where url = makeUrl (postPath x) params = postParams x - opts = wreqDefaults & Network.Wreq.auth ?~ auth key - & Network.Wreq.headers <>~ (requestApiVersionHeaders v) + 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 @@ -210,16 +216,18 @@ 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) + 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.unpack . Data.Text.intercalate (Data.Text.pack "/") . (urlBase :) @@ -228,7 +236,6 @@ -- 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] @@ -238,137 +245,125 @@ 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 -} - +-- | 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." - - -} - +-- | 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." - +-- 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. -} - +-- | 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. --} - +-- | 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) +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 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 Monoid Error where + mappend = (Data.Semigroup.<>) + mempty = Error mempty mempty instance Control.Exception.Exception Error -userError - :: Text -- ^ An error message intended to be shown to a user. - -> Error - -userError x = Error { userMessages = [UserMessage x], logMessages = [] } - -logError - :: Text -- ^ An error message intended to go into a log file, - -- /not/ to be shown to a user. - -> Error +userError :: + -- | An error message intended to be shown to a user. + Text -> + Error +userError x = Error {userMessages = [UserMessage x], logMessages = []} -logError x = Error { userMessages = [], logMessages = [LogMessage x] } +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 - { responseBody :: Either Text Data.Aeson.Value - -- ^ 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. - , responseCode :: StatusCode - -- ^ The status code of the HTTP response. - } - -{- | Convert a 'WreqResponse' into a 'Response' by parsing the JSON response -body (the Stripe API always returns JSON) and getting the HTTP status code. -} +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 + & 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. -} - +-- | 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." - - -} + 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." - +-- responseValueError :: Data.Aeson.Value -> Error responseValueError val - | isCardError = foldMap userError (msg val) - | otherwise = foldMap logError (msg 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 + typ = aesonAttr "error" >=> aesonAttr "type" >=> aesonText ------------------------------------------------------------ diff --git a/stripe-wreq.cabal b/stripe-wreq.cabal --- a/stripe-wreq.cabal +++ b/stripe-wreq.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 name: stripe-wreq -version: 1.0.1.15 +version: 1.0.1.16 synopsis: Use the Stripe API via Wreq category: Web @@ -25,16 +25,17 @@ library hs-source-dirs: library - default-language: Haskell2010 + default-language: GHC2021 + ghc-options: -Wall -fno-warn-missing-signatures exposed-modules: Stripe.Wreq build-depends: , aeson ^>= 2.0.3 || ^>= 2.1 - , base ^>= 4.14 || ^>= 4.15 || ^>= 4.16 || ^>= 4.17 - , bytestring ^>= 0.10.12 || ^>= 0.11 + , base ^>= 4.16 || ^>= 4.17 || ^>= 4.18 + , bytestring ^>= 0.11 , lens ^>= 5.0.1 || ^>= 5.1 || ^>= 5.2 , stripe-concepts ^>= 1.0.3 - , text ^>= 1.2.4 || ^>= 2.0 + , text ^>= 1.2.5 || ^>= 2.0 , wreq ^>= 0.5.3