From fb679ff96bea45cefee75527990f4166d9f860b1 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 20 Feb 2022 21:02:50 +0100 Subject: [PATCH] make registration block configurable from UI --- app/AppTypes/Configuration.hs | 5 +++-- app/Main.hs | 18 +++++------------- 2 files changed, 8 insertions(+), 15 deletions(-) diff --git a/app/AppTypes/Configuration.hs b/app/AppTypes/Configuration.hs index 0506f51..f77edda 100644 --- a/app/AppTypes/Configuration.hs +++ b/app/AppTypes/Configuration.hs @@ -18,7 +18,7 @@ data ServerConfig = ServerConfig , configListenPort :: Word , configListenHost :: T.Text -- , configMaxConnectionsPerClient :: Word - , configBlockRegistration :: Bool + -- , configBlockRegistration :: Bool , configSendmailPath :: FilePath } deriving (Show) @@ -35,8 +35,9 @@ instance FromJSON ServerConfig where <*> m .: "listen_port" <*> m .:? "listen_host" .!= "127.0.0.1" -- <*> m .:? "max_connections_per_client" .!= 10 - <*> m .: "block_registration" + -- <*> m .: "block_registration" <*> m .: "sendmail_path" + parseJSON _ = error "Can not parse configuration" data Options = Options { optConfigLocation :: T.Text diff --git a/app/Main.hs b/app/Main.hs index 883acb7..9324ce9 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -73,7 +73,7 @@ main = do lport lhost -- max_conn_per_client - block_registration + -- block_registration sendmail_path ) -> do conn <- connectPostgreSQL ( @@ -142,7 +142,7 @@ main = do in Right $ Address $ toSockAddr (read (B8.unpack xaddr), defaultPort) Nothing -> Right $ Address $ remoteHost req ) - runSettings settings (throttle th (app block_registration initState)) + runSettings settings (throttle th (app initState)) where opts = info (options <**> helper) ( fullDesc @@ -150,9 +150,9 @@ main = do <> header "mateamt - Your friendly mate distribution office" ) -app :: Bool -> ReadState -> Application +app :: ReadState -> Application -- app conn = serveWithContext userApi genAuthServerContext (users conn) -app block_registration initState = +app initState = serveWithContext mateApi (genAuthServerContext (rsConnection initState)) $ hoistServerWithContext mateApi @@ -166,15 +166,7 @@ app block_registration initState = authManageNewAuth :<|> authManageDeleteAuth :<|> - ( - if block_registration - then - const $ throwError $ err406 - { errBody = "User registration is not allowed." - } - else - userNew - ) :<|> + userNew :<|> userGet :<|> userUpdate :<|> userList :<|>