From 739ee85db26239e19f458fba0fd45efe8f353d23 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 7 Dec 2021 17:12:53 +0100 Subject: [PATCH] chore(ldap): wip remove add ldap keys --- models/users.model | 7 ++- src/Auth/LDAP.hs | 36 +++++++----- src/Foundation/Yesod/Auth.hs | 66 +++++++++++----------- src/Handler/Utils/StudyFeatures.hs | 5 +- src/Handler/Utils/StudyFeatures/Parse.hs | 71 ------------------------ 5 files changed, 60 insertions(+), 125 deletions(-) delete mode 100644 src/Handler/Utils/StudyFeatures/Parse.hs diff --git a/models/users.model b/models/users.model index 28e336f8e..0960f9d57 100644 --- a/models/users.model +++ b/models/users.model @@ -19,7 +19,7 @@ User json -- Each Uni2work user has a corresponding row in this table; create lastLdapSynchronisation UTCTime Maybe ldapPrimaryKey Text Maybe tokensIssuedAfter UTCTime Maybe -- do not accept bearer tokens issued before this time (accept all tokens if null) - matrikelnummer UserMatriculation Maybe -- optional immatriculation-string; usually a number, but not always (e.g. lecturers, pupils, guests,...) + matrikelnummer UserMatriculation Maybe -- usually a number; AVS Personalnummer; nicht Fraport Personalnummer! firstName Text -- For export in tables, pre-split firstName from displayName title Text Maybe -- For upcoming name customisation maxFavourites Int default=12 -- max number of non-manual entries in favourites bar (pruned only if below a set importance threshold) @@ -35,6 +35,10 @@ User json -- Each Uni2work user has a corresponding row in this table; create csvOptions CsvOptions "default='{}'::jsonb" sex Sex Maybe showSex Bool default=false + telephone Text Maybe + mobile Text Maybe + companyPersonalNumber Text Maybe -- Company will become a new table, but if company=fraport, some information is received via LDAP + companyDepartment Text Maybe -- thus we store such information for ease of reference directly, if available UniqueAuthentication ident -- Column 'ident' can be used as a row-key in this table UniqueEmail email -- Column 'email' can be used as a row-key in this table deriving Show Eq Ord Generic -- Haskell-specific settings for runtime-value representing a row in memory @@ -63,7 +67,6 @@ UserSchool -- Managed by users themselves, encodes "schools of interest" isOptOut Bool -- true if this a marker, that the user manually deleted this entry; it should not be recreated automatically UniqueUserSchool user school deriving Generic - UserGroupMember group UserGroupName user UserId diff --git a/src/Auth/LDAP.hs b/src/Auth/LDAP.hs index 6d6db7bce..4d2d18492 100644 --- a/src/Auth/LDAP.hs +++ b/src/Auth/LDAP.hs @@ -7,11 +7,11 @@ module Auth.LDAP , campusUserReTest, campusUserReTest' , campusUserMatr, campusUserMatr' , CampusMessage(..) + , ldapPrimaryKey , ldapUserPrincipalName, ldapUserEmail, ldapUserDisplayName - , ldapUserMatriculation, ldapUserFirstName, ldapUserSurname - , ldapUserTitle, ldapUserStudyFeatures, ldapUserFieldName - , ldapUserSchoolAssociation, ldapUserSubTermsSemester, ldapSex - , ldapAffiliation, ldapPrimaryKey + , ldapUserFirstName, ldapUserSurname + , ldapUserMobile, ldapUserTelephone + , ldapUserFraportPersonalnummer, ldapUserFraportAbteilung ) where import Import.NoFoundation @@ -47,21 +47,20 @@ findUser conf@LdapConf{..} ldap ident retAttrs = fromMaybe [] <$> findM (assertM where userFilters = [ ldapUserPrincipalName Ldap.:= Text.encodeUtf8 ident - , ldapUserPrincipalName Ldap.:= Text.encodeUtf8 [st|#{ident}@campus.lmu.de|] + , ldapUserPrincipalName Ldap.:= Text.encodeUtf8 [st|#{ident}@fraport.de|] ] ++ [ ldapUserEmail' Ldap.:= Text.encodeUtf8 ident' - | ident' <- [ident, [st|#{ident}@lmu.de|], [st|#{ident}@campus.lmu.de|]] + | ident' <- [ident, [st|#{ident}@lmu.de|], [st|#{ident}@fraport.de|]] , ldapUserEmail' <- toList ldapUserEmail ] ++ [ ldapUserDisplayName Ldap.:= Text.encodeUtf8 ident - , ldapUserMatriculation Ldap.:= Text.encodeUtf8 ident ] findUserMatr :: LdapConf -> Ldap -> Text -> [Ldap.Attr] -> IO [Ldap.SearchEntry] findUserMatr conf@LdapConf{..} ldap userMatr retAttrs = fromMaybe [] <$> findM (assertM (not . null) . lift . flip (Ldap.search ldap ldapBase $ userSearchSettings conf) retAttrs) userFilters where userFilters = - [ ldapUserMatriculation Ldap.:= Text.encodeUtf8 userMatr + [ ldapUserFraportPersonalnummer Ldap.:= Text.encodeUtf8 userMatr ] userSearchSettings :: LdapConf -> Ldap.Mod Ldap.Search @@ -72,24 +71,35 @@ userSearchSettings LdapConf{..} = mconcat , Ldap.derefAliases Ldap.DerefAlways ] -ldapUserPrincipalName, ldapUserDisplayName, ldapUserMatriculation, ldapUserFirstName, ldapUserSurname, ldapUserTitle, ldapUserStudyFeatures, ldapUserFieldName, ldapUserSchoolAssociation, ldapSex, ldapUserSubTermsSemester, ldapAffiliation, ldapPrimaryKey :: Ldap.Attr +ldapPrimaryKey, ldapUserPrincipalName, ldapUserDisplayName, ldapUserFirstName, ldapUserSurname, ldapUserMobile, ldapUserTelephone, ldapUserFraportPersonalnummer, ldapUserFraportAbteilung :: Ldap.Attr +ldapPrimaryKey = Ldap.Attr "cn" -- should always be identical to "sAMAccountName" ldapUserPrincipalName = Ldap.Attr "userPrincipalName" ldapUserDisplayName = Ldap.Attr "displayName" -ldapUserMatriculation = Ldap.Attr "LMU-Stud-Matrikelnummer" ldapUserFirstName = Ldap.Attr "givenName" ldapUserSurname = Ldap.Attr "sn" +-- new +ldapUserTelephone = Ldap.Attr "telephoneNumber" +ldapUserMobile = Ldap.Attr "mobile" +ldapUserFraportPersonalnummer = Ldap.Attr "sAMAccountName" +ldapUserFraportAbteilung = Ldap.Attr "Department" + +{- +Maybe keep: -- ldapAffiliation +-- outdated to be removed +ldapUserMatriculation = Ldap.Attr "LMU-Stud-Matrikelnummer" ldapUserTitle = Ldap.Attr "title" ldapUserStudyFeatures = Ldap.Attr "dfnEduPersonFeaturesOfStudy" 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" -ldapPrimaryKey = Ldap.Attr "eduPersonPrincipalName" +ldapAffiliation = Ldap.Attr "eduPersonAffiliation" -- was used to determin user function, i.e. rights + +-} ldapUserEmail :: NonEmpty Ldap.Attr ldapUserEmail = Ldap.Attr "mail" :| - [ Ldap.Attr "name" + [ Ldap.Attr "userPrincipalName" ] diff --git a/src/Foundation/Yesod/Auth.hs b/src/Foundation/Yesod/Auth.hs index 29c77c654..4a642998b 100644 --- a/src/Foundation/Yesod/Auth.hs +++ b/src/Foundation/Yesod/Auth.hs @@ -158,20 +158,22 @@ upsertCampusUser upsertMode ldapData = do now <- liftIO getCurrentTime UserDefaultConf{..} <- getsYesod $ view _appUserDefaults - let - userIdent'' = fold [ v | (k, v) <- ldapData, k == ldapUserPrincipalName ] - userMatrikelnummer' = fold [ v | (k, v) <- ldapData, k == ldapUserMatriculation ] - userLdapPrimaryKey' = fold [ v | (k, v) <- ldapData, k == ldapPrimaryKey ] + let userEmail' = fold $ do k' <- toList ldapUserEmail (k, v) <- ldapData guard $ k' == k return v + -- SJ says: this highly repetitive code needs fefactoring; why not turn ldapData into a Data.Map right away instead of repetitive list iteration? + userLdapPrimaryKey' = fold [ v | (k, v) <- ldapData, k == ldapPrimaryKey ] + userIdent'' = fold [ v | (k, v) <- ldapData, k == ldapUserPrincipalName ] userDisplayName'' = fold [ v | (k, v) <- ldapData, k == ldapUserDisplayName ] userFirstName' = fold [ v | (k, v) <- ldapData, k == ldapUserFirstName ] userSurname' = fold [ v | (k, v) <- ldapData, k == ldapUserSurname ] - userTitle' = fold [ v | (k, v) <- ldapData, k == ldapUserTitle ] - userSex' = fold [ v | (k, v) <- ldapData, k == ldapSex ] + userTelephone' = fold [ v | (k, v) <- ldapData, k == ldapUserTelephone ] + userMobile' = fold [ v | (k, v) <- ldapData, k == ldapUserMobile ] + userFraportPersonalnummer' = fold [ v | (k, v) <- ldapData, k == ldapUserFraportPersonalnummer ] + userFraportAbteilung' = fold [ v | (k, v) <- ldapData, k == ldapUserFraportAbteilung ] userAuthentication | is _UpsertCampusUserLoginOther upsertMode @@ -212,32 +214,31 @@ upsertCampusUser upsertMode ldapData = do -> return userSurname | otherwise -> throwM CampusUserInvalidSurname - userTitle <- if - | all ByteString.null userTitle' + userTelephone <- if + | [bs] <- userTelephone' + , Right userTelephone <- Text.decodeUtf8' bs + -> return userTelephone + | otherwise -> return Nothing - | [bs] <- userTitle' - , Right userTitle <- Text.decodeUtf8' bs - -> return $ Just userTitle + userMobile <- if + | [bs] <- userMobile' + , Right userMobile <- Text.decodeUtf8' bs + -> return $ Just userMobile | otherwise - -> throwM CampusUserInvalidTitle - userMatrikelnummer <- if - | [bs] <- userMatrikelnummer' - , Right userMatrikelnummer <- Text.decodeUtf8' bs - -> return $ Just userMatrikelnummer - | [] <- userMatrikelnummer' -> return Nothing + userCompanyPersonalNumber <- if + | [bs] <- userFraportPersonalnummer' + , Right dt <- Text.decodeUtf8' bs + -> return $ Just dt | otherwise - -> throwM CampusUserInvalidMatriculation - userSex <- if - | [bs] <- userSex' - , Right userSex'' <- Text.decodeUtf8' bs - , Just userSex''' <- readMay userSex'' - , Just userSex <- userSex''' ^? iso5218 - -> return $ Just userSex - | [] <- userSex' - -> return Nothing + -> return Nothing + userCompanyDepartment <- if + | [bs] <- userFraportAbteilung' + , Right dt <- Text.decodeUtf8' bs + -> return $ Just dt | otherwise - -> throwM CampusUserInvalidSex + -> return Nothing + userLdapPrimaryKey <- if | [bs] <- userLdapPrimaryKey' , Right userLdapPrimaryKey'' <- Text.decodeUtf8' bs @@ -257,6 +258,7 @@ upsertCampusUser upsertMode ldapData = do , userDownloadFiles = userDefaultDownloadFiles , userWarningDays = userDefaultWarningDays , userShowSex = userDefaultShowSex + , userSex = Nothing , userNotificationSettings = def , userLanguages = Nothing , userCsvOptions = def @@ -265,6 +267,8 @@ upsertCampusUser upsertMode ldapData = do , userLastLdapSynchronisation = Just now , userDisplayName = userDisplayName' , userDisplayEmail = userEmail + , userMatrikelnummer = Nothing -- not known from LDAP, must be derived from REST interface to AVS TODO + , userTitle = Nothing , .. } userUpdate = [ UserMatrikelnummer =. userMatrikelnummer @@ -288,14 +292,6 @@ upsertCampusUser upsertMode ldapData = do update userId [ UserDisplayName =. userDisplayName' ] let - userStudyFeatures = fmap concat . forM userStudyFeatures' $ parseStudyFeatures userId now - userStudyFeatures' = do - (k, v) <- ldapData - guard $ k == ldapUserStudyFeatures - v' <- v - Right str <- return $ Text.decodeUtf8' v' - return str - termNames = nubOrdOn CI.mk $ do (k, v) <- ldapData guard $ k == ldapUserFieldName diff --git a/src/Handler/Utils/StudyFeatures.hs b/src/Handler/Utils/StudyFeatures.hs index ef0d0a2e6..992334b2c 100644 --- a/src/Handler/Utils/StudyFeatures.hs +++ b/src/Handler/Utils/StudyFeatures.hs @@ -1,6 +1,5 @@ module Handler.Utils.StudyFeatures - ( module Handler.Utils.StudyFeatures.Parse - , UserTableStudyFeature(..) + ( UserTableStudyFeature(..) , _userTableField, _userTableDegree, _userTableSemester, _userTableFieldType , UserTableStudyFeatures(..) , _UserTableStudyFeatures @@ -18,8 +17,6 @@ import Foundation.I18n import Utils.Term -import Handler.Utils.StudyFeatures.Parse - import qualified Data.Csv as Csv import qualified Data.Set as Set diff --git a/src/Handler/Utils/StudyFeatures/Parse.hs b/src/Handler/Utils/StudyFeatures/Parse.hs deleted file mode 100644 index 516dd1b95..000000000 --- a/src/Handler/Utils/StudyFeatures/Parse.hs +++ /dev/null @@ -1,71 +0,0 @@ -module Handler.Utils.StudyFeatures.Parse - ( parseStudyFeatures - , parseSubTermsSemester - ) where - -import Import.NoFoundation hiding (try, (<|>)) - -import Text.Parsec -import Text.Parsec.Text - -import Auth.LDAP (ldapUserSubTermsSemester, ldapUserStudyFeatures) -import qualified Ldap.Client as Ldap - - -parseStudyFeatures :: UserId -> UTCTime -> Text -> Either ParseError [StudyFeatures] -parseStudyFeatures uId now = parse (pStudyFeatures uId now <* eof) (unpack key) - where - Ldap.Attr key = ldapUserStudyFeatures - -parseSubTermsSemester :: Text -> Either ParseError (StudyTermsId, Int) -parseSubTermsSemester = parse (pLMUTermsSemester <* eof) (unpack key) - where - Ldap.Attr key = ldapUserSubTermsSemester - - -pStudyFeatures :: UserId -> UTCTime -> Parser [StudyFeatures] -pStudyFeatures studyFeaturesUser now = do - studyFeaturesDegree <- StudyDegreeKey' <$> pKey - void $ string "$$" - - let - pStudyFeature = do - _ <- pKey -- "Fächergruppe" - void $ char '!' - _ <- pKey -- "Studienbereich" - void $ char '!' - studyFeaturesField <- StudyTermsKey' <$> pKey - void $ char '!' - studyFeaturesType <- pType - void $ char '!' - studyFeaturesSemester <- decimal - let studyFeaturesValid = True - studyFeaturesSuperField = Nothing - studyFeaturesFirstObserved = Just now - studyFeaturesLastObserved = now - studyFeaturesRelevanceCached = Nothing - return StudyFeatures{..} - - pStudyFeature `sepBy1` char '#' - -pKey :: Parser Int -pKey = decimal - -pType :: Parser StudyFieldType -pType = FieldPrimary <$ try (string "HF") - <|> FieldSecondary <$ try (string "NF") - -decimal :: Parser Int -decimal = foldl' (\now next -> now * 10 + next) 0 <$> many1 digit' - where - digit' = dVal <$> digit - dVal c = fromEnum c - fromEnum '0' - - -pLMUTermsSemester :: Parser (StudyTermsId, Int) -pLMUTermsSemester = do - subTermsKey <- StudyTermsKey' <$> pKey - void $ char '$' - semester <- decimal - - return (subTermsKey, semester)