Merge remote-tracking branch 'origin/flexible-job-queue' into dev
[gargantext.git] / src / Gargantext / Database / Query / Table / User.hs
index f97cabb353e1897b7458e49af48c4742fa98faf8..efd2f6b55133b58d221d13fa0f34925252a18d0d 100644 (file)
@@ -26,6 +26,9 @@ module Gargantext.Database.Query.Table.User
   , getUserHyperdata
   , getUsersWithHyperdata
   , getUsersWithNodeHyperdata
+  , updateUserEmail
+  , updateUserPassword
+  , updateUserForgotPasswordUUID
   , getUser
   , insertNewUsers
   , selectUsersLightWith
@@ -33,6 +36,8 @@ module Gargantext.Database.Query.Table.User
   , userWithId
   , userLightWithId
   , getUsersWith
+  , getUsersWithEmail
+  , getUsersWithForgotPasswordUUID
   , getUsersWithId
   , module Gargantext.Database.Schema.User
   )
@@ -40,9 +45,11 @@ module Gargantext.Database.Query.Table.User
 
 import Control.Arrow (returnA)
 import Control.Lens ((^.))
+import Data.Maybe (fromMaybe)
 import Data.List (find)
 import Data.Text (Text)
 import Data.Time (UTCTime)
+import qualified Data.UUID as UUID
 import Gargantext.Core.Types.Individu
 import qualified Gargantext.Prelude.Crypto.Auth as Auth
 import Gargantext.Database.Admin.Config (nodeTypeId)
@@ -74,25 +81,34 @@ updateUserDB us = mkCmd $ \c -> runUpdate_ c (updateUserQuery us)
     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
+      , uUpdateWith = updateEasy (\ (UserDB { .. })
+                                  -> UserDB { user_password = p'
+                                            , user_email = em'
+                                            , .. }
                                  )
       , uWhere      = (\row -> user_username row .== un')
       , uReturning  = rCount
       }
         where
-          UserDB _ p' _ _ un' _ _ em' _ _ _ = us'
+          UserDB { user_password = p'
+                 , user_username = un'
+                 , user_email = em' } = us'
 
 -----------------------------------------------------------------------
 toUserWrite :: NewUser HashPassword -> UserWrite
 toUserWrite (NewUser u m (Auth.PasswordHash p)) = 
-  UserDB (Nothing) (sqlStrictText p)
-         (Nothing) (sqlBool True) (sqlStrictText u)
-         (sqlStrictText "first_name")
-         (sqlStrictText "last_name")
-         (sqlStrictText m)
-         (sqlBool True)
-         (sqlBool True) Nothing
+  UserDB { user_id = Nothing
+         , user_password = sqlStrictText p
+         , user_lastLogin = Nothing
+         , user_isSuperUser = sqlBool True
+         , user_username = sqlStrictText u
+         , user_firstName = sqlStrictText "first_name"
+         , user_lastName = sqlStrictText "last_name"
+         , user_email = sqlStrictText m
+         , user_isStaff = sqlBool True
+         , user_isActive = sqlBool True
+         , user_dateJoined = Nothing
+         , user_forgot_password_uuid = Nothing }
 
 ------------------------------------------------------------------
 getUsersWith :: Username -> Cmd err [UserLight]
@@ -104,6 +120,24 @@ selectUsersLightWith u = proc () -> do
       restrict -< user_username row .== sqlStrictText u
       returnA  -< row
 
+getUsersWithEmail :: Text -> Cmd err [UserLight]
+getUsersWithEmail e = map toUserLight <$> runOpaQuery (selectUsersLightWithEmail e)
+
+selectUsersLightWithEmail :: Text -> Select UserRead
+selectUsersLightWithEmail e = proc () -> do
+      row      <- queryUserTable -< ()
+      restrict -< user_email row .== sqlStrictText e
+      returnA  -< row
+
+getUsersWithForgotPasswordUUID :: UUID.UUID -> Cmd err [UserLight]
+getUsersWithForgotPasswordUUID uuid = map toUserLight <$> runOpaQuery (selectUsersLightWithForgotPasswordUUID uuid)
+
+selectUsersLightWithForgotPasswordUUID :: UUID.UUID -> Select UserRead
+selectUsersLightWithForgotPasswordUUID uuid = proc () -> do
+      row      <- queryUserTable -< ()
+      restrict -< user_forgot_password_uuid row .== sqlStrictText (UUID.toText uuid)
+      returnA  -< row
+
 ----------------------------------------------------------
 getUsersWithId :: Int -> Cmd err [UserLight]
 getUsersWithId i = map toUserLight <$> runOpaQuery (selectUsersLightWithId i)
@@ -158,7 +192,36 @@ 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 { .. }) -> UserDB { user_email = sqlStrictText userLight_email, .. } )
+      , uWhere      = (\row -> user_id row .== (sqlInt4 userLight_id))
+      , uReturning  = rCount }
 
+updateUserPassword :: UserLight -> Cmd err Int64
+updateUserPassword (UserLight { userLight_password = GargPassword password, .. }) = mkCmd $ \c -> runUpdate_ c updateUserQuery
+  where
+    updateUserQuery :: Update Int64
+    updateUserQuery = Update
+      { uTable      = userTable
+      , uUpdateWith = updateEasy (\ (UserDB { .. }) -> UserDB { user_password = sqlStrictText password, .. } )
+      , uWhere      = (\row -> user_id row .== (sqlInt4 userLight_id))
+      , uReturning  = rCount }
+
+updateUserForgotPasswordUUID :: UserLight -> Cmd err Int64
+updateUserForgotPasswordUUID (UserLight { .. }) = mkCmd $ \c -> runUpdate_ c updateUserQuery
+  where
+    pass = sqlStrictText $ fromMaybe "" userLight_forgot_password_uuid
+    updateUserQuery :: Update Int64
+    updateUserQuery = Update
+      { uTable      = userTable
+      , uUpdateWith = updateEasy (\ (UserDB { .. }) -> UserDB { user_forgot_password_uuid = pass, .. })
+      , uWhere      = (\row -> user_id row .== (sqlInt4 userLight_id))
+      , uReturning  = rCount }
 ------------------------------------------------------------------
 -- | Select User with some parameters
 -- Not optimized version