stripe-hs (empty) → 0.1.0.0
raw patch · 7 files changed
+483/−0 lines, 7 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, casing, cpphs, cryptonite, hspec, http-client, http-client-tls, memory, safe, servant, servant-client, stripe-hs, stripe-servant, text, time, vector
Files
- LICENSE +30/−0
- README.md +51/−0
- Setup.hs +2/−0
- src/Stripe/Client.hs +101/−0
- src/Stripe/Webhook/Verify.hs +55/−0
- stripe-hs.cabal +83/−0
- test/Spec.hs +161/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,51 @@+# stripe-hs++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!++## Install++``` sh+# stack+stack install stripe-hs++# cabal+cabal install stripe-hs+```++## Example++``` haskell+{-# LANGUAGE OverloadedStrings #-}+import Stripe.Client++import System.Environment (getEnv)+import Network.HTTP.Client+import Network.HTTP.Client.TLS++main :: IO ()+main =+ do manager <- newManager tlsManagerSettings+ apiKey <- T.pack <$> getEnv "STRIPE_KEY"+ let client = makeStripeClient apiKey manager+ result <-+ createCustomer cli (CustomerCreate Nothing (Just "mail@athiemann.net"))+ print result+```++## Features++The package provides a module for webhook signature verification (see `Stripe.Webhook.Verify`).++Supported APIs/Resources:+* Customers+* Products+* Prices+* CustomerPortal+* CheckoutSession+* Events++*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).*++## Running the tests++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Stripe/Client.hs view
@@ -0,0 +1,101 @@+{-# OPTIONS_GHC -cpp -pgmPcpphs -optP--cpp #-}+{-# LANGUAGE CPP #-}+module Stripe.Client+ ( -- * Basics+ ApiKey, StripeClient, makeStripeClient+ -- * Helper types+ , TimeStamp(..), StripeList(..)+ -- * Customers+ , createCustomer, retrieveCustomer, updateCustomer, listCustomers+ , Customer(..), CustomerCreate(..), CustomerUpdate(..)+ -- * Product catalog+ , ProductId(..), PriceId(..), Product(..), Price(..), PriceRecurring(..)+ , ProductCreate(..), PriceCreate(..), PriceCreateRecurring(..)+ , createProduct, retrieveProduct+ , createPrice, retrievePrice, listPrices+ -- * Subscriptions+ , SubscriptionId(..)+ -- * Customer Portal+ , CustomerPortalId(..), CustomerPortal(..), CustomerPortalCreate(..)+ , createCustomerPortal+ -- * Checkout+ , CheckoutSessionId(..), CheckoutSession(..), CheckoutSessionCreate(..), CheckoutSessionCreateLineItem(..)+ , createCheckoutSession, retrieveCheckoutSession+ -- * Events+ , retrieveEvent, listEvents+ , Event(..), EventData(..)+ )+where++import Stripe.Api+import Stripe.Resources++import Data.Proxy+import Servant.API+import Servant.Client+import Network.HTTP.Client (Manager)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T++-- | Your Stripe API key. Can be obtained from the Stripe dashboard. Format: @sk_<mode>_<redacted>@+type ApiKey = T.Text++-- | Holds a 'Manager' and your API key.+data StripeClient+ = StripeClient+ { scBasicAuthData :: BasicAuthData+ , scManager :: Manager+ }++-- | Construct a 'StripeClient'. Note that the passed 'Manager' must support https (e.g. via @http-client-tls@)+makeStripeClient :: ApiKey -> Manager -> StripeClient+makeStripeClient k = StripeClient (BasicAuthData (T.encodeUtf8 k) "")++api :: Proxy StripeApi+api = Proxy++stripeBaseUrl :: BaseUrl+stripeBaseUrl = BaseUrl Https "api.stripe.com" 443 ""++#define EP(N, ARG, R) \+ N##' :: BasicAuthData -> ARG -> ClientM R;\+ N :: StripeClient -> ARG -> IO (Either ClientError R);\+ N sc a = runClientM (N##' (scBasicAuthData sc) a) (mkClientEnv (scManager sc) stripeBaseUrl)++#define EP2(N, ARG, ARG2, R) \+ N##' :: BasicAuthData -> ARG -> ARG2 -> ClientM R;\+ N :: StripeClient -> ARG -> ARG2 -> IO (Either ClientError R);\+ N sc a b = runClientM (N##' (scBasicAuthData sc) a b) (mkClientEnv (scManager sc) stripeBaseUrl)++#define EP3(N, ARG, ARG2, ARG3, R) \+ N##' :: BasicAuthData -> ARG -> ARG2 -> ARG3 -> ClientM R;\+ N :: StripeClient -> ARG -> ARG2 -> ARG3 -> IO (Either ClientError R);\+ N sc a b c = runClientM (N##' (scBasicAuthData sc) a b c) (mkClientEnv (scManager sc) stripeBaseUrl)++EP(createCustomer, CustomerCreate, Customer)+EP(retrieveCustomer, CustomerId, Customer)+EP2(updateCustomer, CustomerId, CustomerUpdate, Customer)+EP(listCustomers, Maybe CustomerId, (StripeList Customer))++EP(createProduct, ProductCreate, Product)+EP(retrieveProduct, ProductId, Product)++EP(createPrice, PriceCreate, Price)+EP(retrievePrice, PriceId, Price)+EP(listPrices, Maybe T.Text, (StripeList Price))++EP(createCheckoutSession, CheckoutSessionCreate, CheckoutSession)+EP(retrieveCheckoutSession, CheckoutSessionId, CheckoutSession)++EP(createCustomerPortal, CustomerPortalCreate, CustomerPortal)++EP(retrieveEvent, EventId, Event)+EP(listEvents, Maybe EventId, (StripeList Event))++(createCustomer' :<|> retrieveCustomer' :<|> updateCustomer' :<|> listCustomers')+ :<|> (createProduct' :<|> retrieveProduct')+ :<|> (createPrice' :<|> retrievePrice' :<|> listPrices')+ :<|> (createCheckoutSession' :<|> retrieveCheckoutSession')+ :<|> (createCustomerPortal')+ :<|> (retrieveEvent' :<|> listEvents')+ = client api
+ src/Stripe/Webhook/Verify.hs view
@@ -0,0 +1,55 @@+module Stripe.Webhook.Verify+ ( verifyStripeSignature+ , WebhookSecret, VerificationResult(..)+ )+where++import Crypto.Hash.Algorithms+import Crypto.MAC.HMAC+import Data.Bifunctor+import Data.ByteArray.Encoding+import Data.Time+import Data.Time.Clock.POSIX+import Safe+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC++-- | Your webhook secret, can be obtained from the Stripe dashboard. Format: @whsec_<redacted>@+type WebhookSecret = BS.ByteString++-- | Output of the webhook signature verification+data VerificationResult+ = VOk UTCTime+ -- ^ Signature verification successful, check the time against the current time and reject /too old/ requests.+ | VFailed+ -- ^ Signature verification failed. Check that your 'WebhookSecret' is correct.+ | VInvalidSignature+ -- ^ Invalid signature. Verify that you are passing the raw contents of the @stripe-signature@ header.+ deriving (Show, Eq)++-- | Verify the @stripe-signature@ header+verifyStripeSignature ::+ WebhookSecret+ -- ^ Your webhook secret+ -> BS.ByteString+ -- ^ Value of the @stripe-signature@ header+ -> BS.ByteString+ -- ^ Raw request body received from Stripe+ -> VerificationResult+verifyStripeSignature secret sig rawBody =+ let sigMap = map (second (BS.drop 1) . BSC.break (\c -> c == '=')) . BSC.split ',' $ sig+ needed =+ do t <- lookup "t" sigMap+ (parsedTime :: Int) <- readMay (BSC.unpack t)+ v1 <- lookup "v1" sigMap+ pure (t, posixSecondsToUTCTime $ fromIntegral parsedTime, v1)+ in case needed of+ Nothing -> VInvalidSignature+ Just (rawTime, time, v1) ->+ let payload = rawTime <> BSC.singleton '.' <> rawBody+ computedSig :: HMAC SHA256+ computedSig = hmac secret payload+ hexSig = convertToBase Base16 computedSig+ in if hexSig == v1+ then VOk time+ else VFailed
+ stripe-hs.cabal view
@@ -0,0 +1,83 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: e3b93721f97a9a10c4c1eac1e38649e238caceee6ce78dce82361e9f569a82e8++name: stripe-hs+version: 0.1.0.0+synopsis: Unofficial Stripe client+description: Unofficial Stripe client+category: Web+homepage: https://github.com/agrafix/stripe-hs#readme+bug-reports: https://github.com/agrafix/stripe-hs/issues+author: Alexander Thiemann <mail@thiemann.at>+maintainer: Alexander Thiemann <mail@thiemann.at>+copyright: 2020 Alexander Thiemann <mail@thiemann.at>+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md++source-repository head+ type: git+ location: https://github.com/agrafix/stripe-hs++library+ exposed-modules:+ Stripe.Client+ Stripe.Webhook.Verify+ other-modules:+ Paths_stripe_hs+ hs-source-dirs:+ src+ default-extensions: OverloadedStrings DataKinds TypeOperators TypeFamilies GADTs FlexibleInstances FlexibleContexts MultiParamTypeClasses StrictData ScopedTypeVariables DeriveGeneric DeriveFunctor+ build-depends:+ aeson+ , base >=4.7 && <5+ , bytestring+ , casing+ , cpphs+ , cryptonite+ , http-client+ , memory+ , safe+ , servant+ , servant-client+ , stripe-servant+ , text+ , time+ default-language: Haskell2010++test-suite stripe-hs-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_stripe_hs+ hs-source-dirs:+ test+ default-extensions: OverloadedStrings DataKinds TypeOperators TypeFamilies GADTs FlexibleInstances FlexibleContexts MultiParamTypeClasses StrictData ScopedTypeVariables DeriveGeneric DeriveFunctor+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ aeson+ , base >=4.7 && <5+ , bytestring+ , casing+ , cpphs+ , cryptonite+ , hspec+ , http-client+ , http-client-tls+ , memory+ , safe+ , servant+ , servant-client+ , stripe-hs+ , stripe-servant+ , text+ , time+ , vector+ default-language: Haskell2010
+ test/Spec.hs view
@@ -0,0 +1,161 @@+import Network.HTTP.Client+import Network.HTTP.Client.TLS+import Test.Hspec+import Data.Time.Clock.POSIX+import System.Environment (getEnv)+import qualified Data.Text as T+import qualified Data.ByteString as BS+import qualified Data.Vector as V++import Stripe.Client+import Stripe.Webhook.Verify++makeClient :: IO StripeClient+makeClient =+ do manager <- newManager tlsManagerSettings+ apiKey <- T.pack <$> getEnv "STRIPE_KEY"+ pure (makeStripeClient apiKey manager)++forceSuccess :: (MonadFail m, Show a) => m (Either a b) -> m b+forceSuccess req =+ req >>= \res ->+ case res of+ Left err -> fail (show err)+ Right ok -> pure ok++main :: IO ()+main =+ hspec $+ do describe "api" apiTests+ describe "webhooks" webhookTests++testStripeSignature :: BS.ByteString+testStripeSignature =+ "t=1608784111"+ <> ",v1=3cef61e0cf5ad6e9832925080d463dd7396160f8371c430e426242f3f89f4126"+ <> ",v0=aa179c5358b80a557a960137a85279caa13b06a05390816b533c3c146127bbe0"++-- Don't worry, i've long deleted this one... obfuscating a bit so that search tools+-- don't find it an try it out.+testStripeSecret :: WebhookSecret+testStripeSecret =+ "wh" <> "sec_" <> "2FZJ5Kqdi6AF8fGCLOCP9lH8Hpw9DW6T"++webhookTests :: SpecWith ()+webhookTests =+ do it "accepts correctly signed webhooks" $+ do bs <- BS.readFile "test-data/customer_webhook.json"+ let stripped = BS.take (BS.length bs - 1) bs -- trim trailing newline+ time = posixSecondsToUTCTime 1608784111+ verifyStripeSignature testStripeSecret testStripeSignature stripped `shouldBe` VOk time+ it "fails incorrectly signed webhooks" $+ do let bs = "{\"foo\": 1234}"+ verifyStripeSignature testStripeSecret testStripeSignature bs `shouldBe` VFailed+ it "detects bad signatures" $+ do let bs = "{\"foo\": 1234}"+ verifyStripeSignature testStripeSecret "fooo" bs `shouldBe` VInvalidSignature++apiTests :: SpecWith ()+apiTests =+ before makeClient $+ do describe "events" $+ do it "lists events" $ \cli ->+ do _ <- forceSuccess $ createCustomer cli (CustomerCreate Nothing (Just "mail@athiemann.net"))+ res <- forceSuccess $ listEvents cli Nothing+ V.null (slData res) `shouldBe` False+ describe "products" $+ do it "creates a product" $ \cli ->+ do res <- forceSuccess $ createProduct cli (ProductCreate "Test" Nothing)+ prName res `shouldBe` "Test"+ it "retrieves a product" $ \cli ->+ do res <- forceSuccess $ createProduct cli (ProductCreate "Test" Nothing)+ res2 <- forceSuccess $ retrieveProduct cli (prId res)+ res `shouldBe` res2+ describe "prices" $+ do it "creates a price" $ \cli ->+ do prod <- forceSuccess $ createProduct cli (ProductCreate "Test" Nothing)+ res <-+ forceSuccess $+ createPrice cli $+ PriceCreate "usd" (Just 1000) (prId prod) (Just "lk") True $+ Just (PriceCreateRecurring "month" Nothing)+ pCurrency res `shouldBe` "usd"+ pUnitAmount res `shouldBe` Just 1000+ pType res `shouldBe` "recurring"+ pLookupKey res `shouldBe` Just "lk"+ pRecurring res `shouldBe` Just (PriceRecurring "month" 1)+ it "retrieves a price" $ \cli ->+ do prod <- forceSuccess $ createProduct cli (ProductCreate "Test" Nothing)+ res <-+ forceSuccess $+ createPrice cli $+ PriceCreate "usd" (Just 1000) (prId prod) Nothing False $+ Just (PriceCreateRecurring "month" Nothing)+ res2 <- forceSuccess $ retrievePrice cli (pId res)+ res `shouldBe` res2+ it "lists by lookup_key" $ \cli ->+ do prod <- forceSuccess $ createProduct cli (ProductCreate "Test" Nothing)+ price <-+ forceSuccess $+ createPrice cli $+ PriceCreate "usd" (Just 1000) (prId prod) (Just "the_key") True $+ Just (PriceCreateRecurring "month" Nothing)+ res <- forceSuccess $ listPrices cli (Just "the_key")+ 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 <-+ forceSuccess $+ createCustomer cli (CustomerCreate Nothing (Just "mail@athiemann.net"))+ portal <-+ forceSuccess $+ createCustomerPortal cli (CustomerPortalCreate (cId customer) (Just "https://athiemann.net/return"))+ cpCustomer portal `shouldBe` cId customer+ 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 <-+ forceSuccess $+ createCheckoutSession cli $+ CheckoutSessionCreate+ { cscCancelUrl = "https://athiemann.net/cancel"+ , cscMode = "subscription"+ , cscPaymentMethodTypes = ["card"]+ , cscSuccessUrl = "https://athiemann.net/success"+ , cscClientReferenceId = Just "cool"+ , cscCustomer = Just (cId customer)+ , cscLineItems = [CheckoutSessionCreateLineItem (pId price) 1]+ }+ csClientReferenceId session `shouldBe` Just "cool"+ csCancelUrl session `shouldBe` "https://athiemann.net/cancel"+ csSuccessUrl session `shouldBe` "https://athiemann.net/success"+ csPaymentMethodTypes session `shouldBe` V.singleton "card"++ sessionRetrieved <-+ 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"