From 906db8d4ac24f65f38e1d31bfdaa47602a54d759 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Mon, 9 Jan 2023 13:06:53 -0500
Subject: Reorganize some Auth/App stuff

---
 Biz/App.hs     | 15 +++++++++++++--
 Biz/Auth.hs    | 17 +++++++++++++++++
 Biz/Dragons.hs | 32 ++++----------------------------
 3 files changed, 34 insertions(+), 30 deletions(-)

(limited to 'Biz')

diff --git a/Biz/App.hs b/Biz/App.hs
index 9c0b7a7..317a163 100644
--- a/Biz/App.hs
+++ b/Biz/App.hs
@@ -5,7 +5,8 @@
 
 -- | General utils for apps
 module Biz.App
-  ( CSS (..),
+  ( Area (..),
+    CSS (..),
     HasCss (..),
     Manifest (..),
     Html (..),
@@ -22,6 +23,16 @@ import Network.HTTP.Media
     (/:),
   )
 import Servant.API (Accept (..), MimeRender (..))
+import qualified System.Envy as Envy
+
+data Area = Test | Live
+  deriving (Generic, Show)
+
+instance Envy.Var Area where
+  toVar = show
+  fromVar "Test" = Just Test
+  fromVar "Live" = Just Live
+  fromVar _ = Just Test
 
 newtype CSS = CSS
   { unCSS :: Text
@@ -47,7 +58,7 @@ data Manifest = Manifest
 instance ToJSON Manifest
 
 -- | A wrapper for an HTML page. You need to provide an orphan
--- 'Lucid.Base.ToHtml' instance in the Host module of your app.
+-- 'Lucid.Base.ToHtml' instance in the web module of your app.
 --
 -- Ideally this would be captured in a Biz.App type, with overrides for head
 -- elements, and we would wouldn't have to make the same basic orphan instance
diff --git a/Biz/Auth.hs b/Biz/Auth.hs
index 1c3e45c..14f67ec 100644
--- a/Biz/Auth.hs
+++ b/Biz/Auth.hs
@@ -18,6 +18,8 @@ module Biz.Auth
 
     -- * Servant Helpers
     SetCookies,
+    liveCookieSettings,
+    testCookieSettings,
   )
 where
 
@@ -38,6 +40,21 @@ notset = "notset"
 type SetCookies ret =
   (Headers '[Header "Set-Cookie" Auth.SetCookie, Header "Set-Cookie" Auth.SetCookie] ret)
 
+liveCookieSettings :: Auth.CookieSettings
+liveCookieSettings =
+  Auth.defaultCookieSettings
+    { Auth.cookieIsSecure = Auth.Secure,
+      -- disable XSRF protection because we don't use any javascript
+      Auth.cookieXsrfSetting = Nothing
+    }
+
+testCookieSettings :: Auth.CookieSettings
+testCookieSettings =
+  Auth.defaultCookieSettings
+    { Auth.cookieIsSecure = Auth.NotSecure,
+      Auth.cookieXsrfSetting = Nothing
+    }
+
 -- | These are arguments that a 3rd-party OAuth provider needs in order for us
 -- to authenticate a user.
 data OAuthArgs = OAuthArgs
diff --git a/Biz/Dragons.hs b/Biz/Dragons.hs
index 7307f69..d71ca3c 100644
--- a/Biz/Dragons.hs
+++ b/Biz/Dragons.hs
@@ -749,8 +749,8 @@ startup quiet = do
     Log.info ["boot", "home", "example", url] >> Log.br
   let jwtCfg = Auth.defaultJWTSettings jwk
   let cooks = case area cfg of
-        Test -> testCookieSettings
-        Live -> liveCookieSettings
+        App.Test -> Auth.testCookieSettings
+        App.Live -> Auth.liveCookieSettings
   let ctx = cooks :. jwtCfg :. EmptyContext
   let app = serveWithContext paths ctx (toServant <| htmlApp jwtCfg cooks kp cfg oAuthArgs)
   unless quiet <| do Log.info ["boot", "ready"] >> Log.br
@@ -765,21 +765,6 @@ tidy Config {..} = Directory.removeDirectoryRecursive keep
 run :: (Config, Wai.Application, Acid.AcidState Keep) -> IO ()
 run (cfg, app, _) = Warp.run (port cfg) (Log.wai app)
 
-liveCookieSettings :: Auth.CookieSettings
-liveCookieSettings =
-  Auth.defaultCookieSettings
-    { Auth.cookieIsSecure = Auth.Secure,
-      -- disable XSRF protection because we don't use any javascript
-      Auth.cookieXsrfSetting = Nothing
-    }
-
-testCookieSettings :: Auth.CookieSettings
-testCookieSettings =
-  Auth.defaultCookieSettings
-    { Auth.cookieIsSecure = Auth.NotSecure,
-      Auth.cookieXsrfSetting = Nothing
-    }
-
 test :: Test.Tree
 test =
   Test.group
@@ -797,21 +782,12 @@ test =
 
 -- * app configurations
 
-data Area = Test | Live
-  deriving (Generic, Show)
-
-instance Envy.Var Area where
-  toVar = show
-  fromVar "Test" = Just Test
-  fromVar "Live" = Just Live
-  fromVar _ = Just Test
-
 data Config = Config
   { port :: Warp.Port,
     -- | The repo depo! Depository of repositories!
     depo :: FilePath,
     keep :: FilePath,
-    area :: Area,
+    area :: App.Area,
     -- | A user token for the GitHub API to be used in testing and when getting
     -- the homepage/example analyses. Get a token with 'repo' scope from GitHub
     -- and set in .envrc.local
@@ -828,7 +804,7 @@ instance Envy.DefConfig Config where
       { port = 8005,
         depo = "_/var/dragons/depo",
         keep = "_/var/dragons/keep",
-        area = Test,
+        area = App.Test,
         tokn = mempty,
         homeExample = ForgeURL "https://github.com/github/training-kit"
       }
-- 
cgit v1.2.3