summaryrefslogtreecommitdiff
path: root/Biz
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2021-03-17 22:04:06 -0400
committerBen Sima <ben@bsima.me>2021-03-17 22:05:09 -0400
commitde189c5897ca6c122ea9cae34f60f4065fc4437d (patch)
tree837920eff73317f7b25793ad8affd1a9e92af5f3 /Biz
parentf061974833a4b6cf7582047bf31f239d0e621458 (diff)
Change auth error message and reorg Analysis css
Diffstat (limited to 'Biz')
-rw-r--r--Biz/Devalloc.hs28
1 files changed, 16 insertions, 12 deletions
diff --git a/Biz/Devalloc.hs b/Biz/Devalloc.hs
index ce70f07..9d0b2ce 100644
--- a/Biz/Devalloc.hs
+++ b/Biz/Devalloc.hs
@@ -726,7 +726,7 @@ guardAuth ::
guardAuth = \case
Auth.NoSuchUser -> throwError err401 {errBody = "No such user"}
Auth.BadPassword -> throwError err401 {errBody = "Bad password"}
- Auth.Indefinite -> throwError err401 {errBody = "Incorrect authentication method"}
+ Auth.Indefinite -> throwError err401 {errBody = "No authentication found"}
Auth.Authenticated user -> pure user
requiredScopes :: Set Text
@@ -950,7 +950,7 @@ black = "#121212"
data Home = Home OAuthArgs (Maybe Analysis)
instance App.HasCss Home where
- cssFor (Home _ _) = do
+ cssFor (Home _ mAnalysis) = do
"p" ? Clay.textAlign Clay.center
"h1" ? do
Clay.fontSize (Clay.rem 3)
@@ -963,6 +963,7 @@ instance App.HasCss Home where
Biz.Look.borderRadiusAll (px 10)
Biz.Look.paddingX (em 2)
Biz.Look.paddingY (em 1)
+ maybe mempty App.cssFor mAnalysis
"section" ? do
Clay.padding (rem 3) 0 (rem 3) 0
"a#try-button" <> "a#try-button:visited" ? do
@@ -1265,7 +1266,19 @@ footer =
data AnalysisDisplay = AnalysisDisplay User Analysis
instance App.HasCss AnalysisDisplay where
- cssFor (AnalysisDisplay _ _) = do
+ cssFor (AnalysisDisplay _ analysis) = App.cssFor analysis
+
+instance Lucid.ToHtml AnalysisDisplay where
+ toHtmlRaw = Lucid.toHtml
+ toHtml (AnalysisDisplay user anal) = do
+ header <| Just user
+ Lucid.main_ <| do
+ Lucid.h1_ "Analysis Results"
+ Lucid.toHtml anal
+ footer
+
+instance App.HasCss Analysis where
+ cssFor _ = do
Clay.display Clay.grid
Clay.justifyContent Clay.spaceAround
Biz.Look.rowGap (rem 2)
@@ -1299,15 +1312,6 @@ instance App.HasCss AnalysisDisplay where
"details[open]" ? do
Biz.Look.gridArea "details"
-instance Lucid.ToHtml AnalysisDisplay where
- toHtmlRaw = Lucid.toHtml
- toHtml (AnalysisDisplay user anal) = do
- header <| Just user
- Lucid.main_ <| do
- Lucid.h1_ "Analysis Results"
- Lucid.toHtml anal
- footer
-
instance Lucid.ToHtml Analysis where
toHtmlRaw = Lucid.toHtml
toHtml Analysis {..} =