Merge branch 'dev-merge' into dev

src/Gargantext/API/GraphQL/UserInfo.hs

@@ -4,6 +4,7 @@
 module Gargantext.API.GraphQL.UserInfo where
 
 import Control.Lens
+import Data.Maybe (fromMaybe)
 import Data.Morpheus.Types
   ( GQLType
   , Resolver
@@ -39,7 +40,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact
   , hc_where)
 import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
-import Gargantext.Database.Query.Table.User (getUsersWithHyperdata, getUsersWithNodeHyperdata)
+import Gargantext.Database.Query.Table.User (getUsersWithHyperdata, getUsersWithNodeHyperdata, updateUserEmail)
 import Gargantext.Database.Schema.User (UserLight(..))
 import Gargantext.Database.Schema.Node (node_id, node_hyperdata)
 import Gargantext.Prelude
@@ -60,7 +61,8 @@ data UserInfo = UserInfo
   , ui_cwOffice       :: Maybe Text
   , ui_cwRole         :: Maybe Text
   , ui_cwTouchPhone   :: Maybe Text
-  , ui_cwTouchMail    :: Maybe Text }
+  , ui_cwTouchMail    :: Maybe Text  -- TODO: Remove. userLight_email should be used instead
+  }
   deriving (Generic, GQLType, Show)
 
 -- | Arguments to the "user info" query.
@@ -106,7 +108,7 @@ updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
   users <- lift (getUsersWithNodeHyperdata ui_id)
   case users of
     [] -> panic $ "[updateUserInfo] User with id " <> (T.pack $ show ui_id) <> " doesn't exist."
-    ((_u, node_u):_) -> do
+    ((UserLight { .. }, node_u):_) -> do
       let u_hyperdata = node_u ^. node_hyperdata
       -- lift $ printDebug "[updateUserInfo] u" u
       let u_hyperdata' = uh ui_titleL ui_title $
@@ -122,8 +124,17 @@ updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
                          uh ui_cwTouchMailL ui_cwTouchMail $
                          uh ui_cwTouchPhoneL ui_cwTouchPhone $
                          u_hyperdata
+      -- NOTE: We have 1 username and 2 emails: userLight_email and ui_cwTouchMail
+      -- The userLight_email is more important: it is used for login and sending mail.
+      -- Therefore we update ui_cwTouchMail and userLight_email.
+      -- ui_cwTouchMail is to be removed in the future.
+      let u' = UserLight { userLight_id
+                         , userLight_username
+                         , userLight_email = fromMaybe userLight_email $ view ui_cwTouchMailL u_hyperdata
+                         , userLight_password }
       -- lift $ printDebug "[updateUserInfo] with firstName" u_hyperdata'
       _ <- lift $ updateHyperdata (node_u ^. node_id) u_hyperdata'
+      _ <- lift $ updateUserEmail u'
       --let _newUser = toUser (u, u_hyperdata')
       pure 1
   where
@@ -158,7 +169,8 @@ toUser (UserLight { .. }, u_hyperdata) =
            , ui_cwOrganization = u_hyperdata ^. ui_cwOrganizationL
            , ui_cwOffice       = u_hyperdata ^. ui_cwOfficeL
            , ui_cwRole         = u_hyperdata ^. ui_cwRoleL
-           , ui_cwTouchMail    = u_hyperdata ^. ui_cwTouchMailL
+           --, ui_cwTouchMail    = u_hyperdata ^. ui_cwTouchMailL
+           , ui_cwTouchMail    = Just userLight_email
            , ui_cwTouchPhone   = u_hyperdata ^. ui_cwTouchPhoneL }
 
 sharedL :: Traversal' HyperdataUser HyperdataContact

src/Gargantext/Core/Mail.hs

@@ -48,7 +48,10 @@ mail mailCfg model = do
     (m,u)   = email_to         model
     subject = email_subject    model
     body    = emailWith (view gc_url cfg)    model
-  liftBase $ gargMail mailCfg (GargMail m (Just u) subject body)
+  liftBase $ gargMail mailCfg (GargMail { gm_to = m
+                                        , gm_name = Just u
+                                        , gm_subject = subject
+                                        , gm_body = body })
 
 ------------------------------------------------------------------------
 emailWith :: ServerAddress -> MailModel -> Text
@@ -62,7 +65,7 @@ emailWith server model =
 email_to :: MailModel -> (EmailAddress, Name)
 email_to (Invitation user) = email_to' user
 email_to (PassUpdate user) = email_to' user
-email_to (MailInfo u m)    = (m, u)
+email_to (MailInfo { .. })    = (mailInfo_address, mailInfo_username)
 
 email_to' :: NewUser GargPassword -> (EmailAddress, Name)
 email_to' (NewUser u m _) = (m,u)

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

@@ -26,6 +26,7 @@ module Gargantext.Database.Query.Table.User
   , getUserHyperdata
   , getUsersWithHyperdata
   , getUsersWithNodeHyperdata
+  , updateUserEmail
   , getUser
   , insertNewUsers
   , selectUsersLightWith
@@ -158,6 +159,17 @@ getUsersWithNodeHyperdata i = do
   pure $ zip u h
 
 
+updateUserEmail :: UserLight -> Cmd err Int64
+updateUserEmail (UserLight { .. }) = mkCmd $ \c -> runUpdate_ c updateUserQuery
+  where
+    updateUserQuery :: Update Int64
+    updateUserQuery = 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 (sqlStrictText userLight_email) _is _ia _dj)
+      , uWhere      = (\row -> user_id row .== (sqlInt4 userLight_id))
+      , uReturning  = rCount }
+
 
 ------------------------------------------------------------------
 -- | Select User with some parameters

stack.yaml

@@ -30,7 +30,7 @@ allow-newer: true
 
 extra-deps:
 - git: https://gitlab.iscpif.fr/gargantext/haskell-gargantext-prelude.git
-  commit: 220f32810f988a5a121f110a7d557fc7d0721712
+  commit: 08096a4913572cf22762fa77613340207ec6d9fd
 - git: https://gitlab.iscpif.fr/gargantext/gargantext-graph.git
   commit: f68f9e78ff4302f53d0855190574c2d818a00b4d
   # Data Mining Libs