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!

website/sandbox/learnpianochords/src/server/App.hs

@@ -0,0 +1,46 @@
+--------------------------------------------------------------------------------
+module App where
+--------------------------------------------------------------------------------
+import RIO hiding (Handler)
+import Servant
+import API
+import Data.String.Conversions (cs)
+import Control.Monad.IO.Class (liftIO)
+import GoogleSignIn (EncodedJWT(..), ValidationResult(..))
+import Utils
+
+import qualified Network.Wai.Handler.Warp as Warp
+import qualified Network.Wai.Middleware.Cors as Cors
+import qualified GoogleSignIn
+import qualified Types as T
+--------------------------------------------------------------------------------
+
+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
+        -- 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 }
+
+run :: RIO T.Context ()
+run = do
+  T.Context{..} <- ask
+  liftIO $ Warp.run contextServerPort (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"]
+        }

website/sandbox/learnpianochords/src/server/Fixtures.hs

@@ -1,6 +1,7 @@
 --------------------------------------------------------------------------------
 module Fixtures where
 --------------------------------------------------------------------------------
+import RIO
 import Web.JWT
 import Utils
 

website/sandbox/learnpianochords/src/server/GoogleSignIn.hs

@@ -1,8 +1,8 @@
 --------------------------------------------------------------------------------
 module GoogleSignIn where
 --------------------------------------------------------------------------------
+import RIO
 import Data.String.Conversions (cs)
-import Data.Text
 import Web.JWT
 import Utils
 
@@ -23,7 +23,7 @@ instance Eq DecodedJWT where
 
 data ValidationResult
   = Valid DecodedJWT
-  | DecodeError
+  | CannotDecodeJWT
   | GoogleSaysInvalid Text
   | NoMatchingClientIDs [StringOrURI]
   | WrongIssuer StringOrURI
@@ -46,7 +46,7 @@ validateJWT :: Bool
            -> IO ValidationResult
 validateJWT skipHTTP (EncodedJWT encodedJWT) = do
   case encodedJWT |> decode of
-    Nothing -> pure DecodeError
+    Nothing -> pure CannotDecodeJWT
     Just jwt -> do
       if skipHTTP then
         continue jwt
@@ -101,7 +101,7 @@ validateJWT skipHTTP (EncodedJWT encodedJWT) = do
 -- | Attempt to explain the `ValidationResult` to a human.
 explainResult :: ValidationResult -> String
 explainResult (Valid _) = "Everything appears to be valid"
-explainResult DecodeError = "We had difficulty decoding the provided JWT"
+explainResult CannotDecodeJWT = "We had difficulty decoding the provided JWT"
 explainResult (GoogleSaysInvalid x) = "After checking with Google, they claimed that the provided JWT was invalid: " ++ cs x
 explainResult (NoMatchingClientIDs audFields) = "None of the values in the `aud` field on the provided JWT match our client ID: " ++ show audFields
 explainResult (WrongIssuer issuer) = "The `iss` field in the provided JWT does not match what we expect: " ++ show issuer

website/sandbox/learnpianochords/src/server/Main.hs

@@ -1,41 +1,30 @@
 --------------------------------------------------------------------------------
 module Main where
 --------------------------------------------------------------------------------
-import Servant
+import RIO
-import API
+import Prelude (putStrLn)
-import Control.Monad.IO.Class (liftIO)
-import GoogleSignIn (EncodedJWT(..), ValidationResult(..))
-import Data.String.Conversions (cs)
-import Utils
 
