Add CLI command to update user data

This commit is contained in:
Saku Laesvuori 2023-10-31 21:37:19 +02:00
parent 6b93991cb3
commit 7983f9b187
Signed by: slaesvuo
GPG Key ID: 257D284A2A1D3A32
1 changed files with 28 additions and 1 deletions

View File

@ -33,6 +33,7 @@ main = do
GCEmails -> gcEmailsMain GCEmails -> gcEmailsMain
GCApplications -> gcApplicationsMain GCApplications -> gcApplicationsMain
GCAll -> gcAllMain GCAll -> gcAllMain
UpdateUser opts -> updateUserMain opts
addUserMain :: AddUserOpts -> CLIM () addUserMain :: AddUserOpts -> CLIM ()
addUserMain AddUserOpts {..} = do addUserMain AddUserOpts {..} = do
@ -74,6 +75,15 @@ gcAllMain = do
gcEmailsMain gcEmailsMain
gcApplicationsMain gcApplicationsMain
updateUserMain :: UpdateUserOpts -> CLIM ()
updateUserMain UpdateUserOpts {..} = runQuery $ do
case updateUserApplication of
Nothing -> pure ()
Just application -> Sql.updateUserData updateUserId [] [Sql.SetUserApplication application]
case updateUserPermissions of
Nothing -> pure ()
Just permissions -> Sql.setPermissions updateUserId $ show permissions
cliOptions :: Parser CLIOptions cliOptions :: Parser CLIOptions
cliOptions = CLIOptions cliOptions = CLIOptions
<$> strOption (short 'u' <> long "db-url" <> metavar "URL" <> value "postgres:///datarekisteri-backend") <$> strOption (short 'u' <> long "db-url" <> metavar "URL" <> value "postgres:///datarekisteri-backend")
@ -85,6 +95,7 @@ cliCommandParser = hsubparser
<> command "gc-expired-emails" (info (pure GCEmails) (progDesc "Delete emails that have not been verified in time.")) <> command "gc-expired-emails" (info (pure GCEmails) (progDesc "Delete emails that have not been verified in time."))
<> command "gc-applications" (info (pure GCApplications) (progDesc "Delete users without an email address")) <> command "gc-applications" (info (pure GCApplications) (progDesc "Delete users without an email address"))
<> command "gc" (info (pure GCAll) (progDesc "Run all garbage collection jobs.")) <> command "gc" (info (pure GCAll) (progDesc "Run all garbage collection jobs."))
<> command "update-user" (info updateUserCommand (progDesc "Update a datarekisteri user"))
addUserCommand :: Parser CLISubCommand addUserCommand :: Parser CLISubCommand
addUserCommand = fmap AddUser $ AddUserOpts addUserCommand = fmap AddUser $ AddUserOpts
@ -94,9 +105,18 @@ addUserCommand = fmap AddUser $ AddUserOpts
<*> strOption (long "homeplace" <> metavar "NAME" <> help "The user's homeplace, usually a city") <*> strOption (long "homeplace" <> metavar "NAME" <> help "The user's homeplace, usually a city")
<*> option (maybeReader $ toPhoneNumber . toText) (long "phone-number" <> metavar "PHONE" <> help "The user's phone number. Only numbers, spaces and the plus-sign are allowed") <*> option (maybeReader $ toPhoneNumber . toText) (long "phone-number" <> metavar "PHONE" <> help "The user's phone number. Only numbers, spaces and the plus-sign are allowed")
<*> option (maybeReader $ toEmail . toText) (long "email" <> metavar "EMAIL" <> help "The user's email address.") <*> option (maybeReader $ toEmail . toText) (long "email" <> metavar "EMAIL" <> help "The user's email address.")
<*> (fromList <$> many permissionParser) <*> permissionsParser
<*> strOption (long "application" <> metavar "TEXT" <> value "Added by the admin.") <*> strOption (long "application" <> metavar "TEXT" <> value "Added by the admin.")
updateUserCommand :: Parser CLISubCommand
updateUserCommand = fmap UpdateUser $ UpdateUserOpts
<$> (UserID <$> argument auto (metavar "USER"))
<*> optional (strOption (long "application" <> metavar "TEXT"))
<*> optional permissionsParser
permissionsParser :: Parser (Map Scope Permission)
permissionsParser = fromList <$> many permissionParser
permissionParser :: Parser (Scope, Permission) permissionParser :: Parser (Scope, Permission)
permissionParser = (,) permissionParser = (,)
<$> option auto (long "scope") <$> option auto (long "scope")
@ -111,6 +131,13 @@ data CLISubCommand = AddUser AddUserOpts
| GCEmails | GCEmails
| GCApplications | GCApplications
| GCAll | GCAll
| UpdateUser UpdateUserOpts
data UpdateUserOpts = UpdateUserOpts
{ updateUserId :: UserID
, updateUserApplication :: Maybe Text
, updateUserPermissions :: Maybe (Map Scope Permission)
}
data AddUserOpts = AddUserOpts data AddUserOpts = AddUserOpts
{ addUserNickname :: Maybe Text { addUserNickname :: Maybe Text