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