Permalink
Browse files

Moved ifLoggedIn to Framework, added fallback parameter.

  • Loading branch information...
1 parent 9ffbb78 commit 1b59f770f5744343a964dbf66247d0a7e717c715 @jgm committed Jan 31, 2009
Showing with 26 additions and 23 deletions.
  1. +6 −21 Gitit.hs
  2. +20 −2 Gitit/Framework.hs
View
@@ -139,21 +139,6 @@ debugHandler = do
liftIO $ putStrLn page >> putStrLn (show params)
noHandle
-ifLoggedIn :: (String -> Params -> Web Response) -> (String -> Params -> Web Response)
-ifLoggedIn responder =
- \page params -> do user <- getLoggedInUser params
- case user of
- Nothing -> do
- loginUserForm page (params { pReferer = Just $ pUri params })
- Just u -> do
- usrs <- queryAppState users
- let e = case M.lookup u usrs of
- Just usr -> uEmail usr
- Nothing -> error $ "User '" ++ u ++ "' not found."
- -- give the user another hour...
- addCookie sessionTime (mkCookie "sid" (show $ fromJust $ pSessionKey params))
- responder page (params { pUser = u, pEmail = e })
-
wikiHandlers :: [Handler]
wikiHandlers = [ handlePath "_index" GET indexPage
, handlePath "_activity" GET showActivity
@@ -166,22 +151,22 @@ wikiHandlers = [ handlePath "_index" GET indexPage
, handlePath "_login" GET loginUserForm
, handlePath "_login" POST loginUser
, handlePath "_logout" GET logoutUser
- , handlePath "_upload" GET (ifLoggedIn uploadForm)
- , handlePath "_upload" POST (ifLoggedIn uploadFile)
+ , handlePath "_upload" GET (ifLoggedIn uploadForm loginUserForm)
+ , handlePath "_upload" POST (ifLoggedIn uploadFile loginUserForm)
, handlePath "_random" GET randomPage
, handlePath "" GET showFrontPage
, withCommand "showraw" [ handlePage GET showRawPage ]
, withCommand "history" [ handlePage GET showPageHistory,
handle (not . isPage) GET showFileHistory ]
- , withCommand "edit" [ handlePage GET $ unlessNoEdit (ifLoggedIn editPage) showPage ]
+ , withCommand "edit" [ handlePage GET $ unlessNoEdit (ifLoggedIn editPage loginUserForm) showPage ]
, withCommand "diff" [ handlePage GET showPageDiff,
handle isSourceCode GET showFileDiff ]
, withCommand "export" [ handlePage POST exportPage, handlePage GET exportPage ]
, withCommand "cancel" [ handlePage POST showPage ]
, withCommand "discuss" [ handlePage GET discussPage ]
- , withCommand "update" [ handlePage POST $ unlessNoEdit (ifLoggedIn updatePage) showPage ]
- , withCommand "delete" [ handlePage GET $ unlessNoDelete (ifLoggedIn confirmDelete) showPage,
- handlePage POST $ unlessNoDelete (ifLoggedIn deletePage) showPage ]
+ , withCommand "update" [ handlePage POST $ unlessNoEdit (ifLoggedIn updatePage loginUserForm) showPage ]
+ , withCommand "delete" [ handlePage GET $ unlessNoDelete (ifLoggedIn confirmDelete loginUserForm) showPage,
+ handlePage POST $ unlessNoDelete (ifLoggedIn deletePage loginUserForm) showPage ]
, handleSourceCode
, handleAny
, handlePage GET showPage
View
@@ -38,10 +38,11 @@ module Gitit.Framework (
, pathForPage
, withCommands
, getMimeTypeForExtension
+ , ifLoggedIn
)
where
import HAppS.Server hiding (look, lookRead, lookCookieValue, mkCookie)
-import Gitit.HAppS (look, lookRead, lookCookieValue)
+import Gitit.HAppS (look, lookRead, lookCookieValue, mkCookie)
import Gitit.State
import Text.Pandoc.Shared (substitute)
import Control.Monad.Reader (mplus)
@@ -51,7 +52,7 @@ import Control.Monad.Trans (MonadIO)
import qualified Data.ByteString.Lazy as B
import qualified Data.Map as M
import Data.ByteString.UTF8 (fromString, toString)
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, fromJust)
import Data.List (intersect, intercalate, isSuffixOf)
import System.FilePath ((<.>), takeExtension)
import Codec.Binary.UTF8.String (decodeString, encodeString)
@@ -278,3 +279,20 @@ getMimeTypeForExtension ext = do
Nothing -> "application/octet-stream"
Just t -> t
+ifLoggedIn :: (String -> Params -> Web Response)
+ -> (String -> Params -> Web Response)
+ -> (String -> Params -> Web Response)
+ifLoggedIn responder fallback =
+ \page params -> do user <- getLoggedInUser params
+ case user of
+ Nothing -> do
+ fallback page (params { pReferer = Just $ pUri params })
+ Just u -> do
+ usrs <- queryAppState users
+ let e = case M.lookup u usrs of
+ Just usr -> uEmail usr
+ Nothing -> error $ "User '" ++ u ++ "' not found."
+ -- give the user another hour...
+ addCookie sessionTime (mkCookie "sid" (show $ fromJust $ pSessionKey params))
+ responder page (params { pUser = u, pEmail = e })
+

0 comments on commit 1b59f77

Please sign in to comment.