diff options
author | William Carroll <wpcarro@gmail.com> | 2020-08-10T14·02+0100 |
---|---|---|
committer | William Carroll <wpcarro@gmail.com> | 2020-08-10T14·02+0100 |
commit | 4ff1ea291c266c68acfd662b7439d5c2061907ea (patch) | |
tree | b019dcc69bbf4964b1964650f1f4e66bbed49cac /website/sandbox/learnpianochords/src/server/App.hs | |
parent | f61ed25755da89f6068efb75642e2ac22d268278 (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.hs | 18 |
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 |