stripe-http-client (empty) → 2.4.0
raw patch · 5 files changed
+275/−0 lines, 5 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, free, hspec, http-client, http-client-tls, http-types, stripe-core, stripe-http-client, stripe-tests, text
Files
- LICENSE +22/−0
- Setup.hs +2/−0
- src/Web/Stripe/Client/HttpClient.hs +161/−0
- stripe-http-client.cabal +53/−0
- tests/Main.hs +37/−0
+ LICENSE view
@@ -0,0 +1,22 @@+The MIT License (MIT)++Copyright (c) 2018 Christopher Reichert++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Web/Stripe/Client/HttpClient.hs view
@@ -0,0 +1,161 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++module Web.Stripe.Client.HttpClient+ (+ StripeRequest(..)+ , StripeError(..)+ , StripeConfig(..)++ , stripe+ , stripeManager+ , stripeConn++ -- * low-level+ , withConnection+ , withManager+ , callAPI++ ) where++import qualified Control.Arrow+import qualified Data.ByteString.Lazy as BSL+import qualified Data.Text.Encoding as TE+import qualified Network.HTTP.Types as Http++import Data.Aeson as A+import Data.ByteString (ByteString)+import Data.Monoid ((<>))+#if MIN_VERSION_http_client(0,5,13)+import Network.HTTP.Client as Http hiding (withManager, withConnection)+#else+import Network.HTTP.Client as Http hiding (withManager)+#endif+import Network.HTTP.Client.TLS as TLS++import qualified Web.Stripe.StripeRequest as S++import Web.Stripe.Client (APIVersion (..), StripeConfig (..),+ StripeError (..), StripeKey (..),+ StripeRequest, StripeReturn,+ attemptDecode, handleStream,+ parseFail, toBytestring, unknownCode)+++-- | Create a request to 'Stripe's API.+--+-- This function uses the global TLS manager from @http-client-tls@+-- via 'getGlobalManager'.+stripe :: FromJSON (StripeReturn a)+ => StripeConfig+ -> StripeRequest a+ -> IO (Either StripeError (StripeReturn a))+stripe config request = do+ man <- TLS.getGlobalManager+ callAPI man fromJSON config request++-- | Create a request to 'Stripe's API using a 'Manager'.+stripeManager :: FromJSON (StripeReturn a)+ => Manager+ -> StripeConfig+ -> StripeRequest a+ -> IO (Either StripeError (StripeReturn a))+stripeManager manager config request = callAPI manager fromJSON config request++-- | Create a request to 'Stripe's API using a 'Manager'.+--+-- This function is used to maintain compatibility w/+-- @stripe-http-streams@. However, the terminology in @http-streams@+-- uses 'Connection' whereas @http-client@ uses connection 'Manager'.+stripeConn :: FromJSON (StripeReturn a)+ => Manager+ -> StripeConfig+ -> StripeRequest a+ -> IO (Either StripeError (StripeReturn a))+stripeConn = stripeManager++withConnection :: (Manager -> IO (Either StripeError a))+ -> IO (Either StripeError a)+withConnection = withManager++withManager :: (Manager -> IO (Either StripeError a))+ -> IO (Either StripeError a)+withManager m = do++ -- @http-client@ has a set of deprecated `withManager` functions+ -- that are not necessary to safely prevent a 'Manager' from+ -- leaking resources. "Manager's will be closed and shutdown+ -- automatically (and safely) via gargage collection.+ manager <- TLS.getGlobalManager+ m manager++-- | Create a request to 'Stripe's API using an existing 'Manager'+--+-- This is a low-level function. In most cases you probably want to+-- use 'stripe' or 'stripeManager'.+callAPI :: Manager+ -> (Value -> Result b)+ -> StripeConfig+ -> StripeRequest a+ -> IO (Either StripeError b)+callAPI man fromJSON' config stripeRequest = do++ res <- httpLbs mkStripeRequest man++ let status = Http.statusCode (Http.responseStatus res)++ if not (attemptDecode status) then+ return unknownCode++ else do+ case A.eitherDecode (Http.responseBody res) of+ Left e -> pure $ parseFail e+ Right a -> pure $ handleStream fromJSON' status $ return a+ where+ mkStripeRequest =++ let req = Http.applyBasicAuth (getStripeKey (secretKey config)) mempty $+ defaultRequest {+ Http.method = m2m (S.method stripeRequest)+ , Http.secure = True+ , Http.host = "api.stripe.com"+ , Http.port = 443+ , Http.path = "/v1/" <> TE.encodeUtf8 (S.endpoint stripeRequest)+ , Http.requestHeaders = [+ ("Stripe-Version", toBytestring stripeVersion)+ , ("Connection", "Keep-Alive")+ ]+ , Http.checkResponse = \_ _ -> return ()+ }++ stripeQueryParams = fmap+ (Control.Arrow.second Just)+ (S.queryParams stripeRequest)++ in if S.GET == S.method stripeRequest then+ Http.setQueryString stripeQueryParams req+ else+ urlEncodeBody (S.queryParams stripeRequest) req++m2m :: S.Method -> Http.Method+m2m S.GET = Http.methodGet+m2m S.POST = Http.methodPost+m2m S.DELETE = Http.methodDelete++-- | This function is used instead of http-client's built-in 'urlEncodedBody' as+-- the request method is set explicitly to POST in 'urlEncodeBody' but Stripe+-- uses POST\/PUT\/DELETE. A PR should be submitted to http-client to fix+-- eventually.+urlEncodeBody :: [(ByteString, ByteString)] -> Request -> Request+urlEncodeBody headers req = req {+ requestBody = RequestBodyLBS (BSL.fromChunks body)+ , requestHeaders =+ ("Content-Type", "application/x-www-form-urlencoded")+ : filter (\(x, _) -> x /= "Content-Type") (requestHeaders req)+ }+ where+ body = pure (Http.renderSimpleQuery False headers)++stripeVersion :: APIVersion+stripeVersion = V20141007
+ stripe-http-client.cabal view
@@ -0,0 +1,53 @@+name: stripe-http-client+version: 2.4.0+license: MIT+license-file: LICENSE+author: Christopher Reichert+synopsis: Stripe API for Haskell - http-client backend+maintainer: creichert07@gmail.com+copyright: Copyright (c) 2018 Christopher Reichert+category: Web+build-type: Simple+cabal-version: >=1.10+Description:+ .+ <<https://stripe.com/img/navigation/logo@2x.png>>+ .+ [Access Stripe API using http-client]+ This package provides access to the Stripe API using `stripe-core`+ and `http-client`. See also the `stripe` package.++library+ hs-source-dirs: src+ default-language: Haskell2010+ exposed-modules: Web.Stripe.Client.HttpClient+ ghc-options: -Wall+ other-extensions: OverloadedStrings+ RecordWildCards+ build-depends: base >= 4.7 && < 5+ , bytestring >= 0.10 && < 0.11+ , text >= 1.1 && < 1.3+ , aeson >= 0.8 && < 0.10 || >= 0.11 && < 1.3+ , http-client+ , http-client-tls+ , http-types+ , stripe-core++Test-Suite tests+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: tests+ default-language: Haskell2010+ build-depends: base >= 4.7 && < 5+ , free >= 4.10 && < 6+ , hspec >= 2.1.0 && < 2.5+ , stripe-core+ , stripe-tests+ , http-client+ , stripe-http-client+ ghc-options: -Wall -threaded -rtsopts++source-repository head+ type: git+ subdir: stripe-http-client+ location: git://github.com/dmjio/stripe-haskell.git
+ tests/Main.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE CPP #-}+module Main where++import Control.Monad.Trans.Free (FreeF(..), FreeT(..))+#if MIN_VERSION_http_client(0,5,13)+import Network.HTTP.Client hiding (withConnection)+#else+import Network.HTTP.Client+#endif+import Web.Stripe.Client (StripeConfig(..), StripeError(..))+import Web.Stripe.Client.HttpClient (withConnection, callAPI)+import Web.Stripe.Test.AllTests (allTests)+import Web.Stripe.Test.Prelude (Stripe, StripeRequestF(..))++main :: IO ()+main = allTests runStripe++runStripe :: StripeConfig+ -> Stripe a+ -> IO (Either StripeError a)+runStripe config stripe =+ withConnection $ \conn ->+ runStripe' conn config stripe++runStripe' :: Manager+ -> StripeConfig+ -> Stripe a+ -> IO (Either StripeError a)+runStripe' manager config (FreeT m) =+ do f <- m+ case f of+ (Pure a) -> return (Right a)+ (Free (StripeRequestF req decode')) ->+ do r <- callAPI manager decode' config req+ case r of+ (Left e) -> return (Left e)+ (Right next) -> runStripe' manager config next