[FIX] UserInfo page get and update, Password hidden in the logs

bin/gargantext-client/Auth.hs

@@ -35,7 +35,7 @@ withAuthToken opts act
           maybe "" (show . Auth._authInv_message)
                    (Auth._authRes_inval authRes)
         -- authentication went through, we can run the action
-        Just (Auth.AuthValid tok tree_id) -> do
+        Just (Auth.AuthValid tok tree_id _uid) -> do
           let tok' = SA.Token (encodeUtf8 tok)
           whenVerbose opts $ do
             liftIO . putStrLn $ "[Debug] Authenticated: token=" ++ show tok ++

src/Gargantext/API/Admin/Auth.hs

@@ -70,7 +70,7 @@ checkAuthRequest u (GargPassword p) = do
   candidate <- head <$> getUsersWith u
   case candidate of
     Nothing -> pure InvalidUser
-    Just (UserLight id _u _email h) ->
+    Just (UserLight id _u _email (GargPassword h)) ->
       case Auth.checkPassword (Auth.mkPassword p) (Auth.PasswordHash h) of
         Auth.PasswordCheckFail    -> pure InvalidPassword
         Auth.PasswordCheckSuccess -> do

src/Gargantext/API/GraphQL/UserInfo.hs

@@ -37,11 +37,11 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact
   , ct_phone
   , hc_who
   , hc_where)
-import Gargantext.Database.Admin.Types.Node (NodeId(..))
 import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
-import Gargantext.Database.Query.Table.User (getUsersWithHyperdata)
+import Gargantext.Database.Query.Table.User (getUsersWithHyperdata, getUsersWithNodeHyperdata)
 import Gargantext.Database.Schema.User (UserLight(..))
+import Gargantext.Database.Schema.Node (node_id, node_hyperdata)
 import Gargantext.Prelude
 import GHC.Generics (Generic)
 
@@ -72,7 +72,7 @@ data UserInfoArgs
 -- | Arguments to the "user info" mutation,
 data UserInfoMArgs
   = UserInfoMArgs
