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.Morpheus.Types
   8   ( GQLType
   9   , Resolver
  10   , ResolverM
  11   , QUERY
  12   , lift
  13   )
  14 import Data.Text (Text)
  15 import qualified Data.Text as T
  16 import Gargantext.API.Prelude (GargM, GargError)
  17 import Gargantext.Core.Mail.Types (HasMail)
  18 import Gargantext.Database.Admin.Types.Hyperdata
  19   ( HyperdataUser(..)
  20   , hc_source
  21   , hc_title
  22   , hu_shared)
  23 import Gargantext.Database.Admin.Types.Hyperdata.Contact
  24   ( HyperdataContact
  25   , ContactWho
  26   , ContactWhere
  27   , cw_city
  28   , cw_country
  29   , cw_firstName
  30   , cw_lastName
  31   , cw_labTeamDepts
  32   , cw_office
  33   , cw_organization
  34   , cw_role
  35   , cw_touch
  36   , ct_mail
  37   , ct_phone
  38   , hc_who
  39   , hc_where)
  40 import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
  41 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
  42 import Gargantext.Database.Query.Table.User (getUsersWithHyperdata, getUsersWithNodeHyperdata)
  43 import Gargantext.Database.Schema.User (UserLight(..))
  44 import Gargantext.Database.Schema.Node (node_id, node_hyperdata)
  45 import Gargantext.Prelude
  46 import GHC.Generics (Generic)
  47
  48 data UserInfo = UserInfo
  49   { ui_id             :: Int
  50   , ui_username       :: Text
  51   , ui_email          :: Text
  52   , ui_title          :: Maybe Text
  53   , ui_source         :: Maybe Text
  54   , ui_cwFirstName    :: Maybe Text
  55   , ui_cwLastName     :: Maybe Text
  56   , ui_cwCity         :: Maybe Text
  57   , ui_cwCountry      :: Maybe Text
  58   , ui_cwOrganization :: [Text]
  59   , ui_cwLabTeamDepts :: [Text]
  60   , ui_cwOffice       :: Maybe Text
  61   , ui_cwRole         :: Maybe Text
  62   , ui_cwTouchPhone   :: Maybe Text
  63   , ui_cwTouchMail    :: Maybe Text }
  64   deriving (Generic, GQLType, Show)
  65
  66 -- | Arguments to the "user info" query.
  67 data UserInfoArgs
  68   = UserInfoArgs
  69     { user_id :: Int
  70     } deriving (Generic, GQLType)
  71
  72 -- | Arguments to the "user info" mutation,
  73 data UserInfoMArgs
  74   = UserInfoMArgs
  75     { ui_id             :: Int
  76     , ui_username       :: Maybe Text
  77     , ui_email          :: Maybe Text
  78     , ui_title          :: Maybe Text
  79     , ui_source         :: Maybe Text
  80     , ui_cwFirstName    :: Maybe Text
  81     , ui_cwLastName     :: Maybe Text
  82     , ui_cwCity         :: Maybe Text
  83     , ui_cwCountry      :: Maybe Text
  84     , ui_cwOrganization :: Maybe [Text]
  85     , ui_cwLabTeamDepts :: Maybe [Text]
  86     , ui_cwOffice       :: Maybe Text
  87     , ui_cwRole         :: Maybe Text
  88     , ui_cwTouchPhone   :: Maybe Text
  89     , ui_cwTouchMail    :: Maybe Text
  90     } deriving (Generic, GQLType)
  91
  92 type GqlM e env = Resolver QUERY e (GargM env GargError)
  93
  94 -- | Function to resolve user from a query.
  95 resolveUserInfos
  96   :: (HasConnectionPool env, HasConfig env, HasMail env)
  97   => UserInfoArgs -> GqlM e env [UserInfo]
  98 resolveUserInfos UserInfoArgs { user_id } = dbUsers user_id
  99
 100 -- | Mutation for user info
 101 updateUserInfo
 102   :: (HasConnectionPool env, HasConfig env, HasMail env)
 103   => UserInfoMArgs -> ResolverM e (GargM env GargError) Int
 104 updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
 105   -- lift $ printDebug "[updateUserInfo] ui_id" ui_id
 106   users <- lift (getUsersWithNodeHyperdata ui_id)
 107   case users of
 108     [] -> panic $ "[updateUserInfo] User with id " <> (T.pack $ show ui_id) <> " doesn't exist."
 109     ((_u, node_u):_) -> do
 110       let u_hyperdata = node_u ^. node_hyperdata
 111       -- lift $ printDebug "[updateUserInfo] u" u
 112       let u_hyperdata' = uh ui_titleL ui_title $
 113                          uh ui_sourceL ui_source $
 114                          uh ui_cwFirstNameL ui_cwFirstName $
 115                          uh ui_cwLastNameL ui_cwLastName $
 116                          uh ui_cwCityL ui_cwCity $
 117                          uh ui_cwCountryL ui_cwCountry $
 118                          uh' ui_cwLabTeamDeptsL ui_cwLabTeamDepts $
 119                          uh' ui_cwOrganizationL ui_cwOrganization $
 120                          uh ui_cwOfficeL ui_cwOffice $
 121                          uh ui_cwRoleL ui_cwRole $
 122                          uh ui_cwTouchMailL ui_cwTouchMail $
 123                          uh ui_cwTouchPhoneL ui_cwTouchPhone $
 124                          u_hyperdata
 125       -- lift $ printDebug "[updateUserInfo] with firstName" u_hyperdata'
 126       _ <- lift $ updateHyperdata (node_u ^. node_id) u_hyperdata'
 127       --let _newUser = toUser (u, u_hyperdata')
 128       pure 1
 129   where
 130     uh _ Nothing u_hyperdata = u_hyperdata
 131     uh lens' (Just val) u_hyperdata = u_hyperdata & lens' .~ Just val
 132     uh' _ Nothing u_hyperdata = u_hyperdata
 133     uh' lens' (Just val) u_hyperdata = u_hyperdata & lens' .~ val
 134
 135 -- | Inner function to fetch the user from DB.
 136 dbUsers
 137   :: (HasConnectionPool env, HasConfig env, HasMail env)
 138   => Int -> GqlM e env [UserInfo]
 139 dbUsers user_id = do
 140   -- lift $ printDebug "[dbUsers]" user_id
 141 --  user <- getUsersWithId user_id
 142 --  hyperdata <- getUserHyperdata user_id
 143 --  lift (map toUser <$> zip user hyperdata)
 144   lift (map toUser <$> (getUsersWithHyperdata user_id))
 145
 146 toUser :: (UserLight, HyperdataUser) -> UserInfo
 147 toUser (UserLight { .. }, u_hyperdata) =
 148   UserInfo { ui_id             = userLight_id
 149            , ui_username       = userLight_username
 150            , ui_email          = userLight_email
 151            , ui_title          = u_hyperdata ^. ui_titleL
 152            , ui_source         = u_hyperdata ^. ui_sourceL
 153            , ui_cwFirstName    = u_hyperdata ^. ui_cwFirstNameL
 154            , ui_cwLastName     = u_hyperdata ^. ui_cwLastNameL
 155            , ui_cwCity         = u_hyperdata ^. ui_cwCityL
 156            , ui_cwCountry      = u_hyperdata ^. ui_cwCountryL
 157            , ui_cwLabTeamDepts = u_hyperdata ^. ui_cwLabTeamDeptsL
 158            , ui_cwOrganization = u_hyperdata ^. ui_cwOrganizationL
 159            , ui_cwOffice       = u_hyperdata ^. ui_cwOfficeL
 160            , ui_cwRole         = u_hyperdata ^. ui_cwRoleL
 161            , ui_cwTouchMail    = u_hyperdata ^. ui_cwTouchMailL
 162            , ui_cwTouchPhone   = u_hyperdata ^. ui_cwTouchPhoneL }
 163
 164 sharedL :: Traversal' HyperdataUser HyperdataContact
 165 sharedL = hu_shared . _Just
 166 ui_titleL :: Traversal' HyperdataUser (Maybe Text)
 167 ui_titleL = sharedL . hc_title
 168 ui_sourceL :: Traversal' HyperdataUser (Maybe Text)
 169 ui_sourceL = sharedL . hc_source
 170 contactWhoL :: Traversal' HyperdataUser ContactWho
 171 contactWhoL = sharedL . hc_who . _Just
 172 ui_cwFirstNameL :: Traversal' HyperdataUser (Maybe Text)
 173 ui_cwFirstNameL = contactWhoL . cw_firstName
 174 ui_cwLastNameL :: Traversal' HyperdataUser (Maybe Text)
 175 ui_cwLastNameL = contactWhoL . cw_lastName
 176 contactWhereL :: Traversal' HyperdataUser ContactWhere
 177 contactWhereL = sharedL . hc_where . (ix 0)
 178 ui_cwCityL :: Traversal' HyperdataUser (Maybe Text)
 179 ui_cwCityL = contactWhereL . cw_city
 180 ui_cwCountryL :: Traversal' HyperdataUser (Maybe Text)
 181 ui_cwCountryL = contactWhereL . cw_country
 182 ui_cwLabTeamDeptsL :: Traversal' HyperdataUser [Text]
 183 ui_cwLabTeamDeptsL = hu_shared . _Just . (hc_where . (ix 0) . cw_labTeamDepts)
 184 ui_cwOrganizationL :: Traversal' HyperdataUser [Text]
 185 ui_cwOrganizationL = hu_shared . _Just . (hc_where . (ix 0) . cw_organization)
 186 ui_cwOfficeL :: Traversal' HyperdataUser (Maybe Text)
 187 ui_cwOfficeL = contactWhereL . cw_office
 188 ui_cwRoleL :: Traversal' HyperdataUser (Maybe Text)
 189 ui_cwRoleL = contactWhereL . cw_role
 190 ui_cwTouchMailL :: Traversal' HyperdataUser (Maybe Text)
 191 ui_cwTouchMailL = hu_shared . _Just . (hc_where . (ix 0) . cw_touch . _Just . ct_mail)
 192 --ui_cwTouchMailL = contactWhereL . cw_touch . _Just . ct_mail
 193 ui_cwTouchPhoneL :: Traversal' HyperdataUser (Maybe Text)
 194 ui_cwTouchPhoneL = hu_shared . _Just . (hc_where . (ix 0) . cw_touch . _Just . ct_phone)
 195 --ui_cwTouchPhoneL = contactWhereL . cw_touch . _Just . ct_phone