Implement basic settings to only allow some users to edit the wiki.

Network/Gitit2/Foundation.hs

@@ -34,6 +34,11 @@ class (Yesod master, RenderMessage master FormMessage,
   maybeUser   :: GH master (Maybe GititUser)
   -- | Return user information or redirect to login page.
   requireUser :: GH master GititUser
+  -- | Determine whether a particular user is an editor.
+  isEditor :: GititUser -> GH master Bool
+  -- | Return user information or redirect to login page if no user.
+  -- If user isn't an editor, show an unauthorized error.
+  requireEditor :: HasGitit master => GH master GititUser
   -- | Gitit subsite page layout.
   makePage :: PageLayout -> WidgetT master IO () -> GH master Html
   -- | Plugins.
@@ -64,6 +69,7 @@ data GititConfig = GititConfig{
      , front_page       :: Text                     -- ^ Front page of wiki
      , help_page        :: Text                     -- ^ Help page
      , latex_engine     :: Maybe FilePath           -- ^ LaTeX engine to use for PDF export
+     , editors          :: Maybe [Text]             -- ^ Users allowed to actually edit
      }
 
 -- | A user.

Network/Gitit2/Handler/Delete.hs

@@ -12,7 +12,7 @@ import Network.Gitit2.Page (pathForFile)
 
 getDeleteR :: HasGitit master => Page -> GH master Html
 getDeleteR page = do
-  requireUser
+  requireEditor
   fs <- filestore <$> getYesod
   path <- pathForPage page
   pageTest <- liftIO $ try $ latest fs path
@@ -41,7 +41,7 @@ getDeleteR page = do
 
 postDeleteR :: HasGitit master => Page -> GH master Html
 postDeleteR page = do
-  user <- requireUser
+  user <- requireEditor
   fs <- filestore <$> getYesod
   mr <- getMessageRender
   fileToDelete <- lift $ runInputPost $ ireq textField "fileToDelete"

Network/Gitit2/Handler/Edit.hs

@@ -16,7 +16,7 @@ import Yesod (Route)
 
 getEditR :: HasGitit master => Page -> GH master Html
 getEditR page = do
-  requireUser
+  requireEditor
   fs <- filestore <$> getYesod
   path <- pathForPage page
   mbcont <- getRawContents path Nothing
@@ -32,7 +32,7 @@ getEditR page = do
 getRevertR :: HasGitit master
            => RevisionId -> Page -> GH master Html
 getRevertR rev page = do
-  requireUser
+  requireEditor
   path <- pathForPage page
   mbcont <- getRawContents path (Just rev)
   case mbcont of
@@ -46,7 +46,7 @@ edit :: HasGitit master
      -> Page
      -> GH master Html
 edit revert txt mbrevid page = do
-  requireUser
+  requireEditor
   let contents = Textarea $ T.pack txt
   mr <- getMessageRender
   let comment = if revert
@@ -95,7 +95,7 @@ postCreateR = update' Nothing
 update' :: HasGitit master
        => Maybe RevisionId -> Page -> GH master Html
 update' mbrevid page = do
-  user <- requireUser
+  user <- requireEditor
   ((result, widget), enctype) <- lift $ runFormPost $ editForm Nothing
   fs <- filestore <$> getYesod
   toMaster <- getRouteToParent

Network/Gitit2/Handler/Upload.hs

@@ -19,7 +19,7 @@ import Control.Exception (throw)
 
 getUploadR :: HasGitit master => GH master Html
 getUploadR = do
-  requireUser
+  requireEditor
   (form, enctype) <- lift $ generateFormPost $ uploadForm Nothing
   showUploadForm enctype form
 
@@ -80,7 +80,7 @@ uploadForm mbupload =
 
 postUploadR :: HasGitit master => GH master Html
 postUploadR = do
-  user <- requireUser
+  user <- requireEditor
   ((result, widget), enctype) <- lift $ runFormPost $ uploadForm Nothing
   fs <- filestore <$> getYesod
   case result of

settings.yaml

@@ -14,3 +14,7 @@ front_page: Front Page
 help_page: Help
 max_upload_size: 1M
 latex_engine: xelatex
+# editors is the list of user emails which are allowed to edit pages
+# leave unset to allow anyone to edit
+# editors: my.email@provider.com my.other.email@example.com
+editors: persona@orezpraw.com

src/Config.hs

@@ -48,6 +48,7 @@ data Conf = Conf { cfg_port             :: Int
                  , cfg_help_page        :: Text
                  , cfg_max_upload_size  :: String
                  , cfg_latex_engine     :: Maybe FilePath
+                 , cfg_editors          :: Maybe Text
                  }
 
 data FoundationSettings  = FoundationSettings {
@@ -88,6 +89,7 @@ parseConfig os = Conf
   <*> os `parseElem` "help_page" .!= "Help"
   <*> os `parseElem` "max_upload_size" .!= "1M"
   <*> os `parseElem` "latex_engine"
+  <*> os `parseElem` "editors"
 
 -- | Ready collection of common mime types. (Copied from
 -- Happstack.Server.HTTP.FileServe.)
@@ -139,6 +141,10 @@ gititConfigFromConf conf = do
                   Just f  -> return f
                   Nothing -> err 11 $ "Unknown default format: " ++
                                    T.unpack (cfg_default_format conf)
+
+  editorEmails <- case cfg_editors conf of
+                 Just emails -> return (Just (T.splitOn (T.pack " ") emails))
+                 Nothing -> return Nothing
 
   let gconfig = GititConfig{ mime_types = mimes
                            , default_format = format
@@ -154,5 +160,6 @@ gititConfigFromConf conf = do
                            , front_page = cfg_front_page conf
                            , help_page = cfg_help_page conf
                            , latex_engine = cfg_latex_engine conf
+                           , editors = editorEmails
                            }
   return gconfig

src/gitit2.hs

@@ -106,6 +106,17 @@ instance HasGitit Master where
                         (T.unpack $ T.takeWhile (/='@') id')
                         (T.unpack id')
   requireUser = maybe (fail "login required") return =<< maybeUser
+  isEditor user = do
+    conf <- config <$> getYesod
+    return $ case editors conf of
+         Just emails ->  T.pack (gititUserEmail user) `elem` emails
+         Nothing -> True
+  requireEditor = do
+    user <- requireUser
+    editorUser <- isEditor user
+    if editorUser
+       then return user
+       else fail "unauthorized"
   makePage = makeDefaultPage
   getPlugins = return [] -- [samplePlugin]
   staticR = StaticR