[graphql] implement user with hyperdata

src/Gargantext/API/GraphQL.hs

@@ -52,7 +52,7 @@ import Data.Typeable (Typeable)
 import Gargantext.API.GraphQL.User
 import Gargantext.API.Prelude (GargServerT, GargM, GargError)
 import Gargantext.Database.Prelude (Cmd, HasConnectionPool, HasConfig)
-import Gargantext.Database.Schema.User (UserPoly(..), UserLight)
+import Gargantext.Database.Schema.User (UserPoly(..))
 import Gargantext.Prelude
 import GHC.Generics (Generic)
 import GHC.TypeLits
@@ -77,7 +77,7 @@ import Servant
 -- | Represents possible GraphQL queries.
 data Query m
   = Query
-    { users :: UserArgs -> m [UserLight]
+    { users :: UserArgs -> m [User]
     } deriving (Generic, GQLType)
 
 -- | Possible GraphQL Events, i.e. here we describe how we will
@@ -92,7 +92,7 @@ data Channel
 
 -- | This type describes what data we will operate on.
 data Contet
-  = UserContet [UserLight]
+  = UserContet [User]
 
 
 -- | The main GraphQL resolver: how queries, mutations and

src/Gargantext/API/GraphQL/User.hs

@@ -3,35 +3,40 @@
 module Gargantext.API.GraphQL.User where
 
 import Data.Either (Either(..))
-import Data.Maybe (fromMaybe)
 import Data.Morpheus.Types
   ( GQLType
   , ResolverQ
   , liftEither
   )
+import Data.Text (Text)
 import Gargantext.API.Prelude (GargM, GargError)
+import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser(..))
 import Gargantext.Database.Prelude (Cmd, HasConnectionPool, HasConfig)
-import Gargantext.Database.Query.Table.User (getUsersWithId)
-import Gargantext.Database.Schema.User (UserLight)
+import Gargantext.Database.Query.Table.User (getUsersWithId, getUserHyperdata)
+import Gargantext.Database.Schema.User (UserLight(..))
 import Gargantext.Prelude
 import GHC.Generics (Generic)
 import qualified Prelude as Prelude
 
+data User = User
+  { u_email     :: Text
+  , u_hyperdata :: Maybe HyperdataUser
+  , u_id        :: Int
+  , u_username  :: Text }
+  deriving (Show, Generic, GQLType)
 
 -- | Arguments to the "user" query.
 data UserArgs
   = UserArgs
     { user_id :: Int
-    , includeHyperdata :: Maybe Bool
     } deriving (Generic, GQLType)
 
 
 -- | Function to resolve user from a query.
 resolveUsers
   :: (HasConnectionPool env, HasConfig env)
-  => UserArgs -> ResolverQ e (GargM env GargError) [UserLight]
-resolveUsers UserArgs { user_id, includeHyperdata } = do
-  let _hyp = fromMaybe False includeHyperdata
+  => UserArgs -> ResolverQ e (GargM env GargError) [User]
+resolveUsers UserArgs { user_id } = do
   liftEither $ dbUsers user_id
 --  user <- lift $ dbUser user_id
 --  case user of
@@ -40,7 +45,24 @@ resolveUsers UserArgs { user_id, includeHyperdata } = do
 --    Right u -> pure u
 
 -- | Inner function to fetch the user from DB.
-dbUsers :: Int -> Cmd err (Either Prelude.String [UserLight])
+dbUsers :: Int -> Cmd err (Either Prelude.String [User])
 dbUsers user_id = do
   users <- getUsersWithId user_id
-  pure $ Right users
+--  users' <- if includeHyperdata
+--    then mapM injectHyperdata (toUser <$> users)
+--    else (pure $ toUser <$> users)
+  users' <- mapM injectHyperdata $ toUser <$> users
+  pure $ Right users'
+
+toUser :: UserLight -> User
+toUser (UserLight { .. }) = User { u_email = userLight_email
+                                 , u_hyperdata = Nothing
+                                 , u_id = userLight_id
+                                 , u_username = userLight_username }
+
+injectHyperdata :: User -> Cmd err User
+injectHyperdata user@(User { .. }) = do
+  hyperdata <- getUserHyperdata u_id
+  case hyperdata of
+    [] -> pure $ user
+    (h:_) -> pure $ User { u_hyperdata = Just h, .. }

src/Gargantext/Core.hs

@@ -9,14 +9,17 @@ Portability : POSIX
 
 -}
 
