chore(ldap): wip remove add ldap keys
This commit is contained in:
Steffen Jost
parent
1c5dc74edf
commit
739ee85db2
@ -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
|
||||
|
||||
@ -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"
|
||||
]
|
||||
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
Reference in New Issue
Block a user