added possibility to block new user creation

This commit is contained in:
nek0 2017-06-03 03:00:04 +02:00
parent 36b9af139e
commit 569eb3b95a
8 changed files with 51 additions and 27 deletions

View file

@ -28,6 +28,7 @@ import Data.Time.Calendar (addDays)
-- inclined, or create a single monolithic file.
getHomeR :: Handler Html
getHomeR = do
settings <- getsYesod appSettings
beverages <- runDB $ selectList [BeverageAmount !=. 0] [Desc BeverageIdent]
today <- liftIO $ utctDay <$> getCurrentTime
users <- runDB $ selectList [UserTimestamp >=. addDays (-30) today] [Asc UserIdent]

View file

@ -13,6 +13,7 @@
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
{-# LANGUAGE DoAndIfThenElse #-}
module Handler.NewUser where
import Import as I
@ -21,6 +22,12 @@ import Text.Shakespeare.Text
getNewUserR :: Handler Html
getNewUserR = do
settings <- getsYesod appSettings
if appUserCreationBlocked settings
then do
setMessageI MsgCreationBlocked
redirect HomeR
else do
today <- liftIO $ return . utctDay =<< getCurrentTime
(newUserWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm
@ -30,6 +37,12 @@ getNewUserR = do
postNewUserR :: Handler Html
postNewUserR = do
settings <- getsYesod appSettings
if appUserCreationBlocked settings
then do
setMessageI MsgCreationBlocked
redirect HomeR
else do
today <- liftIO $ return . utctDay =<< getCurrentTime
((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm

View file

@ -76,6 +76,8 @@ data AppSettings = AppSettings
, appCopyright :: Text
, appCopyrightLink :: Text
-- ^ Text and link to source
, appUserCreationBlocked :: Bool
-- ^ Block user creation
, appAdminCreds :: Maybe Login
-- ^ optional admin credentials
}
@ -119,6 +121,8 @@ instance FromJSON AppSettings where
appCopyright <- o .: "copyright"
appCopyrightLink <- o .: "copyright_link"
appUserCreationBlocked <- o .: "block_users"
appAdminCreds <- o .:? "credentials"
return AppSettings {..}

View file

@ -33,6 +33,8 @@ cash_charge: 50
copyright: "Powered by YAMMAT"
copyright_link: "https://github.com/nek0/yammat"
block_users: false
# optional administrative credentials.
# credentials:
# login: "admin"

View file

@ -145,3 +145,4 @@ Modify: upravit
UserIdentNotUnique: Uživatelské jméno není jedinečný
Login: Přihlásit
Logout: Odhlásit
CreationBlocked: Nelze vytvořit nové uživatele.

View file

@ -145,3 +145,4 @@ Modify: bearbeiten
UserIdentNotUnique: Benutzername ist nicht einzigartig
Login: Login
Logout: Logout
CreationBlocked: Es können keine neuen Nutzer angelegt werden.

View file

@ -145,3 +145,4 @@ Modify: modify
UserIdentNotUnique: Username is not unique
Login: Login
Logout: Logout
CreationBlocked: New users can not be created.

View file

@ -16,7 +16,8 @@ $forall (Entity uId user) <- users
<a href=@{SelectR uId}>
<p>#{userIdent user}
<article .article #func>
$if not (appUserCreationBlocked settings)
<article .article #func>
<a href=@{NewUserR}>
<p>_{MsgCreateUser}