diff --git a/models/users.model b/models/users.model index 95945d8a8..2d18206b3 100644 --- a/models/users.model +++ b/models/users.model @@ -45,6 +45,8 @@ UserFunction -- Administratively assigned functions (lecturer, admin, evaluation UserSystemFunction user UserId function SystemFunction + manual Bool + isOptOut Bool UniqueUserSystemFunction user function UserExamOffice user UserId diff --git a/src/Auth/LDAP.hs b/src/Auth/LDAP.hs index 9b57c8904..57270e2c6 100644 --- a/src/Auth/LDAP.hs +++ b/src/Auth/LDAP.hs @@ -10,6 +10,7 @@ module Auth.LDAP , ldapUserMatriculation, ldapUserFirstName, ldapUserSurname , ldapUserTitle, ldapUserStudyFeatures, ldapUserFieldName , ldapUserSchoolAssociation, ldapUserSubTermsSemester, ldapSex + , ldapAffiliation ) where import Import.NoFoundation @@ -68,7 +69,7 @@ userSearchSettings LdapConf{..} = mconcat , Ldap.derefAliases Ldap.DerefAlways ] -ldapUserPrincipalName, ldapUserDisplayName, ldapUserMatriculation, ldapUserFirstName, ldapUserSurname, ldapUserTitle, ldapUserStudyFeatures, ldapUserFieldName, ldapUserSchoolAssociation, ldapSex, ldapUserSubTermsSemester :: Ldap.Attr +ldapUserPrincipalName, ldapUserDisplayName, ldapUserMatriculation, ldapUserFirstName, ldapUserSurname, ldapUserTitle, ldapUserStudyFeatures, ldapUserFieldName, ldapUserSchoolAssociation, ldapSex, ldapUserSubTermsSemester, ldapAffiliation :: Ldap.Attr ldapUserPrincipalName = Ldap.Attr "userPrincipalName" ldapUserDisplayName = Ldap.Attr "displayName" ldapUserMatriculation = Ldap.Attr "LMU-Stud-Matrikelnummer" @@ -80,6 +81,7 @@ ldapUserFieldName = Ldap.Attr "LMU-Stg-Fach" ldapUserSchoolAssociation = Ldap.Attr "LMU-IFI-eduPersonOrgUnitDNString" ldapSex = Ldap.Attr "schacGender" ldapUserSubTermsSemester = Ldap.Attr "LMU-Stg-FachundFS" +ldapAffiliation = Ldap.Attr "eduPersonAffiliation" ldapUserEmail :: NonEmpty Ldap.Attr ldapUserEmail = Ldap.Attr "mail" :| diff --git a/src/Foundation/Yesod/Auth.hs b/src/Foundation/Yesod/Auth.hs index 8be3e80b9..12fb36028 100644 --- a/src/Foundation/Yesod/Auth.hs +++ b/src/Foundation/Yesod/Auth.hs @@ -14,6 +14,7 @@ import Foundation.I18n import Handler.Utils.Profile import Handler.Utils.StudyFeatures import Handler.Utils.SchoolLdap +import Handler.Utils.LdapSystemFunctions import Yesod.Auth.Message import Auth.LDAP @@ -22,6 +23,7 @@ import qualified Data.CaseInsensitive as CI import qualified Control.Monad.Catch as C (Handler(..)) import qualified Data.List.NonEmpty as NonEmpty import qualified Ldap.Client as Ldap +import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import qualified Data.ByteString as ByteString import qualified Data.Set as Set @@ -425,6 +427,19 @@ upsertCampusUser plugin ldapData = do forM_ ss $ void . insertUnique . SchoolLdap Nothing + let + userSystemFunctions = determineSystemFunctions . Set.fromList $ map CI.mk userSystemFunctions' + userSystemFunctions' = do + (k, v) <- ldapData + guard $ k == ldapAffiliation + v' <- v + Right str <- return $ Text.decodeUtf8' v' + assertM' (not . Text.null) $ Text.strip str + + iforM_ userSystemFunctions $ \func preset -> if + | preset -> void $ upsert (UserSystemFunction userId func False False) [] + | otherwise -> deleteWhere [UserSystemFunctionUser ==. userId, UserSystemFunctionFunction ==. func, UserSystemFunctionIsOptOut ==. False, UserSystemFunctionManual ==. False] + return user where insertMaybe key val = get key >>= maybe (insert_ val) (\_ -> return ()) diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index 1f64d0da3..b5e8313e9 100644 --- a/src/Handler/Users.hs +++ b/src/Handler/Users.hs @@ -101,6 +101,9 @@ postUsersR = do $forall (E.Value sh) <- schools
  • #{sh} |] + , sortable Nothing (i18nCell MsgUserSystemFunctions) $ \DBRow{ dbrOutput = Entity uid _ } -> + let getFunctions = fmap (map $ userSystemFunctionFunction . entityVal) . liftHandler . runDB $ selectList [ UserSystemFunctionUser ==. uid, UserSystemFunctionIsOptOut ==. False ] [ Asc UserSystemFunctionFunction ] + in listCell' getFunctions i18nCell , sortable Nothing (mempty & cellAttrs <>~ pure ("hide-columns--hider-label", mr MsgActionsHead)) $ \inp@DBRow{ dbrOutput = Entity uid _ } -> FormCell { formCellAttrs = [] , formCellLens = id @@ -289,7 +292,7 @@ postAdminUserR uuid = do E.&&. adminFunction E.^. UserFunctionFunction E.==. E.val SchoolAdmin return (school, userFunction E.?. UserFunctionFunction, isAdmin) - systemFunctionsF <- Set.fromList . map (userSystemFunctionFunction . entityVal) <$> selectList [UserSystemFunctionUser ==. uid] [] + systemFunctionsF <- Set.fromList . map (userSystemFunctionFunction . entityVal) <$> selectList [UserSystemFunctionUser ==. uid, UserSystemFunctionIsOptOut ==. False] [] let systemFunctions = (`Set.member` systemFunctionsF) return ( user @@ -380,9 +383,9 @@ postAdminUserR uuid = do | not $ Set.null symmDiff -> runDBJobs $ do forM_ symmDiff $ \func -> if | newFuncs func - -> void . insertUnique $ UserSystemFunction uid func + -> void $ upsert (UserSystemFunction uid func True False) [ UserSystemFunctionIsOptOut =. False, UserSystemFunctionManual =. True ] | otherwise - -> deleteBy $ UniqueUserSystemFunction uid func + -> void $ upsert (UserSystemFunction uid func True True) [ UserSystemFunctionIsOptOut =. True, UserSystemFunctionManual =. True ] queueDBJob . JobQueueNotification . NotificationUserSystemFunctionsUpdate uid $ setFromFunc systemFunctions addMessageI Success MsgUserSystemFunctionsSaved | otherwise diff --git a/src/Handler/Utils/LdapSystemFunctions.hs b/src/Handler/Utils/LdapSystemFunctions.hs new file mode 100644 index 000000000..c87b3f252 --- /dev/null +++ b/src/Handler/Utils/LdapSystemFunctions.hs @@ -0,0 +1,13 @@ +module Handler.Utils.LdapSystemFunctions + ( determineSystemFunctions + ) where + +import Import.NoFoundation + +import qualified Data.Set as Set + + +determineSystemFunctions :: Set (CI Text) -> (SystemFunction -> Bool) +determineSystemFunctions ldapFuncs = \case + SystemExamOffice -> False + SystemFaculty -> "faculty" `Set.member` ldapFuncs