stripe-http-streams (empty) → 2.0.0
raw patch · 5 files changed
+252/−0 lines, 5 filesdep +HsOpenSSLdep +aesondep +basesetup-changed
Dependencies added: HsOpenSSL, aeson, base, bytestring, free, hspec, http-streams, io-streams, stripe-core, stripe-http-streams, stripe-tests, text
Files
- LICENSE +21/−0
- Setup.hs +2/−0
- src/Web/Stripe/Client/HttpStreams.hs +146/−0
- stripe-http-streams.cabal +51/−0
- tests/Main.hs +32/−0
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2014 David Johnson++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/HttpStreams.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+-- |+-- Module : Web.Stripe.Client.Internal+-- Copyright : (c) David Johnson, 2014+-- Maintainer : djohnson.m@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Web.Stripe.Client.HttpStreams+ ( stripe+ , stripeConn+ , withConnection+ , StripeRequest (..)+ , StripeError (..)+ , StripeConfig (..)+ -- * low-level+ , callAPI+ ) where++import Control.Exception (SomeException, finally, try)+import Control.Monad (when)+import Data.Aeson (Result(..), FromJSON, Value, fromJSON, json')+import qualified Data.ByteString as S+import Data.Monoid (mempty, (<>))+import qualified Data.Text.Encoding as T+import Network.Http.Client (Connection,+ baselineContextSSL, buildRequest,+ closeConnection,+ getStatusCode, http,+ inputStreamBody, openConnectionSSL,+ receiveResponse, sendRequest,+ setAuthorizationBasic, encodedFormBody,+ setContentType, setHeader)+import qualified Network.Http.Client as C+import OpenSSL (withOpenSSL)+import qualified System.IO.Streams as Streams+import qualified System.IO.Streams.Attoparsec as Streams+import System.IO.Streams.Attoparsec (ParseException(..))+import Web.Stripe.Client (APIVersion (..), Method(..), StripeConfig (..),+ StripeError (..),+ StripeErrorType (..), StripeRequest (..),+ StripeReturn, getStripeKey,+ toBytestring, toText,+ paramsToByteString, attemptDecode, unknownCode,+ handleStream+ )++------------------------------------------------------------------------------+-- | Create a request to `Stripe`'s API+stripe+ :: (FromJSON (StripeReturn a)) =>+ StripeConfig+ -> StripeRequest a+ -> IO (Either StripeError (StripeReturn a))+stripe config request =+ withConnection $ \conn -> do+ stripeConn conn config request++------------------------------------------------------------------------------+-- | Create a request to `Stripe`'s API using a connection opened+-- with `withConnection`+stripeConn+ :: (FromJSON (StripeReturn a)) =>+ Connection+ -> StripeConfig+ -> StripeRequest a+ -> IO (Either StripeError (StripeReturn a))+stripeConn conn config request =+ callAPI conn fromJSON config request++------------------------------------------------------------------------------+-- | Open a connection to the stripe API server+withConnection :: (Connection -> IO (Either StripeError a))+ -> IO (Either StripeError a)+withConnection f =+ withOpenSSL $ do+ ctx <- baselineContextSSL+ result <- try (openConnectionSSL ctx "api.stripe.com" 443) :: IO (Either SomeException Connection)+ case result of+ Left msg -> return $ Left $ StripeError ConnectionFailure (toText msg) Nothing Nothing Nothing+ Right conn -> (f conn) `finally` (closeConnection conn)++------------------------------------------------------------------------------+-- | Debug Helper+debug :: Bool+debug = False++------------------------------------------------------------------------------+-- | convert from stripe-core Method type to http-stream Method type+m2m :: Method -> C.Method+m2m GET = C.GET+m2m POST = C.POST+m2m DELETE = C.DELETE++------------------------------------------------------------------------------+-- | Create a request to `Stripe`'s API over an existing connection+--+-- see also: 'withConnection'+-- FIXME: all connection errors should be+-- turned into a `StripeError`. But that is not yet implemented.+--+-- NOTES: this a pretty low-level function. You probably want `stripe`+-- or `stripeConn`. If you call this function directly, you are+-- responsible for ensuring the JSON conversion function supplied is+-- correct for `StripeRequest`. In the rest of the library this+-- property is enforced automatically by the type-system. But adding+-- that constraint here made implementing the `Stripe` testing monad+-- difficult.+callAPI+ :: Connection -- ^ an open connection to the server (`withConnection`)+ -> (Value -> Result b) -- ^ function to convert JSON result to Haskell Value+ -> StripeConfig -- ^ StripeConfig+ -> StripeRequest a -- ^ StripeRequest+ -> IO (Either StripeError b)+callAPI conn fromJSON' StripeConfig {..} StripeRequest{..} = do+ let reqBody | method == GET = mempty+ | otherwise = queryParams+ reqURL | method == GET = S.concat [+ T.encodeUtf8 endpoint+ , "?"+ , paramsToByteString queryParams+ ]+ | otherwise = T.encodeUtf8 endpoint+ req <- buildRequest $ do+ http (m2m method) $ "/v1/" <> reqURL+ setAuthorizationBasic (getStripeKey secretKey) mempty+ setContentType "application/x-www-form-urlencoded"+ setHeader "Stripe-Version" (toBytestring V20141007)+ setHeader "Connection" "Keep-Alive"+ sendRequest conn req (encodedFormBody reqBody)+ receiveResponse conn $ \response inputStream ->+ do when debug $ print response+ let statusCode = getStatusCode response+ if not (attemptDecode statusCode)+ then return unknownCode+ else do -- FIXME: should we check the content-type instead+ -- assuming it is application/json? --DMJ: Stripe+ -- gaurantees it to be JSON + v <- try (Streams.parseFromStream json' inputStream)+ let r =+ case v of+ (Left (ParseException msg)) -> Error msg+ (Right a) -> Success a+ return $ handleStream fromJSON' statusCode r
+ stripe-http-streams.cabal view
@@ -0,0 +1,51 @@+name: stripe-http-streams+version: 2.0.0+license: MIT+license-file: LICENSE+author: David Johnson+maintainer: djohnson.m@gmail.com+copyright: Copyright (c) 2014 David M. Johnson+category: Web+build-type: Simple+cabal-version: >=1.10+Description:+ .+ <<https://stripe.com/img/navigation/logo@2x.png>>+ .+ [Access Stripe API using http-streams]+ This package provides access to the Stripe API using `stripe-core` and `http-streams`. See also the `stripe` package.++library+ hs-source-dirs: src+ default-language: Haskell2010+ exposed-modules: Web.Stripe.Client.HttpStreams+ other-extensions: OverloadedStrings, RecordWildCards+ build-depends: base >= 4.7 && < 5+ , aeson >= 0.8 && < 0.10+ , bytestring >= 0.10 && < 0.11+ , HsOpenSSL >= 0.11 && < 0.12+ , http-streams >= 0.7 && < 0.9+ , io-streams >= 1.2 && < 1.4+ , stripe-core >= 2.0 && < 2.1+ , text >= 1.1 && < 1.3+ ghc-options: -Wall++Test-Suite tests+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: tests+ build-depends: HsOpenSSL+ , base >= 4.7 && < 5+ , free >= 4.10 && < 4.13+ , hspec >= 2.1.0 && < 2.3+ , http-streams >= 0.7 && < 0.9+ , stripe-core >= 2.0 && < 2.1+ , stripe-http-streams >= 2.0 && < 2.1+ , stripe-tests >= 2.0 && < 2.1+ default-language: Haskell2010+ ghc-options: -Wall -threaded -rtsopts++source-repository head+ type: git+ subdir: stripe-http-streams+ location: git://github.com/dmjio/stripe-haskell.git
+ tests/Main.hs view
@@ -0,0 +1,32 @@+module Main where++import Control.Monad.Trans.Free (FreeF(..), FreeT(..))+import Network.Http.Client (Connection)+import Web.Stripe.Client (StripeConfig(..), StripeError(..))+import Web.Stripe.Client.HttpStreams (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' :: Connection+ -> StripeConfig+ -> Stripe a+ -> IO (Either StripeError a)+runStripe' conn config (FreeT m) =+ do f <- m+ case f of+ (Pure a) -> return (Right a)+ (Free (StripeRequestF req decode')) ->+ do r <- callAPI conn decode' config req+ case r of+ (Left e) -> return (Left e)+ (Right next) -> runStripe' conn config next