+{-# LANGUAGE DeriveAnyClass             #-}
+
 module Gargantext.Core
   where
 
-import Data.Text (Text)
 import Data.Aeson
 import Data.Either(Either(Left))
 import Data.Hashable (Hashable)
+import Data.Morpheus.Types (GQLType)
 import Data.Swagger
+import Data.Text (Text)
 import GHC.Generics (Generic)
 import Gargantext.Prelude
 import Servant.API
@@ -38,7 +41,7 @@ import Servant.API
 -- | All languages supported
 -- TODO : DE | SP | CH
 data Lang = EN | FR | All
-  deriving (Show, Eq, Ord, Bounded, Enum, Generic)
+  deriving (Show, Eq, Ord, Bounded, Enum, Generic, GQLType)
 
 instance ToJSON Lang
 instance FromJSON Lang

src/Gargantext/Database/Admin/Types/Hyperdata/Contact.hs

@@ -9,9 +9,10 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE FunctionalDependencies     #-}
+{-# LANGUAGE DeriveAnyClass             #-}
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE FunctionalDependencies     #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses      #-}
 {-# LANGUAGE NoImplicitPrelude          #-}
@@ -23,11 +24,12 @@ Portability : POSIX
 module Gargantext.Database.Admin.Types.Hyperdata.Contact
   where
 
+import Data.Morpheus.Types (GQLType(..))
 import Data.Time.Segment (jour)
-import Data.Time (UTCTime)
 import Gargantext.Core.Text (HasText(..))
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude
 import Gargantext.Prelude
+import Gargantext.Utils.UTCTime
 
 --------------------------------------------------------------------------------
 data HyperdataContact =
@@ -40,7 +42,7 @@ data HyperdataContact =
                       , _hc_uniqIdBdd       :: Maybe Text
                       , _hc_uniqId          :: Maybe Text
 
-  } deriving (Eq, Show, Generic)
+  } deriving (Eq, Show, Generic, GQLType)
 
 instance HasText HyperdataContact
   where
@@ -87,7 +89,7 @@ data ContactWho =
                 , _cw_lastName    :: Maybe Text
                 , _cw_keywords :: [Text]
                 , _cw_freetags :: [Text]
-  } deriving (Eq, Show, Generic)
+  } deriving (Eq, Show, Generic, GQLType)
 
 type FirstName = Text
 type LastName  = Text
@@ -102,8 +104,6 @@ contactWho fn ln = ContactWho Nothing
                              []
                              []
 
-
-
 data ContactWhere =
      ContactWhere { _cw_organization :: [Text]
                   , _cw_labTeamDepts :: [Text]
@@ -116,9 +116,9 @@ data ContactWhere =
 
                   , _cw_touch        :: Maybe ContactTouch
 
-                  , _cw_entry        :: Maybe UTCTime
-                  , _cw_exit         :: Maybe UTCTime
-  } deriving (Eq, Show, Generic)
+                  , _cw_entry        :: Maybe NUTCTime
+                  , _cw_exit         :: Maybe NUTCTime
+  } deriving (Eq, Show, Generic, GQLType)
 
 defaultContactWhere :: ContactWhere
 defaultContactWhere = ContactWhere ["Organization X"]
@@ -128,14 +128,14 @@ defaultContactWhere = ContactWhere ["Organization X"]
                                  (Just "Country")
                                  (Just "City")
                                  (Just defaultContactTouch)
-                                 (Just $ jour 01 01 2020)
-                                 (Just $ jour 01 01 2029)
+                                 (Just $ NUTCTime $ jour 01 01 2020)
+                                 (Just $ NUTCTime $ jour 01 01 2029)
 
 data ContactTouch =
      ContactTouch { _ct_mail      :: Maybe Text
                   , _ct_phone     :: Maybe Text
                   , _ct_url       :: Maybe Text
-  } deriving (Eq, Show, Generic)
+  } deriving (Eq, Show, Generic, GQLType)
 
 defaultContactTouch :: ContactTouch
 defaultContactTouch = ContactTouch (Just "email@data.com")

src/Gargantext/Database/Admin/Types/Hyperdata/User.hs

@@ -11,6 +11,7 @@ Portability : POSIX
 
 {-# LANGUAGE FunctionalDependencies     #-}
 {-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE DeriveAnyClass             #-}
 {-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses      #-}
@@ -23,6 +24,7 @@ Portability : POSIX
 module Gargantext.Database.Admin.Types.Hyperdata.User
   where
 
+import Data.Morpheus.Types (GQLType)
 import Gargantext.Prelude
 import Gargantext.Core (Lang(..))
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude
@@ -35,19 +37,19 @@ data HyperdataUser =
      HyperdataUser { _hu_private   :: !(Maybe HyperdataPrivate)
                    , _hu_shared    :: !(Maybe HyperdataContact)
                    , _hu_public    :: !(Maybe HyperdataPublic)
-                   } deriving (Eq, Show, Generic)
+                   } deriving (Eq, Show, Generic, GQLType)
 
 data HyperdataPrivate =
      HyperdataPrivate { _hpr_password :: !Text
                       , _hpr_lang     :: !Lang
                       }
-     deriving (Eq, Show, Generic)
+     deriving (Eq, Show, Generic, GQLType)
 
 data HyperdataPublic =
      HyperdataPublic { _hpu_pseudo       :: !Text
                      , _hpu_publications :: ![DocumentId]
                      }
-     deriving (Eq, Show, Generic)
+     deriving (Eq, Show, Generic, GQLType)
 
 -- | Default
 defaultHyperdataUser :: HyperdataUser

src/Gargantext/Database/Admin/Types/Node.hs

@@ -25,6 +25,7 @@ import Data.Aeson
 import Data.Aeson.TH (deriveJSON)
 import Data.Either
 import Data.Hashable (Hashable)
+import Data.Morpheus.Types (GQLType)
 import Data.Swagger
 import Data.Text (Text, unpack)
 import Data.Time (UTCTime)
@@ -152,6 +153,7 @@ pgNodeId = O.sqlInt4 . id2int
 ------------------------------------------------------------------------
 newtype NodeId = NodeId Int
   deriving (Read, Generic, Num, Eq, Ord, Enum, ToJSONKey, FromJSONKey, ToJSON, FromJSON, Hashable)
+instance GQLType NodeId
 instance Show NodeId where
   show (NodeId n) = "nodeId-" <> show n
 instance Serialise NodeId

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

@@ -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
 
@@ -110,6 +114,16 @@ getUsersWithId i = map toUserLight <$> runOpaQuery (selectUsersLightWithId i)
 queryUserTable :: Query UserRead
 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