diff --git a/Network/Gitit2/Foundation.hs b/Network/Gitit2/Foundation.hs index 9f20583..9e6c4d5 100644 --- a/Network/Gitit2/Foundation.hs +++ b/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. diff --git a/Network/Gitit2/Handler/Delete.hs b/Network/Gitit2/Handler/Delete.hs index c1a9567..06368d7 100644 --- a/Network/Gitit2/Handler/Delete.hs +++ b/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" diff --git a/Network/Gitit2/Handler/Edit.hs b/Network/Gitit2/Handler/Edit.hs index d4ebfae..9c6b626 100644 --- a/Network/Gitit2/Handler/Edit.hs +++ b/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 diff --git a/Network/Gitit2/Handler/Upload.hs b/Network/Gitit2/Handler/Upload.hs index 189c452..966e813 100644 --- a/Network/Gitit2/Handler/Upload.hs +++ b/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 diff --git a/settings.yaml b/settings.yaml index c7b8df1..ebe129b 100644 --- a/settings.yaml +++ b/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 \ No newline at end of file diff --git a/src/Config.hs b/src/Config.hs index ee88ca6..0826eed 100644 --- a/src/Config.hs +++ b/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 diff --git a/src/gitit2.hs b/src/gitit2.hs index a86e02d..6e294a6 100644 --- a/src/gitit2.hs +++ b/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