Merge pull request jgm#528 from Rufflewind/github-login-failure-page

Add page for login failure when authorization is required for reading

src/Network/Gitit/Authentication.hs

@@ -464,17 +464,33 @@ oauthGithubCallback ghConfig githubCallbackPars =
  seeOther (encUrl destination) $ toResponse ()
  Left err -> do
  liftIO $ logM "gitit" WARNING $ "Login Failed: " ++ ghUserMessage err ++ maybe "" (". Github response" ++) (ghDetails err)
- let url = destination ++ "?message=" ++ ghUserMessage err
+ cfg <- getConfig
+ let destination'
+ | requireAuthentication cfg >= ForRead = base' ++ "/_loginFailure"
+ | otherwise = destination
+ let url = destination' ++ "?message=" ++ ghUserMessage err
  seeOther (encUrl url) $ toResponse ()
 
 githubAuthHandlers :: GithubConfig
  -> [Handler]
 githubAuthHandlers ghConfig =
  [ dir "_logout" $ withData logoutUser
  , dir "_login" $ loginGithubUser $ oAuth2 ghConfig
+ , dir "_loginFailure" $ githubLoginFailure
  , dir "_githubCallback" $ withData $ oauthGithubCallback ghConfig
  , dir "_user" currentUser ]
 
+githubLoginFailure :: Handler
+githubLoginFailure = withData $ \params ->
+ formattedPage (pageLayout (pMessages params)) noHtml >>= forbidden
+ where
+ pageLayout msgs =
+ defaultPageLayout{ pgShowPageTools = False,
+ pgTabs = [],
+ pgTitle = "Login failure",
+ pgMessages = msgs
+ }
+
 -- Login using RPX (see RPX development docs at https://rpxnow.com/docs)
 loginRPXUser :: RPars -- ^ The parameters passed by the RPX callback call (after authentication has taken place
  -> Handler