diff options
Diffstat (limited to 'Biz/Dragons.hs')
| -rw-r--r-- | Biz/Dragons.hs | 81 |
1 files changed, 42 insertions, 39 deletions
diff --git a/Biz/Dragons.hs b/Biz/Dragons.hs index 22596de..7e626da 100644 --- a/Biz/Dragons.hs +++ b/Biz/Dragons.hs @@ -477,7 +477,10 @@ instance Lucid.ToHtml AnalysisAction where Lucid.td_ [Lucid.style_ <| size n totalCommits] <| do Lucid.span_ [Lucid.class_ "tooltip"] <| Lucid.toHtml - <| path <> ": " <> show n <> " commits" + <| path + <> ": " + <> show n + <> " commits" where simpleBar :: (Show i, Monad m, Num i) => i -> Integer -> Lucid.HtmlT m () simpleBar n total = do @@ -485,7 +488,7 @@ instance Lucid.ToHtml AnalysisAction where Lucid.tr_ <| do Lucid.td_ [Lucid.style_ <| size n total] "" - <> Lucid.td_ [Lucid.style_ <| size total total] "" + <> Lucid.td_ [Lucid.style_ <| size total total] "" len = toInteger <. length slen = tshow <. length @@ -497,7 +500,7 @@ instance Lucid.ToHtml AnalysisAction where percentage_ = div_ "percentage" size n total = "--size: calc(" <> show n <> "/" <> show total <> ")" previewChart = div_ "preview-chart" - desc :: Monad m => Text -> Lucid.HtmlT m () + desc :: (Monad m) => Text -> Lucid.HtmlT m () desc = Lucid.p_ <. Cmark.renderNode [] <. Cmark.commonmarkToNode [] -- | Captures an 'Analysis' with metadata used in the webapp to track who asked @@ -861,64 +864,64 @@ data Paths path = Paths login :: path :- "login" - :> Verb 'GET 301 '[Lucid.HTML] (Headers '[Header "Location" Text] NoContent), + :> Verb 'GET 301 '[Lucid.HTML] (Headers '[Header "Location" Text] NoContent), githubAuth :: path :- "auth" - :> "github" - :> "callback" - :> QueryParam "code" Text - :> Get '[Lucid.HTML] (Auth.SetCookies (App.Html UserAccount)), + :> "github" + :> "callback" + :> QueryParam "code" Text + :> Get '[Lucid.HTML] (Auth.SetCookies (App.Html UserAccount)), getAccount :: path :- Auth.Auth '[Auth.Cookie] User - :> "account" - :> Get '[Lucid.HTML] (App.Html UserAccount), + :> "account" + :> Get '[Lucid.HTML] (App.Html UserAccount), postAccount :: path :- Auth.Auth '[Auth.Cookie] User - :> "account" - :> ReqBody '[FormUrlEncoded] Subscription - :> Post '[Lucid.HTML] (App.Html UserAccount), + :> "account" + :> ReqBody '[FormUrlEncoded] Subscription + :> Post '[Lucid.HTML] (App.Html UserAccount), postAPIKey :: path :- Auth.Auth '[Auth.Cookie] User - :> "account" - :> "api-key" - :> Post '[Lucid.HTML] (App.Html UserAccount), + :> "account" + :> "api-key" + :> Post '[Lucid.HTML] (App.Html UserAccount), selectRepo :: path :- Auth.Auth '[Auth.Cookie] User - :> "select-repo" - :> Get '[Lucid.HTML] (App.Html SelectRepo), + :> "select-repo" + :> Get '[Lucid.HTML] (App.Html SelectRepo), getAnalyses :: path :- Auth.Auth '[Auth.Cookie] User - :> "analysis" - :> Get '[Lucid.HTML] (App.Html Analyses), + :> "analysis" + :> Get '[Lucid.HTML] (App.Html Analyses), getAnalysis :: path :- Auth.Auth '[Auth.Cookie] User - :> "analysis" - :> Capture "analysisId" (Id.Id AnalysisAction) - :> Get '[Lucid.HTML] (App.Html AnalysisDisplay), + :> "analysis" + :> Capture "analysisId" (Id.Id AnalysisAction) + :> Get '[Lucid.HTML] (App.Html AnalysisDisplay), postAnalysis :: path :- Auth.Auth '[Auth.Cookie] User - :> "analysis" - :> ReqBody '[FormUrlEncoded] SubmitAnalysis - :> Post '[Lucid.HTML] (App.Html AnalysisDisplay), + :> "analysis" + :> ReqBody '[FormUrlEncoded] SubmitAnalysis + :> Post '[Lucid.HTML] (App.Html AnalysisDisplay), putAnalysis :: path :- Auth.Auth '[Auth.JWT] User - :> "analysis" - :> ReqBody '[JSON] Analysis - :> Put '[JSON] NoContent, + :> "analysis" + :> ReqBody '[JSON] Analysis + :> Put '[JSON] NoContent, admin :: path :- Auth.Auth '[Auth.Cookie] User - :> "admin" - :> Get '[Lucid.HTML] (App.Html AdminDashboard) + :> "admin" + :> Get '[Lucid.HTML] (App.Html AdminDashboard) } deriving (Generic) @@ -928,7 +931,7 @@ paths = genericApi (Proxy :: Proxy Paths) -- | Ensures a user is authenticated, then returns the logged-in user for -- authorization. guardAuth :: - MonadError ServerError m => + (MonadError ServerError m) => Auth.AuthResult a -> m a guardAuth = \case @@ -938,7 +941,7 @@ guardAuth = \case Auth.Authenticated user -> pure user guardAdmin :: - MonadError ServerError m => + (MonadError ServerError m) => Auth.AuthResult User -> m User guardAdmin = \case @@ -990,7 +993,7 @@ htmlApp jwtCfg cooks kp cfg oAuthArgs = warn msg = Log.warn [msg] >> Log.br - |> liftIO + |> liftIO >> throwError err502 {errBody = str msg} user <- GitHub.userInfoCurrentR @@ -1354,7 +1357,7 @@ instance Lucid.ToHtml Analyses where [ href analysisId, css <| Biz.Look.marginAll (em 1) - <> Clay.textDecoration Clay.none + <> Clay.textDecoration Clay.none ] <| do Lucid.div_ <| Lucid.toHtml source @@ -1379,7 +1382,7 @@ instance Lucid.ToHtml Subscription where toHtml Free = "Free" toHtml Invoice = "Invoice me" -linkAction_ :: ToHttpApiData a => Text -> a -> Lucid.Attribute +linkAction_ :: (ToHttpApiData a) => Text -> a -> Lucid.Attribute linkAction_ baseUrl = Lucid.action_ <. (baseUrl <>) <. Servant.toUrlPiece instance Lucid.ToHtml UserAccount where @@ -1521,7 +1524,7 @@ tryButton oAuthArgs title subtitle = Lucid.small_ <| Lucid.toHtml subtitle -- | Universal header -header :: Monad m => Maybe User -> Lucid.HtmlT m () +header :: (Monad m) => Maybe User -> Lucid.HtmlT m () header muser = Lucid.header_ <| do Lucid.nav_ <| do @@ -1540,7 +1543,7 @@ header muser = li txt href = Lucid.li_ <| a txt href -- | Universal footer -footer :: Monad m => Lucid.HtmlT m () +footer :: (Monad m) => Lucid.HtmlT m () footer = Lucid.footer_ <| do Lucid.p_ <| Lucid.i_ "Copyright ©2020-2021 Dragons.dev" @@ -1640,7 +1643,7 @@ test_spliceCreds = -- | Clones a repo from GitHub and does the analysis. analyzeGitHub :: - GitHub.AuthMethod ghAuth => + (GitHub.AuthMethod ghAuth) => Acid.AcidState Keep -> -- | The User asking for the analysis, we auth as them User -> |