subtree(users/wpcarro): docking briefcase at '24f5a642' r/3226

git-subtree-dir: users/wpcarro
git-subtree-mainline: 464bbcb15c09813172c79820bcf526bb10cf4208
git-subtree-split: 24f5a642af3aa1627bbff977f0a101907a02c69f
Change-Id: I6105b3762b79126b3488359c95978cadb3efa789

1 files changed, 57 insertions, 0 deletions

diff --git a/users/wpcarro/website/sandbox/learnpianochords/src/server/App.hs b/users/wpcarro/website/sandbox/learnpianochords/src/server/App.hs
new file mode 100644
index 0000000000..e23757b015
--- /dev/null
+++ b/users/wpcarro/website/sandbox/learnpianochords/src/server/App.hs
@@ -0,0 +1,57 @@
+--------------------------------------------------------------------------------
+module App where
+--------------------------------------------------------------------------------
+import RIO hiding (Handler)
+import Servant
+import API
+import Data.String.Conversions (cs)
+import Control.Monad.IO.Class (liftIO)
+import Network.Wai.Middleware.Cors
+import GoogleSignIn (EncodedJWT(..), ValidationResult(..))
+import Utils
+
+import qualified Network.Wai.Handler.Warp as Warp
+import qualified GoogleSignIn
+import qualified Stripe
+import qualified Types as T
+--------------------------------------------------------------------------------
+
+server :: T.Context -> Server API
+server ctx@T.Context{..} = verifyGoogleSignIn
+                      :<|> createPaymentIntent
+  where
+    verifyGoogleSignIn :: T.VerifyGoogleSignInRequest -> Handler NoContent
+    verifyGoogleSignIn T.VerifyGoogleSignInRequest{..} = do
+      validationResult <- liftIO $ GoogleSignIn.validateJWT False (EncodedJWT idToken)
+      case validationResult of
+        Valid _ -> do
+          -- If GoogleLinkedAccounts has email from JWT:
+          --   create a new session for email
+          -- Else:
+          --   Redirect the SPA to the sign-up / payment page
+          pure NoContent
+        err -> do
+          throwError err401 { errBody = err |> GoogleSignIn.explainResult |> cs }
+
+    createPaymentIntent :: T.PaymentIntent -> Handler T.CreatePaymentIntentResponse
+    createPaymentIntent pmt = do
+      clientSecret <- liftIO $ Stripe.createPaymentIntent ctx pmt
+      pure T.CreatePaymentIntentResponse{..}
+
+run :: T.App
+run = do
+  ctx@T.Context{..} <- ask
+  ctx
+    |> server
+    |> serve (Proxy @ API)
+    |> cors (const $ Just corsPolicy)
+    |> Warp.run contextServerPort
+    |> liftIO
+  pure $ Right ()
+  where
+    corsPolicy :: CorsResourcePolicy
+    corsPolicy = simpleCorsResourcePolicy
+      { corsOrigins = Just (["http://localhost:8000"], True)
+      , corsMethods = simpleMethods ++ ["PUT", "PATCH", "DELETE", "OPTIONS"]
+      , corsRequestHeaders = simpleHeaders ++ ["Content-Type", "Authorization"]
+      }