src/Gargantext/API/GraphQL/UserInfo.hs

   1 {-# LANGUAGE DeriveAnyClass #-}
   2 {-# LANGUAGE DuplicateRecordFields #-}
   3
   4 module Gargantext.API.GraphQL.UserInfo where
   5
   6 import Control.Lens
   7 import Data.Maybe (fromMaybe)
   8 import Data.Morpheus.Types
   9   ( GQLType(..)
  10   , typeDirective
  11   , Describe(..)
  12   , Resolver
  13   , ResolverM
  14   , QUERY
  15   , lift
  16   )
  17 import Data.Text (Text)
  18 import qualified Data.Text as T
  19 import Gargantext.API.Prelude (GargM, GargError)
  20 import Gargantext.Database.Admin.Types.Hyperdata
  21   ( HyperdataUser(..)
  22   , hc_source
  23   , hc_title
  24   , hu_shared)
  25 import Gargantext.Database.Admin.Types.Hyperdata.Contact
  26   ( HyperdataContact
  27   , ContactWho
  28   , ContactWhere
  29   , cw_city
  30   , cw_country
  31   , cw_firstName
  32   , cw_lastName
  33   , cw_labTeamDepts
  34   , cw_office
  35   , cw_organization
  36   , cw_role
  37   , cw_touch
  38   , cw_description
  39   , ct_mail
  40   , ct_phone
  41   , hc_who
  42   , hc_where)
  43 import Gargantext.Database.Prelude (CmdCommon)
  44 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
  45 import Gargantext.Database.Query.Table.User (getUsersWithHyperdata, getUsersWithNodeHyperdata, updateUserEmail)
  46 import Gargantext.Database.Schema.User (UserLight(..))
  47 import Gargantext.Database.Schema.Node (node_id, node_hyperdata, NodePoly (Node, _node_id))
  48 import Gargantext.Prelude
  49 import GHC.Generics (Generic)
  50 import Gargantext.API.GraphQL.Utils (AuthStatus(Invalid, Valid), authUser)
  51 import Gargantext.API.Admin.Types (HasSettings)
  52 import qualified Gargantext.Core.Types.Individu as Individu
  53
  54 data UserInfo = UserInfo
  55   { ui_id             :: Int
  56   , ui_username       :: Text
  57   , ui_email          :: Text
  58   , ui_title          :: Maybe Text
  59   , ui_source         :: Maybe Text
  60   , ui_cwFirstName    :: Maybe Text
  61   , ui_cwLastName     :: Maybe Text
  62   , ui_cwCity         :: Maybe Text
  63   , ui_cwCountry      :: Maybe Text
  64   , ui_cwOrganization :: [Text]
  65   , ui_cwLabTeamDepts :: [Text]
  66   , ui_cwOffice       :: Maybe Text
  67   , ui_cwRole         :: Maybe Text
  68   , ui_cwTouchPhone   :: Maybe Text
  69   , ui_cwTouchMail    :: Maybe Text  -- TODO: Remove. userLight_email should be used instead
  70   , ui_cwDescription  :: Maybe Text
  71   }
  72   deriving (Generic, Show)
  73 instance GQLType UserInfo where
  74   directives _ = typeDirective (Describe "some text")
  75
  76 -- | Arguments to the "user info" query.
  77 data UserInfoArgs
  78   = UserInfoArgs
  79     { user_id :: Int
  80     } deriving (Generic, GQLType)
  81
  82 -- | Arguments to the "user info" mutation,
  83 data UserInfoMArgs
  84   = UserInfoMArgs
  85     { ui_id             :: Int
  86     , token             :: Text
  87     , ui_username       :: Maybe Text
  88     , ui_email          :: Maybe Text
  89     , ui_title          :: Maybe Text
  90     , ui_source         :: Maybe Text
  91     , ui_cwFirstName    :: Maybe Text
  92     , ui_cwLastName     :: Maybe Text
  93     , ui_cwCity         :: Maybe Text
  94     , ui_cwCountry      :: Maybe Text
  95     , ui_cwOrganization :: Maybe [Text]
  96     , ui_cwLabTeamDepts :: Maybe [Text]
  97     , ui_cwOffice       :: Maybe Text
  98     , ui_cwRole         :: Maybe Text
  99     , ui_cwTouchPhone   :: Maybe Text
 100     , ui_cwTouchMail    :: Maybe Text
 101     , ui_cwDescription  :: Maybe Text
 102     } deriving (Generic, GQLType)
 103
 104 type GqlM e env = Resolver QUERY e (GargM env GargError)
 105 type GqlM' e env err = ResolverM e (GargM env err) Int
 106
 107 -- | Function to resolve user from a query.
 108 resolveUserInfos
 109   :: (CmdCommon env)
 110   => UserInfoArgs -> GqlM e env [UserInfo]
 111 resolveUserInfos UserInfoArgs { user_id } = dbUsers user_id
 112
 113 -- | Mutation for user info
 114 updateUserInfo
 115   :: (CmdCommon env, HasSettings env)
 116   -- => UserInfoMArgs -> ResolverM e (GargM env err) Int
 117   => UserInfoMArgs -> GqlM' e env err
 118 updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
 119   -- lift $ printDebug "[updateUserInfo] ui_id" ui_id
 120   users <- lift (getUsersWithNodeHyperdata (Individu.UserDBId ui_id))
 121   case users of
 122     [] -> panic $ "[updateUserInfo] User with id " <> (T.pack $ show ui_id) <> " doesn't exist."
 123     ((UserLight { .. }, node_u):_) -> do
 124       testAuthUser <- lift $ authUser (nId node_u) token
 125       case testAuthUser of
 126         Invalid -> panic "[updateUserInfo] failed to validate user"
 127         Valid -> do
 128           let u_hyperdata = node_u ^. node_hyperdata
 129           -- lift $ printDebug "[updateUserInfo] u" u
 130           let u_hyperdata' = uh ui_titleL ui_title $
 131                             uh ui_sourceL ui_source $
 132                             uh ui_cwFirstNameL ui_cwFirstName $
 133                             uh ui_cwLastNameL ui_cwLastName $
 134                             uh ui_cwCityL ui_cwCity $
 135                             uh ui_cwCountryL ui_cwCountry $
 136                             uh' ui_cwLabTeamDeptsL ui_cwLabTeamDepts $
 137                             uh' ui_cwOrganizationL ui_cwOrganization $
 138                             uh ui_cwOfficeL ui_cwOffice $
 139                             uh ui_cwRoleL ui_cwRole $
 140                             uh ui_cwTouchMailL ui_cwTouchMail $
 141                             uh ui_cwTouchPhoneL ui_cwTouchPhone $
 142                             uh ui_cwDescriptionL ui_cwDescription
 143                             u_hyperdata
 144           -- NOTE: We have 1 username and 2 emails: userLight_email and ui_cwTouchMail
 145           -- The userLight_email is more important: it is used for login and sending mail.
 146           -- Therefore we update ui_cwTouchMail and userLight_email.
 147           -- ui_cwTouchMail is to be removed in the future.
 148           let u' = UserLight { userLight_email = fromMaybe userLight_email $ view ui_cwTouchMailL u_hyperdata'
 149                              , .. }
 150           -- lift $ printDebug "[updateUserInfo] with firstName" u_hyperdata'
 151           _ <- lift $ updateHyperdata (node_u ^. node_id) u_hyperdata'
 152           _ <- lift $ updateUserEmail u'
 153           --let _newUser = toUser (u, u_hyperdata')
 154           pure 1
 155   where
 156     uh _ Nothing u_hyperdata = u_hyperdata
 157     uh lens' (Just val) u_hyperdata = u_hyperdata & lens' ?~ val
 158     uh' _ Nothing u_hyperdata = u_hyperdata
 159     uh' lens' (Just val) u_hyperdata = u_hyperdata & lens' .~ val
 160     nId Node {_node_id} = _node_id
 161
 162 -- | Inner function to fetch the user from DB.
 163 dbUsers
 164   :: (CmdCommon env)
 165   => Int -> GqlM e env [UserInfo]
 166 dbUsers user_id = do
 167   -- lift $ printDebug "[dbUsers]" user_id
 168 --  user <- getUsersWithId user_id
 169 --  hyperdata <- getUserHyperdata user_id
 170 --  lift (map toUser <$> zip user hyperdata)
 171   lift (map toUser <$> getUsersWithHyperdata (Individu.UserDBId user_id))
 172
 173 toUser :: (UserLight, HyperdataUser) -> UserInfo
 174 toUser (UserLight { .. }, u_hyperdata) =
 175   UserInfo { ui_id             = userLight_id
 176            , ui_username       = userLight_username
 177            , ui_email          = userLight_email
 178            , ui_title          = u_hyperdata ^. ui_titleL
 179            , ui_source         = u_hyperdata ^. ui_sourceL
 180            , ui_cwFirstName    = u_hyperdata ^. ui_cwFirstNameL
 181            , ui_cwLastName     = u_hyperdata ^. ui_cwLastNameL
 182            , ui_cwCity         = u_hyperdata ^. ui_cwCityL
 183            , ui_cwCountry      = u_hyperdata ^. ui_cwCountryL
 184            , ui_cwLabTeamDepts = u_hyperdata ^. ui_cwLabTeamDeptsL
 185            , ui_cwOrganization = u_hyperdata ^. ui_cwOrganizationL
 186            , ui_cwOffice       = u_hyperdata ^. ui_cwOfficeL
 187            , ui_cwRole         = u_hyperdata ^. ui_cwRoleL
 188            --, ui_cwTouchMail    = u_hyperdata ^. ui_cwTouchMailL
 189            , ui_cwTouchMail    = Just userLight_email
 190            , ui_cwTouchPhone   = u_hyperdata ^. ui_cwTouchPhoneL
 191            , ui_cwDescription  = u_hyperdata ^. ui_cwDescriptionL }
 192
 193 sharedL :: Traversal' HyperdataUser HyperdataContact
 194 sharedL = hu_shared . _Just
 195 ui_titleL :: Traversal' HyperdataUser (Maybe Text)
 196 ui_titleL = sharedL . hc_title
 197 ui_sourceL :: Traversal' HyperdataUser (Maybe Text)
 198 ui_sourceL = sharedL . hc_source
 199 contactWhoL :: Traversal' HyperdataUser ContactWho
 200 contactWhoL = sharedL . hc_who . _Just
 201 ui_cwFirstNameL :: Traversal' HyperdataUser (Maybe Text)
 202 ui_cwFirstNameL = contactWhoL . cw_firstName
 203 ui_cwLastNameL :: Traversal' HyperdataUser (Maybe Text)
 204 ui_cwLastNameL = contactWhoL . cw_lastName
 205 contactWhereL :: Traversal' HyperdataUser ContactWhere
 206 contactWhereL = sharedL . hc_where . (ix 0)
 207 ui_cwCityL :: Traversal' HyperdataUser (Maybe Text)
 208 ui_cwCityL = contactWhereL . cw_city
 209 ui_cwCountryL :: Traversal' HyperdataUser (Maybe Text)
 210 ui_cwCountryL = contactWhereL . cw_country
 211 ui_cwLabTeamDeptsL :: Traversal' HyperdataUser [Text]
 212 ui_cwLabTeamDeptsL = hu_shared . _Just . (hc_where . (ix 0) . cw_labTeamDepts)
 213 ui_cwOrganizationL :: Traversal' HyperdataUser [Text]
 214 ui_cwOrganizationL = hu_shared . _Just . (hc_where . (ix 0) . cw_organization)
 215 ui_cwOfficeL :: Traversal' HyperdataUser (Maybe Text)
 216 ui_cwOfficeL = contactWhereL . cw_office
 217 ui_cwRoleL :: Traversal' HyperdataUser (Maybe Text)
 218 ui_cwRoleL = contactWhereL . cw_role
 219 ui_cwTouchMailL :: Traversal' HyperdataUser (Maybe Text)
 220 ui_cwTouchMailL = hu_shared . _Just . (hc_where . (ix 0) . cw_touch . _Just . ct_mail)
 221 --ui_cwTouchMailL = contactWhereL . cw_touch . _Just . ct_mail
 222 ui_cwTouchPhoneL :: Traversal' HyperdataUser (Maybe Text)
 223 ui_cwTouchPhoneL = hu_shared . _Just . (hc_where . (ix 0) . cw_touch . _Just . ct_phone)
 224 --ui_cwTouchPhoneL = contactWhereL . cw_touch . _Just . ct_phone
 225 ui_cwDescriptionL :: Traversal' HyperdataUser (Maybe Text)
 226 ui_cwDescriptionL = contactWhoL . cw_description