summaryrefslogtreecommitdiff
path: root/Biz
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2023-01-09 13:06:53 -0500
committerBen Sima <ben@bsima.me>2023-01-09 13:06:53 -0500
commit906db8d4ac24f65f38e1d31bfdaa47602a54d759 (patch)
tree6f17a84703fb12599d393dc58a90ba9e62f5ca97 /Biz
parent3e89ecfeb236065d845a632324324d57c49b829e (diff)
Reorganize some Auth/App stuff
Diffstat (limited to 'Biz')
-rw-r--r--Biz/App.hs15
-rw-r--r--Biz/Auth.hs17
-rw-r--r--Biz/Dragons.hs32
3 files changed, 34 insertions, 30 deletions
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"
}