diff --git a/Handler/Home.hs b/Handler/Home.hs index 419336e..e8cc307 100644 --- a/Handler/Home.hs +++ b/Handler/Home.hs @@ -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] diff --git a/Handler/NewUser.hs b/Handler/NewUser.hs index 9085297..2142adb 100644 --- a/Handler/NewUser.hs +++ b/Handler/NewUser.hs @@ -13,6 +13,7 @@ -- -- You should have received a copy of the GNU Affero General Public License -- along with this program. If not, see . +{-# LANGUAGE DoAndIfThenElse #-} module Handler.NewUser where import Import as I @@ -21,33 +22,45 @@ import Text.Shakespeare.Text getNewUserR :: Handler Html getNewUserR = do - today <- liftIO $ return . utctDay =<< getCurrentTime - (newUserWidget, enctype) <- generateFormPost - $ renderBootstrap3 BootstrapBasicForm - $ newUserForm today - defaultLayout $ - $(widgetFile "newUser") + settings <- getsYesod appSettings + if appUserCreationBlocked settings + then do + setMessageI MsgCreationBlocked + redirect HomeR + else do + today <- liftIO $ return . utctDay =<< getCurrentTime + (newUserWidget, enctype) <- generateFormPost + $ renderBootstrap3 BootstrapBasicForm + $ newUserForm today + defaultLayout $ + $(widgetFile "newUser") postNewUserR :: Handler Html postNewUserR = do - today <- liftIO $ return . utctDay =<< getCurrentTime - ((res, _), _) <- runFormPost - $ renderBootstrap3 BootstrapBasicForm - $ newUserForm today - case res of - FormSuccess user -> do - namesakes <- runDB $ selectList [UserIdent ==. userIdent user] [] - if null namesakes - then do - runDB $ insert_ user - setMessageI MsgUserCreated - redirect HomeR - else do - setMessageI MsgUserIdentNotUnique - redirect NewUserR - _ -> do - setMessageI MsgUserNotCreated - redirect NewUserR + settings <- getsYesod appSettings + if appUserCreationBlocked settings + then do + setMessageI MsgCreationBlocked + redirect HomeR + else do + today <- liftIO $ return . utctDay =<< getCurrentTime + ((res, _), _) <- runFormPost + $ renderBootstrap3 BootstrapBasicForm + $ newUserForm today + case res of + FormSuccess user -> do + namesakes <- runDB $ selectList [UserIdent ==. userIdent user] [] + if null namesakes + then do + runDB $ insert_ user + setMessageI MsgUserCreated + redirect HomeR + else do + setMessageI MsgUserIdentNotUnique + redirect NewUserR + _ -> do + setMessageI MsgUserNotCreated + redirect NewUserR newUserForm :: Day -> AForm Handler User newUserForm today = User diff --git a/Settings.hs b/Settings.hs index d545b33..5496733 100644 --- a/Settings.hs +++ b/Settings.hs @@ -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 {..} diff --git a/config/settings.yml b/config/settings.yml index 00efa24..377db6a 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -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" diff --git a/messages/cz.msg b/messages/cz.msg index 7d48041..9f6cf16 100644 --- a/messages/cz.msg +++ b/messages/cz.msg @@ -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. diff --git a/messages/de.msg b/messages/de.msg index 871c4a6..7d35b8a 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -145,3 +145,4 @@ Modify: bearbeiten UserIdentNotUnique: Benutzername ist nicht einzigartig Login: Login Logout: Logout +CreationBlocked: Es können keine neuen Nutzer angelegt werden. diff --git a/messages/en.msg b/messages/en.msg index b473664..9ec61e6 100644 --- a/messages/en.msg +++ b/messages/en.msg @@ -145,3 +145,4 @@ Modify: modify UserIdentNotUnique: Username is not unique Login: Login Logout: Logout +CreationBlocked: New users can not be created. diff --git a/templates/home.hamlet b/templates/home.hamlet index be953aa..6f7876b 100644 --- a/templates/home.hamlet +++ b/templates/home.hamlet @@ -16,9 +16,10 @@ $forall (Entity uId user) <- users

#{userIdent user} -

- -

_{MsgCreateUser} +$if not (appUserCreationBlocked settings) +