[MERGE] graphql backend route for annuaire-contact

gargantext.cabal

-cabal-version: 0.0.5.8.8.1
+cabal-version: 1.12
 
 -- This file has been generated from package.yaml by hpack version 0.34.4.
 --
 -- see: https://github.com/sol/hpack
 
 name:           gargantext
-version: 0.0.5.8.8.1
+version:        0.0.5.8.8.1
 synopsis:       Search, map, share
 description:    Please see README.md
 category:       Data
@@ -106,6 +106,7 @@ library
       Gargantext.API.EKG
       Gargantext.API.Flow
       Gargantext.API.GraphQL
+      Gargantext.API.GraphQL.Annuaire
       Gargantext.API.GraphQL.AsyncTask
       Gargantext.API.GraphQL.IMT
       Gargantext.API.GraphQL.Node

src/Gargantext/API/GraphQL.hs

@@ -33,6 +33,7 @@ import Data.Proxy
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog)
 import Gargantext.API.Prelude (HasJobEnv')
+import qualified Gargantext.API.GraphQL.Annuaire as GQLA
 import qualified Gargantext.API.GraphQL.AsyncTask as GQLAT
 import qualified Gargantext.API.GraphQL.IMT as GQLIMT
 import qualified Gargantext.API.GraphQL.Node as GQLNode
@@ -64,7 +65,8 @@ import Gargantext.API.Admin.Types (HasSettings)
 -- | Represents possible GraphQL queries.
 data Query m
   = Query
-    { imt_schools :: GQLIMT.SchoolsArgs -> m [GQLIMT.School]
+    { annuaire_contacts :: GQLA.AnnuaireContactArgs -> m [GQLA.AnnuaireContact]
+    , imt_schools :: GQLIMT.SchoolsArgs -> m [GQLIMT.School]
     , job_logs    :: GQLAT.JobLogArgs -> m (Map Int JobLog)
     , nodes       :: GQLNode.NodeArgs -> m [GQLNode.Node]
     , node_parent :: GQLNode.NodeParentArgs -> m [GQLNode.Node]
@@ -100,13 +102,14 @@ rootResolver
   => RootResolver (GargM env GargError) e Query Mutation Undefined
 rootResolver =
   RootResolver
-    { queryResolver = Query { imt_schools = GQLIMT.resolveSchools
-                            , job_logs    = GQLAT.resolveJobLogs
-                            , nodes       = GQLNode.resolveNodes
-                            , node_parent = GQLNode.resolveNodeParent
-                            , user_infos  = GQLUserInfo.resolveUserInfos
-                            , users       = GQLUser.resolveUsers
-                            , tree        = GQLTree.resolveTree }
+    { queryResolver = Query { annuaire_contacts = GQLA.resolveAnnuaireContacts
+                            , imt_schools       = GQLIMT.resolveSchools
+                            , job_logs          = GQLAT.resolveJobLogs
+                            , nodes             = GQLNode.resolveNodes
+                            , node_parent       = GQLNode.resolveNodeParent
+                            , user_infos        = GQLUserInfo.resolveUserInfos
+                            , users             = GQLUser.resolveUsers
+                            , tree              = GQLTree.resolveTree }
     , mutationResolver = Mutation { update_user_info = GQLUserInfo.updateUserInfo }
     , subscriptionResolver = Undefined }
 

src/Gargantext/API/GraphQL/Annuaire.hs

+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+
+module Gargantext.API.GraphQL.Annuaire where
+
+import Control.Lens
+import Data.Morpheus.Types
+  ( GQLType
+  , Resolver
+  , QUERY
+  , lift
+  )
+import Data.Proxy
+import Data.Text (Text)
+import Gargantext.API.Prelude (GargM, GargError)
+import Gargantext.Core.Mail.Types (HasMail)
+import Gargantext.Database.Admin.Types.Hyperdata.Contact
+  ( HyperdataContact
+  , ContactWho
+  , cw_firstName
+  , cw_lastName
+  , hc_who)
+import Gargantext.Database.Admin.Types.Node (NodeId(..))
+import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
+import Gargantext.Database.Query.Table.Context (getContextWith)
+import Gargantext.Database.Schema.Node (node_hyperdata)
+import Gargantext.Prelude
+import GHC.Generics (Generic)
+
+data AnnuaireContact = AnnuaireContact
+  { ac_id        :: Int
+  , ac_firstName :: Maybe Text
+  , ac_lastName  :: Maybe Text
+  }
+  deriving (Generic, GQLType, Show)
+
+-- | Arguments to the "user info" query.
+data AnnuaireContactArgs
+  = AnnuaireContactArgs
+    { contact_id :: Int
+    } deriving (Generic, GQLType)
+
+type GqlM e env = Resolver QUERY e (GargM env GargError)
+
+-- | Function to resolve user from a query.
+resolveAnnuaireContacts
+  :: (HasConnectionPool env, HasConfig env, HasMail env)
+  => AnnuaireContactArgs -> GqlM e env [AnnuaireContact]
+resolveAnnuaireContacts AnnuaireContactArgs { contact_id } = dbAnnuaireContacts contact_id
+
+-- | Inner function to fetch the user from DB.
+dbAnnuaireContacts
+  :: (HasConnectionPool env, HasConfig env, HasMail env)
+  => Int -> GqlM e env [AnnuaireContact]
+dbAnnuaireContacts contact_id = do
+  -- lift $ printDebug "[dbUsers]" user_id
+--  user <- getUsersWithId user_id
+--  hyperdata <- getUserHyperdata user_id
+--  lift (map toUser <$> zip user hyperdata)
+  c <- lift $ getContextWith (NodeId contact_id) (Proxy :: Proxy HyperdataContact)
+  pure [toAnnuaireContact (contact_id, c ^. node_hyperdata)]
+
+toAnnuaireContact :: (Int, HyperdataContact) -> AnnuaireContact
+toAnnuaireContact (c_id, c_hyperdata) =
+  AnnuaireContact { ac_id = c_id
+                  , ac_firstName = c_hyperdata ^. ac_firstNameL
+                  , ac_lastName = c_hyperdata ^. ac_lastNameL }
+
+contactWhoL :: Traversal' HyperdataContact ContactWho
+contactWhoL = hc_who . _Just
+ac_firstNameL :: Traversal' HyperdataContact (Maybe Text)
+ac_firstNameL = contactWhoL . cw_firstName
+ac_lastNameL :: Traversal' HyperdataContact (Maybe Text)
+ac_lastNameL = contactWhoL . cw_lastName
+