[ADMIN] update user fun (WIP)

src/Gargantext/Database/Action/User.hs

@@ -24,7 +24,6 @@ import Gargantext.Prelude.Mail (gargMail, GargMail(..))
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..), nodeError, NodeError(..))
 import Gargantext.Database.Action.Flow (getOrMkRoot)
 
-
 ------------------------------------------------------------------------
 mkUser :: HasNodeError err => Text -> NewUser GargPassword -> Cmd err Int64
 mkUser address u = mkUsers address [u]
@@ -36,6 +35,13 @@ mkUsers address us = do
   _   <- mapM getOrMkRoot $ map (\u -> UserName (_nu_username u)) us
   _   <- liftBase    $ mapM (mail address) us
   pure r
+------------------------------------------------------------------------
+updateUser :: HasNodeError err => Text -> NewUser GargPassword -> Cmd err Int64
+updateUser address u = do
+  u' <- liftBase   $ toUserHash   u
+  n  <- updateUserDB $ toUserWrite  u'
+  _  <- liftBase   $ mail address u
+  pure n
 
 ------------------------------------------------------------------------
 -- TODO gargantext.ini config
@@ -68,9 +74,6 @@ logInstructions address (NewUser u _ (GargPassword p)) =
           , "The Gargantext Team (CNRS)"
           ]
 
-------------------------------------------------------------------------
-
-
 ------------------------------------------------------------------------
 rmUser :: HasNodeError err => User -> Cmd err Int64
 rmUser (UserName un) = deleteUsers [un]

src/Gargantext/Database/Query/Table/User.hs

@@ -21,6 +21,7 @@ module Gargantext.Database.Query.Table.User
   ( insertUsers
   , toUserWrite
   , deleteUsers
+  , updateUserDB
   , queryUserTable
   , getUser
   , insertUsersDemo
@@ -55,6 +56,22 @@ deleteUsers :: [Username] -> Cmd err Int64
 deleteUsers us = mkCmd $ \c -> runDelete c userTable
     (\user -> in_ (map pgStrictText us) (user_username user))
 
+-- Updates email or password only (for now)
+updateUserDB :: UserWrite -> Cmd err Int64
+updateUserDB us = mkCmd $ \c -> runUpdate_ c (updateUserQuery us)
+  where
+    updateUserQuery :: UserWrite -> Update Int64
+    updateUserQuery us = Update
+      { uTable      = userTable
+      , uUpdateWith = updateEasy (\ (UserDB _id _p ll su un fn ln _em is ia dj)
+                                  -> UserDB _id p' ll su un fn ln em' is ia dj
+                                 )
+      , uWhere      = (\row -> user_username row .== un')
+      , uReturning  = rCount
+      }
+        where
+          UserDB _ p' _ _ un' _ _ em' _ _ _ = us
+
 -----------------------------------------------------------------------
 toUserWrite :: NewUser HashPassword -> UserWrite
 toUserWrite (NewUser u m (Auth.PasswordHash p)) =