New YAML setting: Optional user limit

config/settings.yml

@@ -42,3 +42,4 @@ repo-dir:     repos
 ssh-port:     5022
 ssh-key-file: config/ssh-host-key
 registration: false
+max-accounts: 3

src/Vervis/Handler/Person.hs

@@ -24,7 +24,7 @@ where
 import Vervis.Import hiding ((==.))
 --import Prelude
 
-import Database.Esqueleto hiding (isNothing)
+import Database.Esqueleto hiding (isNothing, count)
 import Vervis.Form.Person
 --import Model
 import Text.Blaze.Html (toHtml)
@@ -45,8 +45,15 @@ getPeopleR = do
 -- | Create new user
 postPeopleR :: Handler Html
 postPeopleR = do
-    regEnabled <- getsYesod $ appRegister . appSettings
-    if regEnabled
+    settings <- getsYesod appSettings
+    if appRegister settings
+        then do
+            room <- case appAccounts settings of
+                Nothing -> return True
+                Just cap -> do
+                    current <- runDB $ count ([] :: [Filter Person])
+                    return $ current < cap
+            if room
                 then do
                     ((result, widget), enctype) <- runFormPost newPersonForm
                     case result of
@@ -72,9 +79,15 @@ postPeopleR = do
                             setMessage "Field(s) missing"
                             defaultLayout $(widgetFile "person-new")
                         FormFailure _l -> do
-                    setMessage "User registration failed, see errors below"
+                            setMessage
+                                "User registration failed, see errors below"
                             defaultLayout $(widgetFile "person-new")
-        else notFound
+                else do
+                    setMessage "Maximal number of registered users reached"
+                    redirect PeopleR
+        else do
+            setMessage "User registration disabled"
+            redirect PeopleR
 
 getPersonNewR :: Handler Html
 getPersonNewR = do

src/Vervis/Settings.hs

@@ -77,6 +77,8 @@ data AppSettings = AppSettings
     , appSshKeyFile             :: FilePath
       -- | Whether new user accounts can be created.
     , appRegister               :: Bool
+      -- | The maximal number of user accounts that can be registered.
+    , appAccounts               :: Maybe Int
     }
 
 instance FromJSON AppSettings where
@@ -104,6 +106,7 @@ instance FromJSON AppSettings where
         appSshPort                <- o .: "ssh-port"
         appSshKeyFile             <- o .: "ssh-key-file"
         appRegister               <- o .: "registration"
+        appAccounts               <- o .: "max-accounts"
 
         return AppSettings {..}