about summary refs log tree commit diff
path: root/website/sandbox/learnpianochords/src/server/Main.hs
diff options
context:
space:
mode:
authorWilliam Carroll <wpcarro@gmail.com>2020-08-09T21·17+0100
committerWilliam Carroll <wpcarro@gmail.com>2020-08-09T21·17+0100
commitbbcd0bf27d2663a9673983ccf6e2cf7034ddf240 (patch)
tree18c6fa980ffce4a598e4889ea56510fd2f21495f /website/sandbox/learnpianochords/src/server/Main.hs
parent7d85ba559dd50e0552abccb45d1cf5766ebcb541 (diff)
Replace Prelude with RIO
I believe RIO stands for: "ReaderT <something-something> IO", which is a nod to
the top-level application data type:

```haskell
-- This is a simplification
newtype RIO env a = RIO { runRIO :: ReaderT env a () }
```

I read about RIO from an FP-Complete blog post a few months ago, and now I'm
excited to try it out for a real project. Bon voyage!
Diffstat (limited to 'website/sandbox/learnpianochords/src/server/Main.hs')
-rw-r--r--website/sandbox/learnpianochords/src/server/Main.hs51
1 files changed, 20 insertions, 31 deletions
diff --git a/website/sandbox/learnpianochords/src/server/Main.hs b/website/sandbox/learnpianochords/src/server/Main.hs
index ae3562d48486..36044d2585eb 100644
--- a/website/sandbox/learnpianochords/src/server/Main.hs
+++ b/website/sandbox/learnpianochords/src/server/Main.hs
@@ -1,41 +1,30 @@
 --------------------------------------------------------------------------------
 module Main where
 --------------------------------------------------------------------------------
-import Servant
-import API
-import Control.Monad.IO.Class (liftIO)
-import GoogleSignIn (EncodedJWT(..), ValidationResult(..))
-import Data.String.Conversions (cs)
-import Utils
+import RIO
+import Prelude (putStrLn)
 
-import qualified Network.Wai.Handler.Warp as Warp
-import qualified Network.Wai.Middleware.Cors as Cors
 import qualified Types as T
-import qualified GoogleSignIn
+import qualified System.Envy as Envy
+import qualified App
 --------------------------------------------------------------------------------
 
-server :: Server API
-server = verifyGoogleSignIn
-  where
-    verifyGoogleSignIn :: T.VerifyGoogleSignInRequest -> Handler NoContent
-    verifyGoogleSignIn T.VerifyGoogleSignInRequest{..} = do
-    validationResult <- liftIO $ GoogleSignIn.validateJWT False (EncodedJWT idToken)
-    case validationResult of
-      Valid _ -> do
-        liftIO $ putStrLn "Sign-in valid! Let's create a session"
-        pure NoContent
-      err -> do
-        throwError err401 { errBody = err |> GoogleSignIn.explainResult |> cs }
+-- | Attempt to read environment variables from the system and initialize the
+-- Context data type for our application.
+getAppContext :: IO (Either String T.Context)
+getAppContext = do
+  mEnv <- Envy.decodeEnv
+  case mEnv of
+    Left err -> pure $ Left err
+    Right T.Env{..} -> pure $ Right T.Context
+      { contextGoogleClientID = envGoogleClientID
+      , contextClientPort = 8000
+      , contextServerPort = 3000
+      }
 
 main :: IO ()
 main = do
-  Warp.run 3000 (enforceCors $ serve (Proxy @ API) $ server)
-  where
-    enforceCors = Cors.cors (const $ Just corsPolicy)
-    corsPolicy :: Cors.CorsResourcePolicy
-    corsPolicy =
-      Cors.simpleCorsResourcePolicy
-        { Cors.corsOrigins = Just (["http://localhost:8000"], True)
-        , Cors.corsMethods = Cors.simpleMethods ++ ["PUT", "PATCH", "DELETE", "OPTIONS"]
-        , Cors.corsRequestHeaders = Cors.simpleHeaders ++ ["Content-Type", "Authorization"]
-        }
+  mContext <- getAppContext
+  case mContext of
+    Left err -> putStrLn err
+    Right ctx -> runRIO ctx App.run