Skip to content

Commit 6492a44

Browse files
functorafunctora
committed
stripe wip
1 parent a3137b8 commit 6492a44

File tree

3 files changed

+188
-135
lines changed

3 files changed

+188
-135
lines changed

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -40,6 +40,7 @@ module Stripe.Client
4040
-- * Subscriptions
4141
SubscriptionId (..),
4242
SubscriptionItemId (..),
43+
SubscriptionStatus (..),
4344
Subscription (..),
4445
SubscriptionItem (..),
4546
SubscriptionCreate (..),

‎pub/stripe-hs/test/ApiSpec.hs‎

Lines changed: 173 additions & 134 deletions
Original file line numberDiff line numberDiff line change
@@ -1,168 +1,207 @@
11
module ApiSpec (apiSpec) where
22

3-
import Network.HTTP.Client
4-
import Network.HTTP.Client.TLS
5-
import Test.Hspec
3+
import qualified Data.Text as T
64
import Data.Time
75
import Data.Time.TimeSpan
8-
import System.Environment (getEnv)
9-
import qualified Data.Text as T
106
import qualified Data.Vector as V
11-
7+
import Network.HTTP.Client
8+
import Network.HTTP.Client.TLS
129
import Stripe.Client
10+
import System.Environment (getEnv)
11+
import Test.Hspec
1312

1413
makeClient :: IO StripeClient
1514
makeClient =
16-
do manager <- newManager tlsManagerSettings
17-
apiKey <- T.pack <$> getEnv "STRIPE_KEY"
18-
pure (makeStripeClient apiKey manager 2)
15+
do
16+
manager <- newManager tlsManagerSettings
17+
apiKey <- T.pack <$> getEnv "STRIPE_KEY"
18+
pure (makeStripeClient apiKey manager 2)
1919

2020
forceSuccess :: (MonadFail m, Show a) => m (Either a b) -> m b
2121
forceSuccess req =
2222
req >>= \res ->
23-
case res of
24-
Left err -> fail (show err)
25-
Right ok -> pure ok
23+
case res of
24+
Left err -> fail (show err)
25+
Right ok -> pure ok
2626

2727
apiSpec :: Spec
2828
apiSpec =
29-
do describe "core api" apiTests
30-
describe "api" apiWorldTests
29+
do
30+
describe "core api" apiTests
31+
describe "api" apiWorldTests
3132

