From 4ec90bdb1031070c0d109ce02fbd1d99d2713a01 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Filip=20Grali=C5=84ski?= <filipg@amu.edu.pl>
Date: Wed, 27 Jun 2018 13:32:45 +0200
Subject: [PATCH] introducint 2 modes for tags

---
 Handler/Tags.hs       | 25 +++++++++++++++++++------
 Settings.hs           | 13 ++++++++++++-
 config/settings.yml   | 19 ++++++++++---------
 templates/tags.hamlet |  2 +-
 4 files changed, 42 insertions(+), 17 deletions(-)

diff --git a/Handler/Tags.hs b/Handler/Tags.hs
index bb217f3..139f3d9 100644
--- a/Handler/Tags.hs
+++ b/Handler/Tags.hs
@@ -11,24 +11,37 @@ import Handler.TagUtils
 getTagsR :: Handler Html
 getTagsR = do
   (formWidget, formEnctype) <- generateFormPost tagForm
-  mUser <- maybeAuth
-  doTags mUser formWidget formEnctype
+  doTags formWidget formEnctype
 
 postTagsR :: Handler Html
 postTagsR = do
   ((result, formWidget), formEnctype) <- runFormPost tagForm
-  mUser <- maybeAuth
-  when (checkIfAdmin mUser) $ do
+  canTagsBeAdded <- canAddTags
+  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")
diff --git a/Settings.hs b/Settings.hs
index 47870db..b00f7bd 100644
--- a/Settings.hs
+++ b/Settings.hs
@@ -19,12 +19,19 @@ import Yesod.Default.Util          (WidgetFileSettings, widgetFileNoReload,
                                     widgetFileReload)
 
 data RepoScheme = SelfHosted | Branches
-                  deriving(Eq, Show)
+                  deriving (Eq, Show)
 
 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
diff --git a/config/settings.yml b/config/settings.yml
index b6df103..5b771ed 100644
--- a/config/settings.yml
+++ b/config/settings.yml
@@ -1,15 +1,16 @@
 # Values formatted like "_env:ENV_VAR_NAME:default_value" can be overridden by the specified environment variable.
 # See https://github.com/yesodweb/yesod/wiki/Configuration#overriding-configuration-values-with-environment-variables
 
-static-dir:     "_env:STATIC_DIR:static"
-host:           "_env:HOST:*4" # any IPv4 host
-port:           "_env:PORT:3000"
-approot:        "_env:APPROOT:http://localhost:3000"
-ip-from-header: "_env:IP_FROM_HEADER:false"
-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"
+static-dir:      "_env:STATIC_DIR:static"
+host:            "_env:HOST:*4" # any IPv4 host
+port:            "_env:PORT:3000"
+approot:         "_env:APPROOT:http://localhost:3000"
+ip-from-header:  "_env:IP_FROM_HEADER:false"
+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.
diff --git a/templates/tags.hamlet b/templates/tags.hamlet
index 8681992..01d85aa 100644
--- a/templates/tags.hamlet
+++ b/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}>