introducint 2 modes for tags

Handler/Tags.hs

@@ -11,24 +11,37 @@ import Handler.TagUtils
 getTagsR :: Handler Html
 getTagsR = do
   (formWidget, formEnctype) <- generateFormPost tagForm
-  mUser <- maybeAuth
+  doTags formWidget formEnctype
-  doTags mUser formWidget formEnctype
 
 postTagsR :: Handler Html
 postTagsR = do
   ((result, formWidget), formEnctype) <- runFormPost tagForm
-  mUser <- maybeAuth
+  canTagsBeAdded <- canAddTags
-  when (checkIfAdmin mUser) $ do
+  when canTagsBeAdded $ do
      case result of
       FormSuccess (t, d) -> do
                             _ <- runDB $ insert $ Tag t d
                             return ()
       _ -> do
            return ()
-  doTags mUser formWidget formEnctype
+  doTags formWidget formEnctype
 
-doTags mUser formWidget formEnctype = do
+
+canAddTags :: Handler Bool
+canAddTags = do
+  mUser <- maybeAuth
+
+  app <- getYesod
+  let tagPermissions = appTagPermissions $ appSettings app
+
+  case tagPermissions of
+    OnlyAdminCanAddNewTags -> return $ checkIfAdmin mUser
+    EverybodyCanAddNewTags -> return $ isJust mUser
+
+
+doTags formWidget formEnctype = do
   tags <- runDB $ selectList [] [Asc TagName]
+  canTagsBeAdded <- canAddTags
   defaultLayout $ do
     setTitle "Tags"
     $(widgetFile "tags")

Settings.hs

@@ -25,6 +25,13 @@ toRepoScheme :: Text -> RepoScheme
 toRepoScheme "branches" = Branches
 toRepoScheme _ = SelfHosted
 
+data TagPermissions = OnlyAdminCanAddNewTags | EverybodyCanAddNewTags
+                      deriving (Eq, Show)
+
+toTagPermissions :: Text -> TagPermissions
+toTagPermissions "everybody-can-add-new-tags" = EverybodyCanAddNewTags
+toTagPermissions _ = OnlyAdminCanAddNewTags
+
 -- | Runtime settings to configure this application. These settings can be
 -- loaded from various sources: defaults, environment variables, config files,
 -- theoretically even a database.
@@ -71,6 +78,7 @@ data AppSettings = AppSettings
     -- ^ Repo host
     , appRepoHost               :: Text
     , appRepoScheme             :: RepoScheme
+    , appTagPermissions         :: TagPermissions
     }
 
 instance FromJSON AppSettings where
@@ -108,6 +116,9 @@ instance FromJSON AppSettings where
         scheme <- o .: "repo-scheme"
         appRepoScheme <- return $ toRepoScheme scheme
 
+        tagPermissions <- o .: "tag-permissions"
+        appTagPermissions <- return $ toTagPermissions tagPermissions
+
         return AppSettings {..}
 
 -- | Settings for 'widgetFile', such as which template languages to support and

config/settings.yml

@@ -10,6 +10,7 @@ var-dir:        "_env:VAR_DIR:."
 contact-email:   "_env:CONTACT_EMAIL:filipg@amu.edu.pl"
 repo-host:       "_env:REPO_HOST:ssh://gitolite@gonito.net/"
 repo-scheme:     "_env:REPO_SCHEME:selfhosted"
+tag-permissions: "_env:TAG_PERMISSIONS:only-admin-can-add-new-tags"
 
 # Optional values with the following production defaults.
 # In development, they default to the inverse.

templates/tags.hamlet

@@ -4,7 +4,7 @@
 
 <hr>
 
-$if (checkIfAdmin mUser)
+$if canTagsBeAdded
   <h2>Create a new tag
 
   <form method=post action=@{TagsR}#form enctype=#{formEnctype}>