From 45f352f9cb3bdc16048a0f0d70eef6a59272472b Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Mon, 23 Aug 2021 13:06:15 -0400
Subject: Fix GitHub OAuth args

This makes it explicit that we are using GitHub vs some other OAuth args. The
idea is that we should be making a new type for every service, this allows us to
have type safety in the implementation but a common set or pattern of names for
the environment variables and record fields.

Also using 'notset' instead of 'mempty' is really helpful for debugging when
this breaks, as I found out.
---
 Biz/Auth.hs | 45 ++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 40 insertions(+), 5 deletions(-)

(limited to 'Biz/Auth.hs')

diff --git a/Biz/Auth.hs b/Biz/Auth.hs
index ed904b9..1c3e45c 100644
--- a/Biz/Auth.hs
+++ b/Biz/Auth.hs
@@ -13,6 +13,7 @@ module Biz.Auth
     OAuthArgs (..),
 
     -- * GitHub Authentication
+    GitHub (..),
     githubOauth,
 
     -- * Servant Helpers
@@ -28,6 +29,10 @@ import Servant (Header, Headers)
 import qualified Servant.Auth.Server as Auth
 import qualified System.Envy as Envy
 
+-- | Use this instead of 'mempty' for explicity.
+notset :: Text
+notset = "notset"
+
 -- | Wrapper around 'Auth.SetCookie' that you can put in a servant path
 -- descriptor.
 type SetCookies ret =
@@ -45,9 +50,9 @@ data OAuthArgs = OAuthArgs
 instance Envy.DefConfig OAuthArgs where
   defConfig =
     OAuthArgs
-      { clientSecret = mempty,
-        clientId = mempty,
-        clientState = mempty
+      { clientSecret = notset,
+        clientId = notset,
+        clientState = notset
       }
 
 instance Envy.FromEnv OAuthArgs
@@ -61,13 +66,43 @@ data OAuthResponse = OAuthResponse
   }
   deriving (Generic, Aeson.FromJSON)
 
+newtype GitHub = GitHub OAuthArgs
+  deriving (Show, Generic)
+
+instance Envy.DefConfig GitHub where
+  defConfig =
+    GitHub
+      <| OAuthArgs
+        { clientSecret = notset,
+          clientId = notset,
+          clientState = notset
+        }
+
+instance Envy.FromEnv GitHub where
+  fromEnv Nothing =
+    GitHub
+      </ Envy.gFromEnvCustom
+        Envy.Option
+          { Envy.dropPrefixCount = 0,
+            Envy.customPrefix = "GITHUB"
+          }
+        Nothing
+  fromEnv (Just (GitHub x)) =
+    GitHub
+      </ Envy.gFromEnvCustom
+        Envy.Option
+          { Envy.dropPrefixCount = 0,
+            Envy.customPrefix = "GITHUB"
+          }
+        (Just x)
+
 -- | POST to GitHub's OAuth service and get the user's oAuth token.
 githubOauth ::
-  OAuthArgs ->
+  GitHub ->
   -- | This should be GitHub.Token but GitHub.Auth doesn't export Token.
   Text ->
   IO OAuthResponse
-githubOauth OAuthArgs {..} code =
+githubOauth (GitHub OAuthArgs {..}) code =
   accessTokenRequest
     /> Req.responseBody
     |> Req.runReq Req.defaultHttpConfig
-- 
cgit v1.2.3