From 7983f9b18704ce2e07351b64c3f9b37b7ed93030 Mon Sep 17 00:00:00 2001
From: Saku Laesvuori <saku@laesvuori.fi>
Date: Tue, 31 Oct 2023 21:37:19 +0200
Subject: [PATCH] Add CLI command to update user data

---
 backend/src/Datarekisteri/CLI.hs | 29 ++++++++++++++++++++++++++++-
 1 file changed, 28 insertions(+), 1 deletion(-)

diff --git a/backend/src/Datarekisteri/CLI.hs b/backend/src/Datarekisteri/CLI.hs
index 835a7cf..9662402 100644
--- a/backend/src/Datarekisteri/CLI.hs
+++ b/backend/src/Datarekisteri/CLI.hs
@@ -33,6 +33,7 @@ main = do
       GCEmails -> gcEmailsMain
       GCApplications -> gcApplicationsMain
       GCAll -> gcAllMain
+      UpdateUser opts -> updateUserMain opts
 
 addUserMain :: AddUserOpts -> CLIM ()
 addUserMain AddUserOpts {..} = do
@@ -74,6 +75,15 @@ gcAllMain = do
     gcEmailsMain
     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 = CLIOptions
     <$> 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-applications" (info (pure GCApplications) (progDesc "Delete users without an email address"))
     <> 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 = fmap AddUser $ AddUserOpts
@@ -94,9 +105,18 @@ addUserCommand = fmap AddUser $ AddUserOpts
     <*> 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 $ 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.")
 
+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 = (,)
     <$> option auto (long "scope")
@@ -111,6 +131,13 @@ data CLISubCommand = AddUser AddUserOpts
                    | GCEmails
                    | GCApplications
                    | GCAll
+                   | UpdateUser UpdateUserOpts
+
+data UpdateUserOpts = UpdateUserOpts
+    { updateUserId :: UserID
+    , updateUserApplication :: Maybe Text
+    , updateUserPermissions :: Maybe (Map Scope Permission)
+    }
 
 data AddUserOpts = AddUserOpts
         { addUserNickname :: Maybe Text