-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
+-- | Attempt to read environment variables from the system and initialize the
-server = verifyGoogleSignIn
+-- Context data type for our application.
-  where
+getAppContext :: IO (Either String T.Context)
-    verifyGoogleSignIn :: T.VerifyGoogleSignInRequest -> Handler NoContent
+getAppContext = do
-    verifyGoogleSignIn T.VerifyGoogleSignInRequest{..} = do
+  mEnv <- Envy.decodeEnv
-    validationResult <- liftIO $ GoogleSignIn.validateJWT False (EncodedJWT idToken)
+  case mEnv of
-    case validationResult of
+    Left err -> pure $ Left err
-      Valid _ -> do
+    Right T.Env{..} -> pure $ Right T.Context
-        liftIO $ putStrLn "Sign-in valid! Let's create a session"
+      { contextGoogleClientID = envGoogleClientID
-        pure NoContent
+      , contextClientPort = 8000
-      err -> do
+      , contextServerPort = 3000
-        throwError err401 { errBody = err |> GoogleSignIn.explainResult |> cs }
+      }
 
 main :: IO ()
 main = do
-  Warp.run 3000 (enforceCors $ serve (Proxy @ API) $ server)
+  mContext <- getAppContext
-  where
+  case mContext of
-    enforceCors = Cors.cors (const $ Just corsPolicy)
+    Left err -> putStrLn err
-    corsPolicy :: Cors.CorsResourcePolicy
+    Right ctx -> runRIO ctx App.run
-    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"]
-        }

website/sandbox/learnpianochords/src/server/Spec.hs

@@ -1,6 +1,7 @@
 --------------------------------------------------------------------------------
 module Spec where
 --------------------------------------------------------------------------------
+import RIO
 import Test.Hspec
 import Utils
 import Web.JWT (numericDate, decode)
@@ -18,7 +19,7 @@ main = hspec $ do
     describe "validateJWT" $ do
       let validateJWT' = GoogleSignIn.validateJWT True
       it "returns a decode error when an incorrectly encoded JWT is used" $ do
-        validateJWT' (GoogleSignIn.EncodedJWT "rubbish") `shouldReturn` DecodeError
+        validateJWT' (GoogleSignIn.EncodedJWT "rubbish") `shouldReturn` CannotDecodeJWT
 
       it "returns validation error when the aud field doesn't match my client ID" $ do
         let auds = ["wrong-client-id"]

website/sandbox/learnpianochords/src/server/TestUtils.hs

@@ -1,6 +1,7 @@
 --------------------------------------------------------------------------------
 module TestUtils where
 --------------------------------------------------------------------------------
+import RIO
 import Web.JWT
 import Data.String.Conversions (cs)
 --------------------------------------------------------------------------------
@@ -9,7 +10,7 @@ unsafeStringOrURI :: String -> StringOrURI
 unsafeStringOrURI x =
   case stringOrURI (cs x) of
     Nothing -> error $ "Failed to convert to StringOrURI: " ++ x
-    Just x  -> x
+    Just res -> res
 
 unsafeJust :: Maybe a -> a
 unsafeJust Nothing = error "Attempted to force a Nothing to be a something"

website/sandbox/learnpianochords/src/server/Types.hs

@@ -1,12 +1,30 @@
 --------------------------------------------------------------------------------
 module Types where
 --------------------------------------------------------------------------------
+import RIO
 import Data.Aeson
-import Data.Text
+import System.Envy (FromEnv, fromEnv, env)
 --------------------------------------------------------------------------------
 
+-- | Read from .envrc
+data Env = Env
+  { envGoogleClientID :: !String
+  } deriving (Eq, Show)
+
+instance FromEnv Env where
+  fromEnv _ = do
+    envGoogleClientID <- env "GOOGLE_CLIENT_ID"
+    pure Env {..}
+
+-- | Application context: a combination of Env and additional values.
+data Context = Context
+  { contextGoogleClientID :: !String
+  , contextServerPort :: !Int
+  , contextClientPort :: !Int
+  }
+
 data VerifyGoogleSignInRequest = VerifyGoogleSignInRequest
-  { idToken :: Text
+  { idToken :: !Text
   } deriving (Eq, Show)
 
 instance FromJSON VerifyGoogleSignInRequest where