make registration block configurable from UI

This commit is contained in:
nek0 2022-02-20 21:02:50 +01:00
parent 80d80e2a5d
commit fb679ff96b
2 changed files with 8 additions and 15 deletions

View file

@ -18,7 +18,7 @@ data ServerConfig = ServerConfig
, configListenPort :: Word , configListenPort :: Word
, configListenHost :: T.Text , configListenHost :: T.Text
-- , configMaxConnectionsPerClient :: Word -- , configMaxConnectionsPerClient :: Word
, configBlockRegistration :: Bool -- , configBlockRegistration :: Bool
, configSendmailPath :: FilePath , configSendmailPath :: FilePath
} }
deriving (Show) deriving (Show)
@ -35,8 +35,9 @@ instance FromJSON ServerConfig where
<*> m .: "listen_port" <*> m .: "listen_port"
<*> m .:? "listen_host" .!= "127.0.0.1" <*> m .:? "listen_host" .!= "127.0.0.1"
-- <*> m .:? "max_connections_per_client" .!= 10 -- <*> m .:? "max_connections_per_client" .!= 10
<*> m .: "block_registration" -- <*> m .: "block_registration"
<*> m .: "sendmail_path" <*> m .: "sendmail_path"
parseJSON _ = error "Can not parse configuration"
data Options = Options data Options = Options
{ optConfigLocation :: T.Text { optConfigLocation :: T.Text

View file

@ -73,7 +73,7 @@ main = do
lport lport
lhost lhost
-- max_conn_per_client -- max_conn_per_client
block_registration -- block_registration
sendmail_path sendmail_path
) -> do ) -> do
conn <- connectPostgreSQL ( conn <- connectPostgreSQL (
@ -142,7 +142,7 @@ main = do
in Right $ Address $ toSockAddr (read (B8.unpack xaddr), defaultPort) in Right $ Address $ toSockAddr (read (B8.unpack xaddr), defaultPort)
Nothing -> Right $ Address $ remoteHost req Nothing -> Right $ Address $ remoteHost req
) )
runSettings settings (throttle th (app block_registration initState)) runSettings settings (throttle th (app initState))
where where
opts = info (options <**> helper) opts = info (options <**> helper)
( fullDesc ( fullDesc
@ -150,9 +150,9 @@ main = do
<> header "mateamt - Your friendly mate distribution office" <> header "mateamt - Your friendly mate distribution office"
) )
app :: Bool -> ReadState -> Application app :: ReadState -> Application
-- app conn = serveWithContext userApi genAuthServerContext (users conn) -- app conn = serveWithContext userApi genAuthServerContext (users conn)
app block_registration initState = app initState =
serveWithContext mateApi (genAuthServerContext (rsConnection initState)) $ serveWithContext mateApi (genAuthServerContext (rsConnection initState)) $
hoistServerWithContext hoistServerWithContext
mateApi mateApi
@ -166,15 +166,7 @@ app block_registration initState =
authManageNewAuth :<|> authManageNewAuth :<|>
authManageDeleteAuth :<|> authManageDeleteAuth :<|>
( userNew :<|>
if block_registration
then
const $ throwError $ err406
{ errBody = "User registration is not allowed."
}
else
userNew
) :<|>
userGet :<|> userGet :<|>
userUpdate :<|> userUpdate :<|>
userList :<|> userList :<|>