3233
apiTests :: SpecWith ()
3334
apiTests =
3435
beforeAll makeClient $
35-
do describe "events" $
36-
do it "lists events" $ \cli ->
37-
do _ <- forceSuccess $ createCustomer cli (CustomerCreate Nothing (Just "[email protected]"))
38-
res <- forceSuccess $ listEvents cli Nothing
39-
V.null (slData res) `shouldBe` False
40-
describe "products" $
41-
do it "creates a product" $ \cli ->
42-
do res <- forceSuccess $ createProduct cli (ProductCreate "Test" Nothing)
43-
prName res `shouldBe` "Test"
36+
do
37+
describe "events" $
38+
do
39+
it "lists events" $ \cli ->
40+
do
41+
_ <-
42+
forceSuccess $
43+
createCustomer cli (CustomerCreate Nothing (Just "[email protected]"))
44+
res <- forceSuccess $ listEvents cli Nothing
45+
V.null (slData res) `shouldBe` False
46+
describe "products" $
47+
do
48+
it "creates a product" $ \cli ->
49+
do
50+
res <- forceSuccess $ createProduct cli (ProductCreate "Test" Nothing)
51+
prName res `shouldBe` "Test"
4452
it "retrieves a product" $ \cli ->
45-
do res <- forceSuccess $ createProduct cli (ProductCreate "Test" Nothing)
46-
res2 <- forceSuccess $ retrieveProduct cli (prId res)
47-
res `shouldBe` res2
48-
describe "prices" $
49-
do it "creates a price" $ \cli ->
50-
do prod <- forceSuccess $ createProduct cli (ProductCreate "Test" Nothing)
51-
res <-
52-
forceSuccess $
53-
createPrice cli $
54-
PriceCreate "usd" (Just 1000) (prId prod) (Just "lk") True $
55-
Just (PriceCreateRecurring "month" Nothing)
56-
pCurrency res `shouldBe` "usd"
57-
pUnitAmount res `shouldBe` Just 1000
58-
pType res `shouldBe` "recurring"
59-
pLookupKey res `shouldBe` Just "lk"
60-
pRecurring res `shouldBe` Just (PriceRecurring "month" 1)
53+
do
54+
res <- forceSuccess $ createProduct cli (ProductCreate "Test" Nothing)
55+
res2 <- forceSuccess $ retrieveProduct cli (prId res)
56+
res `shouldBe` res2
57+
describe "prices" $
58+
do
59+
it "creates a price" $ \cli ->
60+
do
61+
prod <- forceSuccess $ createProduct cli (ProductCreate "Test" Nothing)
62+
res <-
63+
forceSuccess $
64+
createPrice cli $
65+
PriceCreate "usd" (Just 1000) (prId prod) (Just "lk") True $
66+
Just (PriceCreateRecurring "month" Nothing)
67+
pCurrency res `shouldBe` "usd"
68+
pUnitAmount res `shouldBe` Just 1000
69+
pType res `shouldBe` "recurring"
70+
pLookupKey res `shouldBe` Just "lk"
71+
pRecurring res `shouldBe` Just (PriceRecurring "month" 1)
6172
it "retrieves a price" $ \cli ->
62-
do prod <- forceSuccess $ createProduct cli (ProductCreate "Test" Nothing)
63-
res <-
64-
forceSuccess $
65-
createPrice cli $
66-
PriceCreate "usd" (Just 1000) (prId prod) Nothing False $
67-
Just (PriceCreateRecurring "month" Nothing)
68-
res2 <- forceSuccess $ retrievePrice cli (pId res)
69-
res `shouldBe` res2
73+
do
74+
prod <- forceSuccess $ createProduct cli (ProductCreate "Test" Nothing)
75+
res <-
76+
forceSuccess $
77+
createPrice cli $
78+
PriceCreate "usd" (Just 1000) (prId prod) Nothing False $
79+
Just (PriceCreateRecurring "month" Nothing)
80+
res2 <- forceSuccess $ retrievePrice cli (pId res)
81+
res `shouldBe` res2
7082
it "lists by lookup_key" $ \cli ->
71-
do prod <- forceSuccess $ createProduct cli (ProductCreate "Test" Nothing)
72-
price <-
73-
forceSuccess $
74-
createPrice cli $
75-
PriceCreate "usd" (Just 1000) (prId prod) (Just "the_key") True $
76-
Just (PriceCreateRecurring "month" Nothing)
77-
res <- forceSuccess $ listPrices cli (Just "the_key")
78-
pId (V.head (slData res)) `shouldBe` pId price
79-
res2 <- forceSuccess $ listPrices cli (Just "KEY_NOT_EXISTING_OK")
80-
V.null (slData res2) `shouldBe` True
81-
describe "customers" $
82-
do it "creates a customer" $ \cli ->
83-
do cr <- forceSuccess $ createCustomer cli (CustomerCreate Nothing (Just "[email protected]"))
84-
cEmail cr `shouldBe` Just "[email protected]"
83+
do
84+
prod <- forceSuccess $ createProduct cli (ProductCreate "Test" Nothing)
85+
price <-
86+
forceSuccess $
87+
createPrice cli $
88+
PriceCreate "usd" (Just 1000) (prId prod) (Just "the_key") True $
89+
Just (PriceCreateRecurring "month" Nothing)
90+
res <- forceSuccess $ listPrices cli (Just "the_key")
91+
pId (V.head (slData res)) `shouldBe` pId price
92+
res2 <- forceSuccess $ listPrices cli (Just "KEY_NOT_EXISTING_OK")
93+
V.null (slData res2) `shouldBe` True
94+
describe "customers" $
95+
do
96+
it "creates a customer" $ \cli ->
97+
do
98+
cr <-
99+
forceSuccess $
100+
createCustomer cli (CustomerCreate Nothing (Just "[email protected]"))
101+
cEmail cr `shouldBe` Just "[email protected]"
85102
it "retrieves a customer" $ \cli ->
86-
do cr <- forceSuccess $ createCustomer cli (CustomerCreate Nothing (Just "[email protected]"))
87-
cu <- forceSuccess $ retrieveCustomer cli (cId cr)
88-
cu `shouldBe` cr
103+
do
104+
cr <-
105+
forceSuccess $
106+
createCustomer cli (CustomerCreate Nothing (Just "[email protected]"))
107+
cu <- forceSuccess $ retrieveCustomer cli (cId cr)
108+
cu `shouldBe` cr
89109
it "updates a customer" $ \cli ->
90-
do cr <- forceSuccess $ createCustomer cli (CustomerCreate Nothing (Just "[email protected]"))
91-
cu <- forceSuccess $ updateCustomer cli (cId cr) (CustomerUpdate Nothing (Just "[email protected]"))
92-
cEmail cu `shouldBe` Just "[email protected]"
110+
do
111+
cr <-
112+
forceSuccess $
113+
createCustomer cli (CustomerCreate Nothing (Just "[email protected]"))
114+
cu <-
115+
forceSuccess $
116+
updateCustomer
117+
cli
118+
(cId cr)
119+
(CustomerUpdate Nothing (Just "[email protected]"))
120+
cEmail cu `shouldBe` Just "[email protected]"
93121

