diff --git a/src/Stripe/Client.hs b/src/Stripe/Client.hs --- a/src/Stripe/Client.hs +++ b/src/Stripe/Client.hs @@ -14,7 +14,8 @@ , createProduct, retrieveProduct , createPrice, retrievePrice, listPrices -- * Subscriptions - , SubscriptionId(..) + , SubscriptionId(..), Subscription(..), SubscriptionItem(..), SubscriptionCreate(..), SubscriptionCreateItem(..) + , createSubscription, retrieveSubscription, listSubscriptions -- * Customer Portal , CustomerPortalId(..), CustomerPortal(..), CustomerPortalCreate(..) , createCustomerPortal @@ -84,6 +85,10 @@ EP(retrievePrice, PriceId, Price) EP(listPrices, Maybe T.Text, (StripeList Price)) +EP(createSubscription, SubscriptionCreate, Subscription) +EP(retrieveSubscription, SubscriptionId, Subscription) +EP(listSubscriptions, Maybe CustomerId, (StripeList Subscription)) + EP(createCheckoutSession, CheckoutSessionCreate, CheckoutSession) EP(retrieveCheckoutSession, CheckoutSessionId, CheckoutSession) @@ -95,6 +100,7 @@ (createCustomer' :<|> retrieveCustomer' :<|> updateCustomer' :<|> listCustomers') :<|> (createProduct' :<|> retrieveProduct') :<|> (createPrice' :<|> retrievePrice' :<|> listPrices') + :<|> (createSubscription' :<|> retrieveSubscription' :<|> listSubscriptions') :<|> (createCheckoutSession' :<|> retrieveCheckoutSession') :<|> (createCustomerPortal') :<|> (retrieveEvent' :<|> listEvents') diff --git a/stripe-hs.cabal b/stripe-hs.cabal --- a/stripe-hs.cabal +++ b/stripe-hs.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: e3b93721f97a9a10c4c1eac1e38649e238caceee6ce78dce82361e9f569a82e8 +-- hash: 88dc0e41a059a0c1c3ed3e4248d25365dd6abfbea3c24f3acbd80d7542e0014c name: stripe-hs -version: 0.1.0.0 +version: 0.1.1.0 synopsis: Unofficial Stripe client description: Unofficial Stripe client category: Web @@ -79,5 +79,6 @@ , stripe-servant , text , time + , timespan , vector default-language: Haskell2010 diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,6 +1,8 @@ import Network.HTTP.Client import Network.HTTP.Client.TLS import Test.Hspec +import Data.Time +import Data.Time.TimeSpan import Data.Time.Clock.POSIX import System.Environment (getEnv) import qualified Data.Text as T @@ -26,7 +28,8 @@ main :: IO () main = hspec $ - do describe "api" apiTests + do describe "core api" apiTests + describe "api" apiWorldTests describe "webhooks" webhookTests testStripeSignature :: BS.ByteString @@ -57,7 +60,7 @@ apiTests :: SpecWith () apiTests = - before makeClient $ + beforeAll makeClient $ do describe "events" $ do it "lists events" $ \cli -> do _ <- forceSuccess $ createCustomer cli (CustomerCreate Nothing (Just "mail@athiemann.net")) @@ -104,28 +107,72 @@ pId (V.head (slData res)) `shouldBe` pId price res2 <- forceSuccess $ listPrices cli (Just "KEY_NOT_EXISTING_OK") V.null (slData res2) `shouldBe` True - describe "customer portal" $ - do it "allows creating a customer portal (needs setup in dashboard)" $ \cli -> - do customer <- + describe "customers" $ + do it "creates a customer" $ \cli -> + do cr <- forceSuccess $ createCustomer cli (CustomerCreate Nothing (Just "mail@athiemann.net")) + cEmail cr `shouldBe` Just "mail@athiemann.net" + it "retrieves a customer" $ \cli -> + do cr <- forceSuccess $ createCustomer cli (CustomerCreate Nothing (Just "mail@athiemann.net")) + cu <- forceSuccess $ retrieveCustomer cli (cId cr) + cu `shouldBe` cr + it "updates a customer" $ \cli -> + do cr <- forceSuccess $ createCustomer cli (CustomerCreate Nothing (Just "mail@athiemann.net")) + cu <- forceSuccess $ updateCustomer cli (cId cr) (CustomerUpdate Nothing (Just "mail+2@athiemann.net")) + cEmail cu `shouldBe` Just "mail+2@athiemann.net" + +data StripeWorld + = StripeWorld + { swProduct :: Product + , swPrice :: Price + , swCustomer :: Customer + } deriving (Show, Eq) + +makeStripeWorld :: IO (StripeClient, StripeWorld) +makeStripeWorld = + do cli <- makeClient + customer <- + forceSuccess $ + createCustomer cli (CustomerCreate Nothing (Just "mail@athiemann.net")) + prod <- forceSuccess $ createProduct cli (ProductCreate "Test" Nothing) + price <- + forceSuccess $ + createPrice cli $ + PriceCreate "usd" (Just 1000) (prId prod) Nothing False $ + Just (PriceCreateRecurring "month" Nothing) + pure (cli, StripeWorld prod price customer) + +apiWorldTests :: SpecWith () +apiWorldTests = + beforeAll makeStripeWorld $ + do describe "subscriptions" $ + do it "allows creating a subscription" $ \(cli, sw) -> + do trialEnd <- TimeStamp . addUTCTimeTS (hours 1) <$> getCurrentTime + subscription <- forceSuccess $ - createCustomer cli (CustomerCreate Nothing (Just "mail@athiemann.net")) - portal <- + createSubscription cli $ + SubscriptionCreate + { scCustomer = cId (swCustomer sw) + , scItems = [SubscriptionCreateItem (pId (swPrice sw)) (Just 1)] + , scCancelAtPeriodEnd = Just False + , scTrialEnd = Just trialEnd + } + sCancelAtPeriodEnd subscription `shouldBe` False + sCustomer subscription `shouldBe` cId (swCustomer sw) + let items = sItems subscription + fmap siPrice items `shouldBe` pure (swPrice sw) + fmap siQuantity items `shouldBe` pure (Just 1) + fmap siSubscription items `shouldBe` pure (sId subscription) + sStatus subscription `shouldBe` "trialing" + describe "customer portal" $ + do it "allows creating a customer portal (needs setup in dashboard)" $ \(cli, sw) -> + do portal <- forceSuccess $ - createCustomerPortal cli (CustomerPortalCreate (cId customer) (Just "https://athiemann.net/return")) - cpCustomer portal `shouldBe` cId customer + createCustomerPortal cli (CustomerPortalCreate (cId (swCustomer sw)) (Just "https://athiemann.net/return")) + cpCustomer portal `shouldBe` cId (swCustomer sw) cpReturnUrl portal `shouldBe` Just "https://athiemann.net/return" describe "checkout" $ - do it "create and retrieves a checkout session" $ \cli -> - do prod <- forceSuccess $ createProduct cli (ProductCreate "Test" Nothing) - price <- - forceSuccess $ - createPrice cli $ - PriceCreate "usd" (Just 1000) (prId prod) Nothing False $ - Just (PriceCreateRecurring "month" Nothing) - customer <- - forceSuccess $ - createCustomer cli (CustomerCreate Nothing (Just "mail@athiemann.net")) - session <- + do it "create and retrieves a checkout session" $ \(cli, sw) -> + do session <- forceSuccess $ createCheckoutSession cli $ CheckoutSessionCreate @@ -134,8 +181,8 @@ , cscPaymentMethodTypes = ["card"] , cscSuccessUrl = "https://athiemann.net/success" , cscClientReferenceId = Just "cool" - , cscCustomer = Just (cId customer) - , cscLineItems = [CheckoutSessionCreateLineItem (pId price) 1] + , cscCustomer = Just (cId (swCustomer sw)) + , cscLineItems = [CheckoutSessionCreateLineItem (pId (swPrice sw)) 1] } csClientReferenceId session `shouldBe` Just "cool" csCancelUrl session `shouldBe` "https://athiemann.net/cancel" @@ -146,16 +193,3 @@ forceSuccess $ retrieveCheckoutSession cli (csId session) sessionRetrieved `shouldBe` session - - describe "customers" $ - do it "creates a customer" $ \cli -> - do cr <- forceSuccess $ createCustomer cli (CustomerCreate Nothing (Just "mail@athiemann.net")) - cEmail cr `shouldBe` Just "mail@athiemann.net" - it "retrieves a customer" $ \cli -> - do cr <- forceSuccess $ createCustomer cli (CustomerCreate Nothing (Just "mail@athiemann.net")) - cu <- forceSuccess $ retrieveCustomer cli (cId cr) - cu `shouldBe` cr - it "updates a customer" $ \cli -> - do cr <- forceSuccess $ createCustomer cli (CustomerCreate Nothing (Just "mail@athiemann.net")) - cu <- forceSuccess $ updateCustomer cli (cId cr) (CustomerUpdate Nothing (Just "mail+2@athiemann.net")) - cEmail cu `shouldBe` Just "mail+2@athiemann.net"