-    { ui_id :: Int
+    { ui_id             :: Int
     , ui_username       :: Maybe Text
     , ui_email          :: Maybe Text
     , ui_title          :: Maybe Text
@@ -102,12 +102,13 @@ updateUserInfo
   :: (HasConnectionPool env, HasConfig env, HasMail env)
   => UserInfoMArgs -> ResolverM e (GargM env GargError) Int
 updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
-  lift $ printDebug "[updateUserInfo] ui_id" ui_id
-  users <- lift (getUsersWithHyperdata ui_id)
+  -- lift $ printDebug "[updateUserInfo] ui_id" ui_id
+  users <- lift (getUsersWithNodeHyperdata ui_id)
   case users of
     [] -> panic $ "[updateUserInfo] User with id " <> (T.pack $ show ui_id) <> " doesn't exist."
-    ((u, u_hyperdata):_) -> do
-      lift $ printDebug "[updateUserInfo] u" u
+    ((u, node_u):_) -> do
+      let u_hyperdata = node_u ^. node_hyperdata
+      -- lift $ printDebug "[updateUserInfo] u" u
       let u_hyperdata' = uh ui_titleL ui_title $
                          uh ui_sourceL ui_source $
                          uh ui_cwFirstNameL ui_cwFirstName $
@@ -121,8 +122,8 @@ updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
                          uh ui_cwTouchMailL ui_cwTouchMail $
                          uh ui_cwTouchPhoneL ui_cwTouchPhone $
                          u_hyperdata
-      lift $ printDebug "[updateUserInfo] with firstName" u_hyperdata'
-      _ <- lift $ updateHyperdata (NodeId ui_id) u_hyperdata'
+      -- lift $ printDebug "[updateUserInfo] with firstName" u_hyperdata'
+      _ <- lift $ updateHyperdata (node_u ^. node_id) u_hyperdata'
       --let _newUser = toUser (u, u_hyperdata')
       pure 1
   where
@@ -136,6 +137,7 @@ dbUsers
   :: (HasConnectionPool env, HasConfig env, HasMail env)
   => Int -> GqlM e env [UserInfo]
 dbUsers user_id = do
+  -- lift $ printDebug "[dbUsers]" user_id
 --  user <- getUsersWithId user_id
 --  hyperdata <- getUserHyperdata user_id
 --  lift (map toUser <$> zip user hyperdata)

src/Gargantext/Core/Types/Individu.hs

@@ -34,6 +34,9 @@ type HashPassword    = Auth.PasswordHash Auth.Argon2
 newtype GargPassword = GargPassword Text
   deriving (Generic)
 
+toGargPassword :: Text -> GargPassword
+toGargPassword x = GargPassword x
+
 instance Show GargPassword where
   show (GargPassword _) = "*GargPassword*"
 

src/Gargantext/Database/Query/Table/Node/Select.hs

@@ -26,7 +26,7 @@ import Gargantext.Database.Schema.Node
 import Gargantext.Database.Schema.User
 import Gargantext.Database.Query.Table.User
 
-selectNodesWithUsername :: HasDBid NodeType => NodeType -> Username -> Cmd err [NodeId]
+selectNodesWithUsername :: NodeType -> Username -> Cmd err [NodeId]
 selectNodesWithUsername nt u = runOpaQuery (q u)
   where
     q u' = proc () -> do

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

@@ -25,6 +25,7 @@ module Gargantext.Database.Query.Table.User
   , queryUserTable
   , getUserHyperdata
   , getUsersWithHyperdata
+  , getUsersWithNodeHyperdata
   , getUser
   , insertNewUsers
   , selectUsersLightWith
@@ -44,9 +45,11 @@ import Data.Text (Text)
 import Data.Time (UTCTime)
 import Gargantext.Core.Types.Individu
 import qualified Gargantext.Prelude.Crypto.Auth as Auth
+import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser)
+import Gargantext.Database.Admin.Types.Node (NodeType(NodeUser), Node)
 import Gargantext.Database.Prelude
-import Gargantext.Database.Schema.Node (node_hyperdata, node_id, queryNodeTable)
+import Gargantext.Database.Schema.Node (NodeRead, node_hyperdata, queryNodeTable, node_user_id, node_typename)
 import Gargantext.Database.Schema.User
 import Gargantext.Prelude
 import Opaleye
@@ -123,14 +126,39 @@ getUserHyperdata i = do
     selectUserHyperdataWithId :: Int -> Select (Column SqlJsonb)
     selectUserHyperdataWithId i' = proc () -> do
       row      <- queryNodeTable -< ()
-      restrict -< row^.node_id .== (sqlInt4 i')
+      restrict -< row^.node_user_id .== (sqlInt4 i')
+      restrict -< row^.node_typename .== (sqlInt4 $ nodeTypeId NodeUser)
       returnA  -< row^.node_hyperdata
 
+getUserNodeHyperdata :: Int -> Cmd err [Node HyperdataUser]
+getUserNodeHyperdata i = do
+  runOpaQuery (selectUserHyperdataWithId i)
+  where
+    selectUserHyperdataWithId :: Int -> Select NodeRead
+    selectUserHyperdataWithId i' = proc () -> do
+      row      <- queryNodeTable -< ()
+      restrict -< row^.node_user_id .== (sqlInt4 i')
+      restrict -< row^.node_typename .== (sqlInt4 $ nodeTypeId NodeUser)
+      returnA  -< row
+
+
+
 getUsersWithHyperdata :: Int -> Cmd err [(UserLight, HyperdataUser)]
 getUsersWithHyperdata i = do
   u <- getUsersWithId i
   h <- getUserHyperdata i
+  -- printDebug "[getUsersWithHyperdata]" (u,h)
+  pure $ zip u h
+
+getUsersWithNodeHyperdata :: Int -> Cmd err [(UserLight, Node HyperdataUser)]
+getUsersWithNodeHyperdata i = do
+  u <- getUsersWithId i
+  h <- getUserNodeHyperdata i
+  -- printDebug "[getUsersWithHyperdata]" (u,h)
   pure $ zip u h
+
+
+
 ------------------------------------------------------------------
 -- | Select User with some parameters
 -- Not optimized version

src/Gargantext/Database/Schema/User.hs

@@ -25,6 +25,7 @@ import Data.Text (Text)
 import Data.Time (UTCTime)
 import qualified Gargantext.API.GraphQL.Utils as GAGU
 import Gargantext.Core.Utils.Prefix (unPrefix)
+import Gargantext.Core.Types.Individu (GargPassword, toGargPassword)
 import Gargantext.Database.Prelude (fromField')
 import Gargantext.Prelude
 import GHC.Generics (Generic)
@@ -43,14 +44,14 @@ import Opaleye.Internal.Table (Table(..))
 data UserLight = UserLight { userLight_id       :: !Int
                            , userLight_username :: !Text
                            , userLight_email    :: !Text
-                           , userLight_password :: !Text
+                           , userLight_password :: !GargPassword
                            } deriving (Show, Generic)
 
 instance GQLType UserLight where
   typeOptions _ = GAGU.unPrefix "userLight_"
 
 toUserLight :: UserDB -> UserLight
-toUserLight (UserDB id p _ _ u _ _ e _ _ _ ) = UserLight id u e p
+toUserLight (UserDB id p _ _ u _ _ e _ _ _ ) = UserLight id u e (toGargPassword p)
 
 
 data UserPoly id pass llogin suser