94-
data StripeWorld
95-
= StripeWorld
96-
{ swProduct :: Product
97-
, swPrice :: Price
98-
, swCustomer :: Customer
99-
} deriving (Show, Eq)
122+
data StripeWorld = StripeWorld
123+
{ swProduct :: Product,
124+
swPrice :: Price,
125+
swCustomer :: Customer
126+
}
127+
deriving (Show, Eq)
100128

101129
makeStripeWorld :: IO (StripeClient, StripeWorld)
102130
makeStripeWorld =
103-
do cli <- makeClient
104-
customer <-
105-
forceSuccess $
106-
createCustomer cli (CustomerCreate Nothing (Just "[email protected]"))
107-
prod <- forceSuccess $ createProduct cli (ProductCreate "Test" Nothing)
108-
price <-
109-
forceSuccess $
110-
createPrice cli $
111-
PriceCreate "usd" (Just 1000) (prId prod) Nothing False $
112-
Just (PriceCreateRecurring "month" Nothing)
113-
pure (cli, StripeWorld prod price customer)
131+
do
132+
cli <- makeClient
133+
customer <-
134+
forceSuccess $
135+
createCustomer cli (CustomerCreate Nothing (Just "[email protected]"))
136+
prod <- forceSuccess $ createProduct cli (ProductCreate "Test" Nothing)
137+
price <-
138+
forceSuccess $
139+
createPrice cli $
140+
PriceCreate "usd" (Just 1000) (prId prod) Nothing False $
141+
Just (PriceCreateRecurring "month" Nothing)
142+
pure (cli, StripeWorld prod price customer)
114143

115144
apiWorldTests :: SpecWith ()
116145
apiWorldTests =
117146
beforeAll makeStripeWorld $
118-
do describe "subscriptions" $
119-
do it "allows creating a subscription" $ \(cli, sw) ->
120-
do trialEnd <- TimeStamp . addUTCTimeTS (hours 1) <$> getCurrentTime
121-
subscription <-
122-
forceSuccess $
123-
createSubscription cli $
124-
SubscriptionCreate
125-
{ scCustomer = cId (swCustomer sw)
126-
, scItems = [SubscriptionCreateItem (pId (swPrice sw)) (Just 1)]
127-
, scCancelAtPeriodEnd = Just False
128-
, scTrialEnd = Just trialEnd
129-
}
130-
sCancelAtPeriodEnd subscription `shouldBe` False
131-
sCustomer subscription `shouldBe` cId (swCustomer sw)
132-
let items = sItems subscription
133-
fmap siPrice items `shouldBe` pure (swPrice sw)
134-
fmap siQuantity items `shouldBe` pure (Just 1)
135-
fmap siSubscription items `shouldBe` pure (sId subscription)
136-
sStatus subscription `shouldBe` "trialing"
137-
describe "customer portal" $
138-
do it "allows creating a customer portal (needs setup in dashboard)" $ \(cli, sw) ->
139-
do portal <-
140-
forceSuccess $
141-
createCustomerPortal cli (CustomerPortalCreate (cId (swCustomer sw)) (Just "https://athiemann.net/return"))
142-
cpCustomer portal `shouldBe` cId (swCustomer sw)
143-
cpReturnUrl portal `shouldBe` Just "https://athiemann.net/return"
144-
describe "checkout" $
145-
do it "create and retrieves a checkout session" $ \(cli, sw) ->
146-
do session <-
147-
forceSuccess $
148-
createCheckoutSession cli $
149-
CheckoutSessionCreate
150-
{ cscCancelUrl = "https://athiemann.net/cancel"
151-
, cscMode = "subscription"
152-
, cscPaymentMethodTypes = ["card"]
153-
, cscSuccessUrl = "https://athiemann.net/success"
154-
, cscClientReferenceId = Just "cool"
155-
, cscCustomer = Just (cId (swCustomer sw))
156-
, cscAllowPromotionCodes = Just True
157-
, cscLineItems = [CheckoutSessionCreateLineItem (pId (swPrice sw)) 1]
158-
}
159-
csClientReferenceId session `shouldBe` Just "cool"
160-
csCancelUrl session `shouldBe` "https://athiemann.net/cancel"
161-
csSuccessUrl session `shouldBe` "https://athiemann.net/success"
162-
csPaymentMethodTypes session `shouldBe` V.singleton "card"
163-
csAllowPromotionCodes session `shouldBe` Just True
147+
do
148+
describe "subscriptions" $
149+
do
150+
it "allows creating a subscription" $ \(cli, sw) ->
151+
do
152+
trialEnd <- TimeStamp . addUTCTimeTS (hours 1) <$> getCurrentTime
153+
subscription <-
154+
forceSuccess $
155+
createSubscription cli $
156+
SubscriptionCreate
157+
{ scCustomer = cId (swCustomer sw),
158+
scItems = [SubscriptionCreateItem (pId (swPrice sw)) (Just 1)],
159+
scCancelAtPeriodEnd = Just False,
160+
scTrialEnd = Just trialEnd
161+
}
162+
sCancelAtPeriodEnd subscription `shouldBe` False
163+
sCustomer subscription `shouldBe` cId (swCustomer sw)
164+
let items = sItems subscription
165+
fmap siPrice items `shouldBe` pure (swPrice sw)
166+
fmap siQuantity items `shouldBe` pure (Just 1)
167+
fmap siSubscription items `shouldBe` pure (sId subscription)
168+
sStatus subscription `shouldBe` SsTrialing
169+
describe "customer portal" $
170+
do
171+
it "allows creating a customer portal (needs setup in dashboard)" $ \(cli, sw) ->
172+
do
173+
portal <-
174+
forceSuccess $
175+
createCustomerPortal
176+
cli
177+
( CustomerPortalCreate (cId (swCustomer sw)) (Just "https://athiemann.net/return")
178+
)
179+
cpCustomer portal `shouldBe` cId (swCustomer sw)
180+
cpReturnUrl portal `shouldBe` Just "https://athiemann.net/return"
181+
describe "checkout" $
182+
do
183+
it "create and retrieves a checkout session" $ \(cli, sw) ->
184+
do
185+
session <-
186+
forceSuccess $
187+
createCheckoutSession cli $
188+
CheckoutSessionCreate
189+
{ cscCancelUrl = "https://athiemann.net/cancel",
190+
cscMode = "subscription",
191+
cscPaymentMethodTypes = ["card"],
192+
cscSuccessUrl = "https://athiemann.net/success",
193+
cscClientReferenceId = Just "cool",
194+
cscCustomer = Just (cId (swCustomer sw)),
195+
cscAllowPromotionCodes = Just True,
196+
cscLineItems = [CheckoutSessionCreateLineItem (pId (swPrice sw)) 1]
197+
}
198+
csClientReferenceId session `shouldBe` Just "cool"
199+
csCancelUrl session `shouldBe` "https://athiemann.net/cancel"
200+
csSuccessUrl session `shouldBe` "https://athiemann.net/success"
201+
csPaymentMethodTypes session `shouldBe` V.singleton "card"
202+
csAllowPromotionCodes session `shouldBe` Just True
164203

