src/Gargantext/API/GraphQL/User.hs

   1 {-# LANGUAGE DeriveAnyClass #-}
   2
   3 module Gargantext.API.GraphQL.User where
   4
   5 import Data.Maybe (listToMaybe)
   6 import Data.Morpheus.Types
   7   ( GQLType
   8   , Resolver, QUERY
   9   , lift
  10   )
  11 import Data.Text (Text)
  12 import Gargantext.API.Prelude (GargM, GargError)
  13 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser(..))
  14 import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
  15 import Gargantext.Database.Query.Table.User (getUsersWithId, getUserHyperdata)
  16 import Gargantext.Database.Schema.User (UserLight(..))
  17 import Gargantext.Prelude
  18 import GHC.Generics (Generic)
  19
  20 data User m = User
  21   { u_email     :: Text
  22   , u_hyperdata :: m (Maybe HyperdataUser)
  23   , u_id        :: Int
  24   , u_username  :: Text }
  25   deriving (Generic, GQLType)
  26
  27 -- | Arguments to the "user" query.
  28 data UserArgs
  29   = UserArgs
  30     { user_id :: Int
  31     } deriving (Generic, GQLType)
  32
  33 type GqlM e env = Resolver QUERY e (GargM env GargError)
  34
  35 -- | Function to resolve user from a query.
  36 resolveUsers
  37   :: (HasConnectionPool env, HasConfig env)
  38   => UserArgs -> GqlM e env [User (GqlM e env)]
  39 resolveUsers UserArgs { user_id } = dbUsers user_id
  40
  41 -- | Inner function to fetch the user from DB.
  42 dbUsers
  43   :: (HasConnectionPool env, HasConfig env)
  44   => Int -> GqlM e env ([User (GqlM e env)])
  45 dbUsers user_id = lift (map toUser <$> getUsersWithId user_id)
  46
  47 toUser
  48   :: (HasConnectionPool env, HasConfig env)
  49   => UserLight -> User (GqlM e env)
  50 toUser (UserLight { .. }) = User { u_email = userLight_email
  51                                  , u_hyperdata = resolveHyperdata userLight_id
  52                                  , u_id = userLight_id
  53                                  , u_username = userLight_username }
  54
  55 resolveHyperdata
  56   :: (HasConnectionPool env, HasConfig env)
  57   => Int -> GqlM e env (Maybe HyperdataUser)
  58 resolveHyperdata userid = lift (listToMaybe <$> getUserHyperdata userid)