[REFACT] SocialList (WIP)
[gargantext.git] / src / Gargantext / Database / Query / Table / User.hs
index 4a3acc6abca79afdc1a9aa05ff483695048c9141..cd548a59e38b82f3c901358c8d2874d5a1df75a2 100644 (file)
@@ -20,6 +20,8 @@ Functions to deal with users, database side.
 module Gargantext.Database.Query.Table.User
   ( insertUsers
   , toUserWrite
+  , deleteUsers
+  , updateUserDB
   , queryUserTable
   , getUser
   , insertUsersDemo
@@ -28,14 +30,13 @@ module Gargantext.Database.Query.Table.User
   , userWithId
   , userLightWithId
   , getUsersWith
+  , getUsersWithId
   , module Gargantext.Database.Schema.User
   )
   where
 
 import Control.Arrow (returnA)
-import Data.Eq(Eq(..))
 import Data.List (find)
-import Data.Maybe (Maybe)
 import Data.Text (Text)
 import Data.Time (UTCTime)
 import Gargantext.Core.Types.Individu
@@ -52,6 +53,26 @@ insertUsers us = mkCmd $ \c -> runInsert_ c insert
   where
     insert = Insert userTable us rCount Nothing
 
+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)) = 
@@ -73,6 +94,19 @@ selectUsersLightWith u = proc () -> do
       restrict -< user_username row .== pgStrictText u
       returnA  -< row
 
+----------------------------------------------------------
+
+getUsersWithId :: Int -> Cmd err [UserLight]
+getUsersWithId i = map toUserLight <$> runOpaQuery (selectUsersLightWithId i)
+  where
+    selectUsersLightWithId :: Int -> Query UserRead
+    selectUsersLightWithId i = proc () -> do
+          row      <- queryUserTable -< ()
+          restrict -< user_id row .== pgInt4 i
+          returnA  -< row
+
+
+
 queryUserTable :: Query UserRead
 queryUserTable = queryTable userTable