165-
sessionRetrieved <-
166-
forceSuccess $
167-
retrieveCheckoutSession cli (csId session)
168-
sessionRetrieved `shouldBe` session
204+
sessionRetrieved <-
205+
forceSuccess $
206+
retrieveCheckoutSession cli (csId session)
207+
sessionRetrieved `shouldBe` session

‎pub/stripe-servant/src/Stripe/Resources.hs‎

Lines changed: 14 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ module Stripe.Resources
2727
-- * Subscriptions
2828
SubscriptionId (..),
2929
SubscriptionItemId (..),
30+
SubscriptionStatus (..),
3031
Subscription (..),
3132
SubscriptionItem (..),
3233
SubscriptionCreate (..),
@@ -206,14 +207,25 @@ data ProductCreate = ProductCreate
206207
newtype SubscriptionId = SubscriptionId {unSubscriptionId :: T.Text}
207208
deriving (Show, Eq, ToJSON, FromJSON, ToHttpApiData)
208209

210+
data SubscriptionStatus
211+
= SsIncomplete
212+
| SsIncompleteExpired
213+
| SsTrialing
214+
| SsActive
215+
| SsPastDue
216+
| SsCanceled
217+
| SsUnpaid
218+
| SsPaused
219+
deriving stock (Eq, Ord, Show, Read, Data, Generic, Enum, Bounded)
220+
209221
data Subscription = Subscription
210222
{ sId :: SubscriptionId,
211223
sCancelAtPeriodEnd :: Bool,
212224
sCurrentPeriodEnd :: TimeStamp,
213225
sCurrentPeriodStart :: TimeStamp,
214226
sCustomer :: CustomerId,
215227
sItems :: StripeList SubscriptionItem,
216-
sStatus :: T.Text -- TODO: make enum
228+
sStatus :: SubscriptionStatus
217229
}
218230
deriving (Show, Eq)
219231

@@ -312,6 +324,7 @@ $(deriveJSON (jsonOpts 2) ''PriceRecurring)
312324
$(deriveJSON (jsonOpts 1) ''Price)
313325
$(deriveJSON (jsonOpts 2) ''Product)
314326
$(deriveJSON (jsonOpts 2) ''SubscriptionItem)
327+
$(deriveJSON (jsonOpts 2) ''SubscriptionStatus)
315328
$(deriveJSON (jsonOpts 1) ''Subscription)
316329
$(deriveJSON (jsonOpts 2) ''CustomerPortal)
317330

0 commit comments

Comments
 (0)