Changes to Gitit

This is my version of the Network.Gitit file with some changes to try and prevent non logged in users from accessing the /private directory

module Network.Gitit (
                     -- * Wiki handlers
                       wiki
                     , reloadTemplates
                     , runHandler
                     -- * Initialization
                     , module Network.Gitit.Initialize
                     -- * Configuration
                     , module Network.Gitit.Config
                     , loginUserForm
                     -- * Types
                     , module Network.Gitit.Types
                     -- * Tools for building handlers
                     , module Network.Gitit.Framework
                     , module Network.Gitit.ContentTransformer
                     , getFileStore
                     , getUser
                     , getConfig
                     )
where
import Network.Gitit.Types
import Network.Gitit.Server
import Network.Gitit.Framework
import Network.Gitit.Handlers
import Network.Gitit.Initialize
import Network.Gitit.Config
import Network.Gitit.State (getFileStore, getUser, getConfig)
import Network.Gitit.ContentTransformer
import Network.Gitit.Authentication (loginUserForm)
import Paths_gitit (getDataFileName)
import Control.Monad.Reader
import Prelude hiding (readFile)
import qualified Data.ByteString.Char8 as B
import System.FilePath ((</>))

-- | Happstack handler for a gitit wiki.
wiki :: Config -> ServerPart Response
wiki conf = do
  let static = staticDir conf
  defaultStatic <- liftIO $ getDataFileName $ "data" </> "static"
  -- if file not found in staticDir, we check also in the data/static
  -- directory, which contains defaults
  let staticHandler = withExpiresHeaders $
        fileServeStrict' [] static `mplus` fileServeStrict' [] defaultStatic
  let handlers = [debugHandler | debugMode conf] ++ (authHandler conf : wikiHandlers)
  let fs = filestoreFromConfig conf
  let ws = WikiState { wikiConfig = conf, wikiFileStore = fs }
  if compressResponses conf
     then compressedResponseFilter
     else return ""
  staticHandler `mplus` runHandler ws (withUser conf $ msum handlers)

-- | Like 'fileServeStrict', but if file is not found, fail instead of
-- returning a 404 error.
fileServeStrict' :: [FilePath] -> FilePath -> ServerPart Response
fileServeStrict' ps p = do
  rq <- askRq
  resp <- fileServeStrict ps p
  if rsCode resp == 404 || last (rqUri rq) == '/'
     then mzero  -- pass through if not found or directory index
     else do
       -- turn off compresion filter unless it's text
       case getHeader "Content-Type" resp of
            Just ct | B.pack "text/" `B.isPrefixOf` ct -> return resp
            _ -> ignoreFilters >> return resp

wikiHandlers :: [Handler]
wikiHandlers =
  [ -- redirect /wiki -> /wiki/ when gitit is being served at /wiki
    -- so that relative wikilinks on the page will work properly:
    guardBareBase >> getWikiBase >>= \b -> movedPermanently (b ++ "/") (toResponse ())
  , dir "_user"     currentUser
  , dir "_activity" showActivity
  , dir "_go"       goToPage
  , dir "_search"   searchResults
  , dir "_upload"   $ methodOnly GET  >> requireUser uploadForm 
  , dir "_upload"   $ methodOnly POST >> requireUser uploadFile
  , dir "_random"   $ methodOnly GET  >> randomPage
  , dir "_index"    indexPage
  , dir "_feed"     feedHandler
  , dir "_category" categoryPage
  , dir "_categories" categoryListPage
  , dir "_expire"     expireCache
  , dir "_showraw"  $ msum
      [ showRawPage
      , guardPath isSourceCode >> showFileAsText ]
  , dir "_history"  $ msum
      [ showPageHistory
      , guardPath isSourceCode >> showFileHistory ]
  , dir "_edit" $ requireUser (unlessNoEdit editPage showPage)

I have added a "requireUser" to the line below so that only people who are logged in can see the changes made to a page

  , dir "_diff" $ requireUser (msum
      [ showPageDiff
      , guardPath isSourceCode >> showFileDiff ])
  , dir "_discuss" discussPage
  , dir "_delete" $ msum
      [ methodOnly GET  >>
          requireUser (unlessNoDelete confirmDelete showPage)
      , methodOnly POST >>
          requireUser (unlessNoDelete deletePage showPage) ]
  , dir "_preview" preview
  , guardIndex >> indexPage
  , guardCommand "export" >> exportPage
  , methodOnly POST >> guardCommand "cancel" >> showPage
  , methodOnly POST >> guardCommand "update" >>
      requireUser (unlessNoEdit updatePage showPage)

The line below means that people have to be logged in to view a page in the "private" directory. It is still possible to find the URIs of pages in the directory, but it is not possible to view the page contents

  , dir "private" $ requireUser showPage
  , showPage
  , guardPath isSourceCode >> methodOnly GET >> showHighlightedSource
  , handleAny
  , notFound =<< (guardPath isPage >> createPage)
  ]

-- | Recompiles the gitit templates.
reloadTemplates :: ServerPart Response
reloadTemplates = do
  liftIO recompilePageTemplate
  ok $ toResponse "Page templates have been recompiled."

-- | Converts a gitit Handler into a standard happstack ServerPart.
runHandler :: WikiState -> Handler -> ServerPart Response
runHandler = mapServerPartT . unpackReaderT

unpackReaderT:: (Monad m)
    => c 
    -> (ReaderT c m) (Maybe ((Either b a), FilterFun b))
    -> m (Maybe ((Either b a), FilterFun b))
unpackReaderT st handler = runReaderT handler st