implement signup block

src/Control/User.hs

@@ -34,8 +34,15 @@ userNew
   :: UserSubmit
   -> MateHandler Int
 userNew (UserSubmit ident email pass) = do
-  now <- liftIO getCurrentTime
   conn <- asks rsConnection
+  block <- selectSignupBlocked conn
+  if block
+  then
+    throwError $ err401
+      { errBody = "User registration has been disabled"
+      }
+  else do
+    now <- liftIO getCurrentTime
     uid <- insertUser ident email (utctDay now) conn
     salt <- liftIO randomString
     let mpasshash = argon2 salt (encodeUtf8 pass)

src/Model/Settings.hs

@@ -59,6 +59,9 @@ selectSettings conn = liftIO $ do
 selectIdleTime :: PGS.Connection -> MateHandler Int
 selectIdleTime conn = settingsIdleTime <$> selectSettings conn
 
+selectSignupBlocked :: PGS.Connection -> MateHandler Bool
+selectSignupBlocked conn = settingsBlockRegistration <$> selectSettings conn
+
 updateSettings :: Settings -> PGS.Connection -> MateHandler ()
 updateSettings (Settings block imprint idleTime) conn = do
   void $ liftIO $ runUpdate_ conn $ Update