Skip to content

Commit b99a75c

Browse files
committed
stripe wip
1 parent d4cc783 commit b99a75c

File tree

26 files changed

+1431
-1
lines changed

26 files changed

+1431
-1
lines changed

cabal.project

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -70,6 +70,8 @@ else
7070
pub/functora/*.cabal
7171
pub/xlsx/*.cabal
7272
pub/bfx/*.cabal
73+
pub/stripe-servant/*.cabal
74+
pub/stripe-hs/*.cabal
7375
ghcjs/*/*.cabal
7476
optional-packages:
7577
prv/*/*.cabal

cfg/q3.cfg

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,7 @@ seta cg_drawHabarDecor 0
3434
seta cg_drawZoomScope 1
3535
seta cg_zoomScopeMGColor white
3636
seta cg_zoomScopeRGColor white
37-
seta cg_zoomToggle 0
37+
seta cg_zoomToggle 1
3838
seta cg_brightPlayers 0
3939
seta cg_drawFriend 0
4040
seta cg_drawTeamOverlay 0

nix/project.nix

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -44,6 +44,15 @@ in
4444
name = "functora";
4545
src = ./..;
4646
};
47+
modules = [
48+
{
49+
# enableProfiling = true;
50+
# enableLibraryProfiling = true;
51+
packages.stripe-hs.components.library.build-tools = [
52+
pkgs.haskellPackages.cpphs
53+
];
54+
}
55+
];
4756
# Specify the GHC version to use.
4857
#
4958
# NOTE : Fallback from 948 to 928 for aarch64 cross support.

pub/stripe-hs/.gitignore

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
.stack-work/
2+
*~

pub/stripe-hs/LICENSE

Lines changed: 30 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,30 @@
1+
Copyright Alexander Thiemann (c) 2020-2021
2+
3+
All rights reserved.
4+
5+
Redistribution and use in source and binary forms, with or without
6+
modification, are permitted provided that the following conditions are met:
7+
8+
* Redistributions of source code must retain the above copyright
9+
notice, this list of conditions and the following disclaimer.
10+
11+
* Redistributions in binary form must reproduce the above
12+
copyright notice, this list of conditions and the following
13+
disclaimer in the documentation and/or other materials provided
14+
with the distribution.
15+
16+
* Neither the name of Author name here nor the names of other
17+
contributors may be used to endorse or promote products derived
18+
from this software without specific prior written permission.
19+
20+
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21+
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22+
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23+
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24+
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25+
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26+
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27+
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28+
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29+
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30+
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

pub/stripe-hs/README.md

Lines changed: 56 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,56 @@
1+
# stripe-hs
2+
3+
Unofficial and incomplete Stripe SDK/client for Haskell. It's generated via `servant-client` from `stripe-servant` with a small amount of hand-written code. Contributions are welcome!
4+
5+
## Install
6+
7+
``` sh
8+
# stack
9+
stack install stripe-hs
10+
11+
# cabal
12+
cabal install stripe-hs
13+
```
14+
15+
## Example
16+
17+
``` haskell
18+
{-# LANGUAGE OverloadedStrings #-}
19+
import Stripe.Client
20+
21+
import System.Environment (getEnv)
22+
import Network.HTTP.Client
23+
import Network.HTTP.Client.TLS
24+
25+
main :: IO ()
26+
main =
27+
do manager <- newManager tlsManagerSettings
28+
apiKey <- T.pack <$> getEnv "STRIPE_KEY"
29+
-- create a stripe client that automatically retries up to 4 times on network
30+
-- errors
31+
let client = makeStripeClient apiKey manager 4
32+
result <-
33+
createCustomer cli (CustomerCreate Nothing (Just "[email protected]"))
34+
print result
35+
```
36+
37+
## Features
38+
39+
The package provides a module for webhook signature verification (see `Stripe.Webhook.Verify`).
40+
41+
The implementation retries automatically according to [Stripe's error handling documentation](https://stripe.com/docs/error-handling#safely-retrying-requests-with-idempotency).
42+
43+
### Supported APIs/Resources:
44+
45+
* Customers
46+
* Products
47+
* Prices
48+
* CustomerPortal
49+
* CheckoutSession
50+
* Events
51+
52+
*Note that all resources are likely missing fields. The library is currently focused on to be used in combination with Stripe's hosted surfaces (Customer Portal and Checkout).*
53+
54+
## Running the tests
55+
56+
You can run all tests with `stack test`. You'll need a Stripe testmode API Key assigned to the `STRIPE_KEY` environment variable and you'll need to setup a Customer Portal configuration in the Stripe dashboard before running them.

pub/stripe-hs/Setup.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
import Distribution.Simple
2+
main = defaultMain

pub/stripe-hs/package.yaml

Lines changed: 66 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,66 @@
1+
name: stripe-hs
2+
version: 0.3.0.0
3+
github: "agrafix/stripe-hs"
4+
license: BSD3
5+
author: "Alexander Thiemann <[email protected]>"
6+
maintainer: "Alexander Thiemann <[email protected]>"
7+
copyright: "2020-2021 Alexander Thiemann <[email protected]>"
8+
9+
extra-source-files:
10+
- README.md
11+
12+
synopsis: Unofficial Stripe client
13+
category: Web
14+
15+
description: Unofficial Stripe client
16+
17+
dependencies:
18+
- base >= 4.7 && < 5
19+
- aeson
20+
- casing
21+
- text
22+
- servant
23+
- servant-client
24+
- stripe-servant
25+
- http-client
26+
- cpphs
27+
- time
28+
- safe
29+
- cryptonite
30+
- memory
31+
- bytestring
32+
- http-types
33+
34+
default-extensions:
35+
- OverloadedStrings
36+
- DataKinds
37+
- TypeOperators
38+
- TypeFamilies
39+
- GADTs
40+
- FlexibleInstances
41+
- FlexibleContexts
42+
- MultiParamTypeClasses
43+
- StrictData
44+
- ScopedTypeVariables
45+
- DeriveGeneric
46+
- DeriveFunctor
47+
48+
library:
49+
source-dirs: src
50+
51+
tests:
52+
stripe-hs-test:
53+
main: Spec.hs
54+
source-dirs: test
55+
ghc-options:
56+
- -threaded
57+
- -rtsopts
58+
- -with-rtsopts=-N
59+
dependencies:
60+
- stripe-hs
61+
- hspec
62+
- http-client-tls
63+
- vector
64+
- timespan
65+
- containers
66+
- servant-client-core

pub/stripe-hs/src/Stripe/Client.hs

Lines changed: 114 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,114 @@
1+
{-# OPTIONS_GHC -cpp -pgmPcpphs -optP--cpp #-}
2+
{-# LANGUAGE CPP #-}
3+
module Stripe.Client
4+
( -- * Basics
5+
ApiKey, StripeClient, makeStripeClient, ClientError(..)
6+
-- * Helper types
7+
, TimeStamp(..), StripeList(..)
8+
-- * Customers
9+
, createCustomer, retrieveCustomer, updateCustomer, listCustomers
10+
, CustomerId(..), Customer(..), CustomerCreate(..), CustomerUpdate(..)
11+
-- * Product catalog
12+
, ProductId(..), PriceId(..), Product(..), Price(..), PriceRecurring(..)
13+
, ProductCreate(..), PriceCreate(..), PriceCreateRecurring(..)
14+
, createProduct, retrieveProduct
15+
, createPrice, retrievePrice, listPrices
16+
-- * Subscriptions
17+
, SubscriptionId(..), SubscriptionItemId(..), Subscription(..), SubscriptionItem(..), SubscriptionCreate(..), SubscriptionCreateItem(..)
18+
, createSubscription, retrieveSubscription, listSubscriptions
19+
-- * Customer Portal
20+
, CustomerPortalId(..), CustomerPortal(..), CustomerPortalCreate(..)
21+
, createCustomerPortal
22+
-- * Checkout
23+
, CheckoutSessionId(..), CheckoutSession(..), CheckoutSessionCreate(..), CheckoutSessionCreateLineItem(..)
24+
, createCheckoutSession, retrieveCheckoutSession
25+
-- * Events
26+
, retrieveEvent, listEvents
27+
, EventId(..), Event(..), EventData(..)
28+
)
29+
where
30+
31+
import Stripe.Api
32+
import Stripe.Resources
33+
import Stripe.Client.Internal.Helpers
34+
35+
import Data.Proxy
36+
import Servant.API
37+
import Servant.Client
38+
import Network.HTTP.Client (Manager)
39+
import qualified Data.Text as T
40+
import qualified Data.Text.Encoding as T
41+
42+
-- | Your Stripe API key. Can be obtained from the Stripe dashboard. Format: @sk_<mode>_<redacted>@
43+
type ApiKey = T.Text
44+
45+
-- | Holds a 'Manager' and your API key.
46+
data StripeClient
47+
= StripeClient
48+
{ scBasicAuthData :: BasicAuthData
49+
, scManager :: Manager
50+
, scMaxRetries :: Int
51+
}
52+
53+
-- | Construct a 'StripeClient'. Note that the passed 'Manager' must support https (e.g. via @http-client-tls@)
54+
makeStripeClient ::
55+
ApiKey
56+
-> Manager
57+
-> Int
58+
-- ^ Number of automatic retries the library should attempt. See also <https://stripe.com/docs/error-handling#safely-retrying-requests-with-idempotency Stripe Error Handling>
59+
-> StripeClient
60+
makeStripeClient k = StripeClient (BasicAuthData (T.encodeUtf8 k) "")
61+
62+
api :: Proxy StripeApi
63+
api = Proxy
64+
65+
stripeBaseUrl :: BaseUrl
66+
stripeBaseUrl = BaseUrl Https "api.stripe.com" 443 ""
67+
68+
#define EP(N, ARG, R) \
69+
N##' :: BasicAuthData -> ARG -> ClientM R;\
70+
N :: StripeClient -> ARG -> IO (Either ClientError R);\
71+
N sc a = runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scBasicAuthData sc) a) (mkClientEnv (scManager sc) stripeBaseUrl)
72+
73+
#define EP2(N, ARG, ARG2, R) \
74+
N##' :: BasicAuthData -> ARG -> ARG2 -> ClientM R;\
75+
N :: StripeClient -> ARG -> ARG2 -> IO (Either ClientError R);\
76+
N sc a b = runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scBasicAuthData sc) a b) (mkClientEnv (scManager sc) stripeBaseUrl)
77+
78+
#define EP3(N, ARG, ARG2, ARG3, R) \
79+
N##' :: BasicAuthData -> ARG -> ARG2 -> ARG3 -> ClientM R;\
80+
N :: StripeClient -> ARG -> ARG2 -> ARG3 -> IO (Either ClientError R);\
81+
N sc a b c = runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scBasicAuthData sc) a b c) (mkClientEnv (scManager sc) stripeBaseUrl)
82+
83+
EP(createCustomer, CustomerCreate, Customer)
84+
EP(retrieveCustomer, CustomerId, Customer)
85+
EP2(updateCustomer, CustomerId, CustomerUpdate, Customer)
86+
EP(listCustomers, Maybe CustomerId, (StripeList Customer))
87+
88+
EP(createProduct, ProductCreate, Product)
89+
EP(retrieveProduct, ProductId, Product)
90+
91+
EP(createPrice, PriceCreate, Price)
92+
EP(retrievePrice, PriceId, Price)
93+
EP(listPrices, Maybe T.Text, (StripeList Price))
94+
95+
EP(createSubscription, SubscriptionCreate, Subscription)
96+
EP(retrieveSubscription, SubscriptionId, Subscription)
97+
EP(listSubscriptions, Maybe CustomerId, (StripeList Subscription))
98+
99+
EP(createCheckoutSession, CheckoutSessionCreate, CheckoutSession)
100+
EP(retrieveCheckoutSession, CheckoutSessionId, CheckoutSession)
101+
102+
EP(createCustomerPortal, CustomerPortalCreate, CustomerPortal)
103+
104+
EP(retrieveEvent, EventId, Event)
105+
EP(listEvents, Maybe EventId, (StripeList Event))
106+
107+
(createCustomer' :<|> retrieveCustomer' :<|> updateCustomer' :<|> listCustomers')
108+
:<|> (createProduct' :<|> retrieveProduct')
109+
:<|> (createPrice' :<|> retrievePrice' :<|> listPrices')
110+
:<|> (createSubscription' :<|> retrieveSubscription' :<|> listSubscriptions')
111+
:<|> (createCheckoutSession' :<|> retrieveCheckoutSession')
112+
:<|> (createCustomerPortal')
113+
:<|> (retrieveEvent' :<|> listEvents')
114+
= client api
Lines changed: 25 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,25 @@
1+
-- | Private helper functions. Note that all contents of this module are excluded from the versioning scheme.
2+
{-# LANGUAGE BangPatterns #-}
3+
module Stripe.Client.Internal.Helpers where
4+
5+
import Servant.Client
6+
import Network.HTTP.Types.Status
7+
8+
runRequest :: Int -> Int -> IO (Either ClientError a) -> IO (Either ClientError a)
9+
runRequest maxRetries !retryCount makeRequest =
10+
do res <- makeRequest
11+
case res of
12+
Right ok -> pure (Right ok)
13+
Left err@(ConnectionError _) -> maybeRetry err
14+
Left err@(FailureResponse _ resp)
15+
| ("stripe-should-retry", "true") `elem` responseHeaders resp -> maybeRetry err
16+
| ("stripe-should-retry", "false") `elem` responseHeaders resp -> pure (Left err)
17+
| responseStatusCode resp == conflict409 -> maybeRetry err
18+
| statusCode (responseStatusCode resp) >= 500 -> maybeRetry err
19+
| otherwise -> pure (Left err)
20+
Left err -> pure (Left err)
21+
where
22+
maybeRetry err =
23+
if retryCount + 1 >= maxRetries
24+
then pure (Left err)
25+
else runRequest maxRetries (retryCount + 1) makeRequest

0 commit comments

Comments
 (0)