introducint 2 modes for tags

This commit is contained in:
Filip Graliński 2018-06-27 13:32:45 +02:00
parent 7b7001845d
commit 4ec90bdb10
4 changed files with 42 additions and 17 deletions

View File

@ -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")

View File

@ -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

View File

@ -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.

View File

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