about summary refs log tree commit diff
path: root/website/sandbox/learnpianochords/src/server/App.hs
diff options
context:
space:
mode:
authorWilliam Carroll <wpcarro@gmail.com>2020-08-10T14·02+0100
committerWilliam Carroll <wpcarro@gmail.com>2020-08-10T14·02+0100
commit4ff1ea291c266c68acfd662b7439d5c2061907ea (patch)
treeb019dcc69bbf4964b1964650f1f4e66bbed49cac /website/sandbox/learnpianochords/src/server/App.hs
parentf61ed25755da89f6068efb75642e2ac22d268278 (diff)
Drop support for ServantT transformer type for server
After burning a few hours wrestling with the type system, I decided to revert to
the simpler `Server API` type instead of the `ServantT` transformer type.

The problem is that I couldn't write a MonadError instance for `RIO Context`,
which is my `AppM` (i.e. application monad). Using `throwIO` in the server
handlers results in 500 errors, which is not what I wanted. I'm still pretty
fuzzy about what's happening; I now know that exception handling in Haskell is
pretty gnaryly. I may revisit this at a later time when my knowledge is more
extensive. For now: time to fry bigger fish.

An easier abstract is for me to pass `T.Context` into `server` as an argument,
which after all is what a Reader does.

TL;DR:
- Read server, client ports from .envrc
- Define a top-level Failure type (empty for now)
- Define a top-level Success type
- Define App as RIO Context (Either Failure Success)
Diffstat (limited to 'website/sandbox/learnpianochords/src/server/App.hs')
-rw-r--r--website/sandbox/learnpianochords/src/server/App.hs18
1 files changed, 8 insertions, 10 deletions
diff --git a/website/sandbox/learnpianochords/src/server/App.hs b/website/sandbox/learnpianochords/src/server/App.hs
index 095e6169b8eb..92dee6045d46 100644
--- a/website/sandbox/learnpianochords/src/server/App.hs
+++ b/website/sandbox/learnpianochords/src/server/App.hs
@@ -15,12 +15,11 @@ import qualified GoogleSignIn
 import qualified Types as T
 --------------------------------------------------------------------------------
 
-server :: ServerT API T.App
-server = verifyGoogleSignIn
+server :: T.Context -> Server API
+server T.Context{..} = verifyGoogleSignIn
   where
-    verifyGoogleSignIn :: T.VerifyGoogleSignInRequest -> T.App NoContent
+    verifyGoogleSignIn :: T.VerifyGoogleSignInRequest -> Handler NoContent
     verifyGoogleSignIn T.VerifyGoogleSignInRequest{..} = do
-      T.Context{..} <- ask
       validationResult <- liftIO $ GoogleSignIn.validateJWT False (EncodedJWT idToken)
       case validationResult of
         Valid _ -> do
@@ -30,19 +29,18 @@ server = verifyGoogleSignIn
           --   Redirect the SPA to the sign-up / payment page
           pure NoContent
         err -> do
-          -- TODO: I would prefer to use `throwError` here, but after changing
-          -- to ServerT, I couldn't get the code to compile.
-          throwIO err401 { errBody = err |> GoogleSignIn.explainResult |> cs }
+          throwError err401 { errBody = err |> GoogleSignIn.explainResult |> cs }
 
-run :: T.App ()
+run :: T.App
 run = do
   ctx@T.Context{..} <- ask
-  server
-    |> hoistServer (Proxy @ API) (runRIO ctx)
+  ctx
+    |> server
     |> serve (Proxy @ API)
     |> cors (const $ Just corsPolicy)
     |> Warp.run contextServerPort
     |> liftIO
+  pure $ Right ()
   where
     corsPolicy :: CorsResourcePolicy
     corsPolicy = simpleCorsResourcePolicy