1 files changed, 29 insertions, 0 deletions
diff --git a/website/sandbox/learnpianochords/src/server/Stripe.hs b/website/sandbox/learnpianochords/src/server/Stripe.hs
new file mode 100644
index 000000000000..5370b90abebf
--- /dev/null
+++ b/website/sandbox/learnpianochords/src/server/Stripe.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE DataKinds #-}
+--------------------------------------------------------------------------------
+module Stripe where
+--------------------------------------------------------------------------------
+import RIO
+import Prelude (print)
+import Data.String.Conversions (cs)
+import Data.Aeson
+import Network.HTTP.Req
+
+import qualified Types as T
+--------------------------------------------------------------------------------
+
+endpoint :: Text -> Url 'Https
+endpoint slug =
+  https "api.stripe.com" /: "v1" /: slug
+
+post :: (FromJSON b) => Text -> Text -> T.PaymentIntent -> IO (JsonResponse b)
+post apiKey slug T.PaymentIntent{..} = runReq defaultHttpConfig $ do
+  let params = "amount" =: paymentIntentAmount
+            <> "currency" =: paymentIntentCurrency
+  req POST (endpoint slug) (ReqBodyUrlEnc params) jsonResponse (oAuth2Bearer (cs apiKey))
+
+createPaymentIntent :: T.Context -> T.PaymentIntent -> IO T.Secret
+createPaymentIntent T.Context{..} pmtIntent = do
+  res <- post contextStripeAPIKey "payment_intents" pmtIntent
+  let T.StripePaymentIntent{..} = responseBody res :: T.StripePaymentIntent
+  pure pmtIntentClientSecret