[graphql] README updated, some refactoring
[gargantext.git] / src / Gargantext / Database / Query / Table / User.hs
index c8d62ba658132ce32002eedc18ff515e4f878be5..8fcd53c3ee5c5261bebaa7a01a6e9a8a2a67e7f6 100644 (file)
@@ -10,7 +10,7 @@ Portability : POSIX
 Functions to deal with users, database side.
 -}
 
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+
 {-# OPTIONS_GHC -fno-warn-orphans        #-}
 
 {-# LANGUAGE TemplateHaskell             #-}
@@ -23,6 +23,7 @@ module Gargantext.Database.Query.Table.User
   , deleteUsers
   , updateUserDB
   , queryUserTable
+  , getUserHyperdata
   , getUser
   , insertNewUsers
   , selectUsersLightWith
@@ -36,13 +37,16 @@ module Gargantext.Database.Query.Table.User
   where
 
 import Control.Arrow (returnA)
+import Control.Lens ((^.))
 import Data.List (find)
 import Data.Text (Text)
 import Data.Time (UTCTime)
 import Gargantext.Core.Types.Individu
 import qualified Gargantext.Prelude.Crypto.Auth as Auth
-import Gargantext.Database.Schema.User
+import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser)
 import Gargantext.Database.Prelude
+import Gargantext.Database.Schema.Node (node_hyperdata, node_id, queryNodeTable)
+import Gargantext.Database.Schema.User
 import Gargantext.Prelude
 import Opaleye
 
@@ -54,15 +58,17 @@ insertUsers us = mkCmd $ \c -> runInsert_ c insert
     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))
+deleteUsers us = mkCmd $ \c -> runDelete_ c
+                       $ Delete userTable
+                                (\user -> in_ (map sqlStrictText us) (user_username user))
+                                rCount
 
 -- 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
+    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
@@ -71,16 +77,16 @@ updateUserDB us = mkCmd $ \c -> runUpdate_ c (updateUserQuery us)
       , uReturning  = rCount
       }
         where
-          UserDB _ p' _ _ un' _ _ em' _ _ _ = us
+          UserDB _ p' _ _ un' _ _ em' _ _ _ = us'
 
 -----------------------------------------------------------------------
 toUserWrite :: NewUser HashPassword -> UserWrite
 toUserWrite (NewUser u m (Auth.PasswordHash p)) = 
-  UserDB (Nothing) (pgStrictText p)
-         (Nothing) (pgBool True) (pgStrictText u)
-         (pgStrictText "first_name")
-         (pgStrictText "last_name")
-         (pgStrictText m)
+  UserDB (Nothing) (sqlStrictText p)
+         (Nothing) (pgBool True) (sqlStrictText u)
+         (sqlStrictText "first_name")
+         (sqlStrictText "last_name")
+         (sqlStrictText m)
          (pgBool True)
          (pgBool True) Nothing
 
@@ -91,25 +97,33 @@ getUsersWith u = map toUserLight <$> runOpaQuery (selectUsersLightWith u)
 selectUsersLightWith :: Username -> Query UserRead
 selectUsersLightWith u = proc () -> do
       row      <- queryUserTable -< ()
-      restrict -< user_username row .== pgStrictText u
+      restrict -< user_username row .== sqlStrictText u
       returnA  -< row
 
 ----------------------------------------------------------
-
 getUsersWithId :: Int -> Cmd err [UserLight]
 getUsersWithId i = map toUserLight <$> runOpaQuery (selectUsersLightWithId i)
   where
     selectUsersLightWithId :: Int -> Query UserRead
-    selectUsersLightWithId i = proc () -> do
+    selectUsersLightWithId i' = proc () -> do
           row      <- queryUserTable -< ()
-          restrict -< user_id row .== pgInt4 i
+          restrict -< user_id row .== sqlInt4 i'
           returnA  -< row
 
 
-
 queryUserTable :: Query UserRead
-queryUserTable = queryTable userTable
+queryUserTable = selectTable userTable
 
+----------------------------------------------------------------------
+getUserHyperdata :: Int -> Cmd err [HyperdataUser]
+getUserHyperdata i = do
+  runOpaQuery (selectUserHyperdataWithId i)
+  where
+    selectUserHyperdataWithId :: Int -> Query (Column PGJsonb)
+    selectUserHyperdataWithId i' = proc () -> do
+      row      <- queryNodeTable -< ()
+      restrict -< row^.node_id .== (sqlInt4 i')
+      returnA  -< row^.node_hyperdata
 ------------------------------------------------------------------
 -- | Select User with some parameters
 -- Not optimized version
@@ -128,7 +142,6 @@ userLightWithUsername t xs = userWith userLight_username t xs
 
 userLightWithId :: Int -> [UserLight] -> Maybe UserLight
 userLightWithId t xs = userWith userLight_id t xs
-
 ----------------------------------------------------------------------
 users :: Cmd err [UserDB]
 users = runOpaQuery queryUserTable
@@ -139,13 +152,12 @@ usersLight = map toUserLight <$> users
 getUser :: Username -> Cmd err (Maybe UserLight)
 getUser u = userLightWithUsername u <$> usersLight
 
-
 ----------------------------------------------------------------------
 insertNewUsers :: [NewUser GargPassword] -> Cmd err Int64
 insertNewUsers newUsers = do
-  users <- liftBase $ mapM toUserHash newUsers
-  insertUsers $ map toUserWrite users
+  users' <- liftBase $ mapM toUserHash newUsers
+  insertUsers $ map toUserWrite users'
 
 ----------------------------------------------------------------------
-instance QueryRunnerColumnDefault PGTimestamptz (Maybe UTCTime) where
-  queryRunnerColumnDefault = fieldQueryRunnerColumn
+instance DefaultFromField PGTimestamptz (Maybe UTCTime) where
+  defaultFromField = fieldQueryRunnerColumn