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.Admin.Types.Node (NodeId(..))
  41 import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
  42 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
  43 import Gargantext.Database.Query.Table.User (getUsersWithHyperdata)
  44 import Gargantext.Database.Schema.User (UserLight(..))
  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 (getUsersWithHyperdata ui_id)
 107   case users of
 108     [] -> panic $ "[updateUserInfo] User with id " <> (T.pack $ show ui_id) <> " doesn't exist."
 109     ((u, u_hyperdata):_) -> do
 110       lift $ printDebug "[updateUserInfo] u" u
 111       let u_hyperdata' = uh ui_titleL ui_title $
 112                          uh ui_sourceL ui_source $
 113                          uh ui_cwFirstNameL ui_cwFirstName $
 114                          uh ui_cwLastNameL ui_cwLastName $
 115                          uh ui_cwCityL ui_cwCity $
 116                          uh ui_cwCountryL ui_cwCountry $
 117                          uh' ui_cwLabTeamDeptsL ui_cwLabTeamDepts $
 118                          uh' ui_cwOrganizationL ui_cwOrganization $
 119                          uh ui_cwOfficeL ui_cwOffice $
 120                          uh ui_cwRoleL ui_cwRole $
 121                          uh ui_cwTouchMailL ui_cwTouchMail $
 122                          uh ui_cwTouchPhoneL ui_cwTouchPhone $
 123                          u_hyperdata
 124       lift $ printDebug "[updateUserInfo] with firstName" u_hyperdata'
 125       _ <- lift $ updateHyperdata (NodeId ui_id) u_hyperdata'
 126       --let _newUser = toUser (u, u_hyperdata')
 127       pure 1
 128   where
 129     uh _ Nothing u_hyperdata = u_hyperdata
 130     uh lens' (Just val) u_hyperdata = u_hyperdata & lens' .~ Just val
 131     uh' _ Nothing u_hyperdata = u_hyperdata
 132     uh' lens' (Just val) u_hyperdata = u_hyperdata & lens' .~ val
 133
 134 -- | Inner function to fetch the user from DB.
 135 dbUsers
 136   :: (HasConnectionPool env, HasConfig env, HasMail env)
 137   => Int -> GqlM e env [UserInfo]
 138 dbUsers user_id = do
 139 --  user <- getUsersWithId user_id
 140 --  hyperdata <- getUserHyperdata user_id
 141 --  lift (map toUser <$> zip user hyperdata)
 142   lift (map toUser <$> (getUsersWithHyperdata user_id))
 143
 144 toUser :: (UserLight, HyperdataUser) -> UserInfo
 145 toUser (UserLight { .. }, u_hyperdata) =
 146   UserInfo { ui_id             = userLight_id
 147            , ui_username       = userLight_username
 148            , ui_email          = userLight_email
 149            , ui_title          = u_hyperdata ^. ui_titleL
 150            , ui_source         = u_hyperdata ^. ui_sourceL
 151            , ui_cwFirstName    = u_hyperdata ^. ui_cwFirstNameL
 152            , ui_cwLastName     = u_hyperdata ^. ui_cwLastNameL
 153            , ui_cwCity         = u_hyperdata ^. ui_cwCityL
 154            , ui_cwCountry      = u_hyperdata ^. ui_cwCountryL
 155            , ui_cwLabTeamDepts = u_hyperdata ^. ui_cwLabTeamDeptsL
 156            , ui_cwOrganization = u_hyperdata ^. ui_cwOrganizationL
 157            , ui_cwOffice       = u_hyperdata ^. ui_cwOfficeL
 158            , ui_cwRole         = u_hyperdata ^. ui_cwRoleL
 159            , ui_cwTouchMail    = u_hyperdata ^. ui_cwTouchMailL
 160            , ui_cwTouchPhone   = u_hyperdata ^. ui_cwTouchPhoneL }
 161
 162 sharedL :: Traversal' HyperdataUser HyperdataContact
 163 sharedL = hu_shared . _Just
 164 ui_titleL :: Traversal' HyperdataUser (Maybe Text)
 165 ui_titleL = sharedL . hc_title
 166 ui_sourceL :: Traversal' HyperdataUser (Maybe Text)
 167 ui_sourceL = sharedL . hc_source
 168 contactWhoL :: Traversal' HyperdataUser ContactWho
 169 contactWhoL = sharedL . hc_who . _Just
 170 ui_cwFirstNameL :: Traversal' HyperdataUser (Maybe Text)
 171 ui_cwFirstNameL = contactWhoL . cw_firstName
 172 ui_cwLastNameL :: Traversal' HyperdataUser (Maybe Text)
 173 ui_cwLastNameL = contactWhoL . cw_lastName
 174 contactWhereL :: Traversal' HyperdataUser ContactWhere
 175 contactWhereL = sharedL . hc_where . (ix 0)
 176 ui_cwCityL :: Traversal' HyperdataUser (Maybe Text)
 177 ui_cwCityL = contactWhereL . cw_city
 178 ui_cwCountryL :: Traversal' HyperdataUser (Maybe Text)
 179 ui_cwCountryL = contactWhereL . cw_country
 180 ui_cwLabTeamDeptsL :: Traversal' HyperdataUser [Text]
 181 ui_cwLabTeamDeptsL = hu_shared . _Just . (hc_where . (ix 0) . cw_labTeamDepts)
 182 ui_cwOrganizationL :: Traversal' HyperdataUser [Text]
 183 ui_cwOrganizationL = hu_shared . _Just . (hc_where . (ix 0) . cw_organization)
 184 ui_cwOfficeL :: Traversal' HyperdataUser (Maybe Text)
 185 ui_cwOfficeL = contactWhereL . cw_office
 186 ui_cwRoleL :: Traversal' HyperdataUser (Maybe Text)
 187 ui_cwRoleL = contactWhereL . cw_role
 188 ui_cwTouchMailL :: Traversal' HyperdataUser (Maybe Text)
 189 ui_cwTouchMailL = hu_shared . _Just . (hc_where . (ix 0) . cw_touch . _Just . ct_mail)
 190 --ui_cwTouchMailL = contactWhereL . cw_touch . _Just . ct_mail
 191 ui_cwTouchPhoneL :: Traversal' HyperdataUser (Maybe Text)
 192 ui_cwTouchPhoneL = hu_shared . _Just . (hc_where . (ix 0) . cw_touch . _Just . ct_phone)
 193 --ui_cwTouchPhoneL = contactWhereL . cw_touch . _Just . ct_phone