stripe-hs-0.1.0.0: test/Spec.hs

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"