src/Gargantext/API/GraphQL/User.hs

   1 {-# LANGUAGE DeriveAnyClass #-}
   2 {-# LANGUAGE DuplicateRecordFields #-}
   3
   4 module Gargantext.API.GraphQL.User where
   5
   6 import Data.Maybe (listToMaybe)
   7 import Data.Morpheus.Types
   8   ( GQLType
   9   , Resolver, ResolverM, QUERY
  10   , lift
  11   )
  12 import Data.Text (Text)
  13 import Gargantext.API.Admin.Types (HasSettings)
  14 import Gargantext.API.Prelude (GargM, GargError)
  15 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser(..))
  16 import Gargantext.Database.Admin.Types.Node (NodeId(..))
  17 import Gargantext.Database.Prelude (CmdCommon)
  18 import qualified Gargantext.Database.Query.Table.User as DBUser
  19 import Gargantext.Database.Schema.User (UserLight(..))
  20 import Gargantext.Prelude
  21 import GHC.Generics (Generic)
  22 import qualified Gargantext.Core.Types.Individu as Individu
  23
  24 data User m = User
  25   { u_email     :: Text
  26   , u_hyperdata :: m (Maybe HyperdataUser)
  27   , u_id        :: Int
  28   , u_username  :: Text }
  29   deriving (Generic, GQLType)
  30
  31 -- | Arguments to the "user" query.
  32 data UserArgs
  33   = UserArgs
  34     { user_id :: Int
  35     } deriving (Generic, GQLType)
  36
  37 data UserPubmedAPIKeyMArgs
  38   = UserPubmedAPIKeyMArgs
  39     { user_id :: Int
  40     , api_key  :: Text }
  41     deriving (Generic, GQLType)
  42
  43 type GqlM e env = Resolver QUERY e (GargM env GargError)
  44 type GqlM' e env a = ResolverM e (GargM env GargError) a
  45
  46 -- | Function to resolve user from a query.
  47 resolveUsers
  48   :: (CmdCommon env)
  49   => UserArgs -> GqlM e env [User (GqlM e env)]
  50 resolveUsers UserArgs { user_id } = dbUsers user_id
  51
  52 -- | Inner function to fetch the user from DB.
  53 dbUsers
  54   :: (CmdCommon env)
  55   => Int -> GqlM e env [User (GqlM e env)]
  56 dbUsers user_id = lift (map toUser <$> DBUser.getUsersWithId (Individu.RootId $ NodeId user_id))
  57
  58 toUser
  59   :: (CmdCommon env)
  60   => UserLight -> User (GqlM e env)
  61 toUser (UserLight { .. }) = User { u_email = userLight_email
  62                                  , u_hyperdata = resolveHyperdata userLight_id
  63                                  , u_id = userLight_id
  64                                  , u_username = userLight_username }
  65
  66 resolveHyperdata
  67   :: (CmdCommon env)
  68   => Int -> GqlM e env (Maybe HyperdataUser)
  69 resolveHyperdata userid = lift (listToMaybe <$> DBUser.getUserHyperdata (Individu.UserDBId userid))
  70
  71 updateUserPubmedAPIKey :: ( CmdCommon env, HasSettings env) =>
  72                           UserPubmedAPIKeyMArgs -> GqlM' e env Int
  73 updateUserPubmedAPIKey UserPubmedAPIKeyMArgs { user_id, api_key } = do
  74   _ <- lift $ DBUser.updateUserPubmedAPIKey (Individu.RootId $ NodeId user_id) api_key
  75
  76   pure 1