implement signup block

This commit is contained in:
nek0 2022-07-26 20:25:55 +02:00
parent 92a71e518f
commit ddb26faf5c
2 changed files with 27 additions and 17 deletions

View file

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

View file

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