refactor(ldap): completed refactoring, userDisplayName no longer contains a comma
This commit is contained in:
Steffen Jost
parent
00ab9af2a9
commit
5f65e68b26
@ -157,29 +157,34 @@ upsertCampusUser upsertMode ldapData = do
|
||||
UserDefaultConf{..} <- getsYesod $ view _appUserDefaults
|
||||
|
||||
let
|
||||
ldapMap :: Map.Map Ldap.Attr [Ldap.AttrValue]
|
||||
ldapMap :: Map.Map Ldap.Attr [Ldap.AttrValue] -- Recall: Ldap.AttrValue == ByteString
|
||||
ldapMap = Map.fromListWith (++) $ ldapData <&> second (filter (not . ByteString.null))
|
||||
userEmail' :: [Ldap.AttrValue]
|
||||
userEmail' = lookupSome ldapMap $ toList ldapUserEmail
|
||||
userLdapPrimaryKey' :: [Ldap.AttrValue] -- ~ [ByteString]
|
||||
userLdapPrimaryKey' = ldapMap !!! ldapPrimaryKey
|
||||
userIdent'' = ldapMap !!! ldapUserPrincipalName
|
||||
userDisplayName'' = ldapMap !!! ldapUserDisplayName
|
||||
-- userFirstName' = ldapMap !!! ldapUserFirstName
|
||||
userSurname' = ldapMap !!! ldapUserSurname
|
||||
userTitle' = ldapMap !!! ldapUserTitle
|
||||
userTelephone' = ldapMap !!! ldapUserTelephone
|
||||
userMobile' = ldapMap !!! ldapUserMobile
|
||||
userFraportPersonalnummer' = ldapMap !!! ldapUserFraportPersonalnummer
|
||||
userFraportAbteilung' = ldapMap !!! ldapUserFraportAbteilung
|
||||
|
||||
-- TODO: continue here
|
||||
-- decodeLdap1 :: (Exception e) => Ldap.Attr -> e -> m Text
|
||||
-- only accept a single result, throw error otherwise
|
||||
-- decodeLdap1 :: (MonadThrow m, Exception e) => Ldap.Attr -> e -> m Text
|
||||
decodeLdap1 attr err
|
||||
| [bs] <- ldapMap !!! attr
|
||||
, Right t <- Text.decodeUtf8' bs
|
||||
= return t
|
||||
| otherwise = throwM err
|
||||
| otherwise = throwM err
|
||||
|
||||
-- accept any successful decoding or empty; only throw an error if all decodings fail
|
||||
-- decodeLdap' :: (Exception e) => Ldap.Attr -> e -> m Text
|
||||
decodeLdap' attr err
|
||||
| [] <- vs = return Nothing
|
||||
| (h:_) <- rights vs = return $ Just h
|
||||
| otherwise = throwM err
|
||||
where
|
||||
vs = Text.decodeUtf8' <$> ldapMap !!! attr
|
||||
|
||||
-- just returns Nothing on error, pure
|
||||
decodeLdap :: Ldap.Attr -> Maybe Text
|
||||
decodeLdap attr = listToMaybe . rights $ Text.decodeUtf8' <$> ldapMap !!! attr
|
||||
|
||||
userTelephone = decodeLdap ldapUserTelephone
|
||||
userMobile = decodeLdap ldapUserMobile
|
||||
userCompanyPersonalNumber = decodeLdap ldapUserFraportPersonalnummer
|
||||
userCompanyDepartment = decodeLdap ldapUserFraportAbteilung
|
||||
|
||||
userAuthentication
|
||||
| is _UpsertCampusUserLoginOther upsertMode
|
||||
@ -189,7 +194,7 @@ upsertCampusUser upsertMode ldapData = do
|
||||
isLogin = has (_UpsertCampusUserLoginLdap <> _UpsertCampusUserLoginOther . united) upsertMode
|
||||
|
||||
userIdent <- if
|
||||
| [bs] <- userIdent''
|
||||
| [bs] <- ldapMap !!! ldapUserPrincipalName
|
||||
, Right userIdent' <- CI.mk <$> Text.decodeUtf8' bs
|
||||
, hasn't _upsertCampusUserIdent upsertMode || has (_upsertCampusUserIdent . only userIdent') upsertMode
|
||||
-> return userIdent'
|
||||
@ -197,66 +202,21 @@ upsertCampusUser upsertMode ldapData = do
|
||||
-> return userIdent'
|
||||
| otherwise
|
||||
-> throwM CampusUserInvalidIdent
|
||||
|
||||
userEmail <- if
|
||||
| userEmail : _ <- mapMaybe (assertM (elem '@') . either (const Nothing) Just . Text.decodeUtf8') userEmail'
|
||||
| userEmail : _ <- mapMaybe (assertM (elem '@') . either (const Nothing) Just . Text.decodeUtf8') (lookupSome ldapMap $ toList ldapUserEmail)
|
||||
-> return $ CI.mk userEmail
|
||||
| otherwise
|
||||
-> throwM CampusUserInvalidEmail
|
||||
userFirstName <- decodeLdap1 ldapUserFirstName CampusUserInvalidGivenName
|
||||
--userFirstName <- if
|
||||
-- | [bs] <- userFirstName'
|
||||
-- , Right userFirstName <- Text.decodeUtf8' bs
|
||||
-- -> return userFirstName
|
||||
-- | otherwise
|
||||
-- -> throwM CampusUserInvalidGivenName
|
||||
userSurname <- if
|
||||
| [bs] <- userSurname'
|
||||
, Right userSurname <- Text.decodeUtf8' bs
|
||||
-> return userSurname
|
||||
| otherwise
|
||||
-> throwM CampusUserInvalidSurname
|
||||
userTitle <- if
|
||||
| [] <- userTitle'
|
||||
-> return Nothing
|
||||
| [bs] <- userTitle'
|
||||
, Right userTitle <- Text.decodeUtf8' bs
|
||||
-> return $ Just userTitle
|
||||
| otherwise
|
||||
-> throwM CampusUserInvalidTitle
|
||||
userDisplayName' <- if
|
||||
| [bs] <- userDisplayName''
|
||||
, Right userDisplayName1 <- Text.decodeUtf8' bs
|
||||
, Just userDisplayName2 <- checkDisplayName userTitle userFirstName userSurname userDisplayName1
|
||||
-> return userDisplayName2
|
||||
| otherwise
|
||||
-> throwM CampusUserInvalidDisplayName
|
||||
userTelephone <- if
|
||||
| [bs] <- userTelephone'
|
||||
, Right userTelephone <- Text.decodeUtf8' bs
|
||||
-> return $ Just userTelephone
|
||||
| otherwise
|
||||
-> return Nothing
|
||||
userMobile <- if
|
||||
| [bs] <- userMobile'
|
||||
, Right userMobile <- Text.decodeUtf8' bs
|
||||
-> return $ Just userMobile
|
||||
| otherwise
|
||||
-> return Nothing
|
||||
userCompanyPersonalNumber <- if
|
||||
| [bs] <- userFraportPersonalnummer'
|
||||
, Right dt <- Text.decodeUtf8' bs
|
||||
-> return $ Just dt
|
||||
| otherwise
|
||||
-> return Nothing
|
||||
userCompanyDepartment <- if
|
||||
| [bs] <- userFraportAbteilung'
|
||||
, Right dt <- Text.decodeUtf8' bs
|
||||
-> return $ Just dt
|
||||
| otherwise
|
||||
-> return Nothing
|
||||
userSurname <- decodeLdap1 ldapUserSurname CampusUserInvalidSurname
|
||||
userTitle <- decodeLdap' ldapUserTitle CampusUserInvalidTitle
|
||||
|
||||
userDisplayName' <- decodeLdap1 ldapUserDisplayName CampusUserInvalidDisplayName >>=
|
||||
(maybeThrow CampusUserInvalidDisplayName . checkDisplayName userTitle userFirstName userSurname)
|
||||
|
||||
userLdapPrimaryKey <- if
|
||||
| [bs] <- userLdapPrimaryKey'
|
||||
| [bs] <- ldapMap !!! ldapPrimaryKey
|
||||
, Right userLdapPrimaryKey'' <- Text.decodeUtf8' bs
|
||||
, Just userLdapPrimaryKey''' <- assertM' (not . Text.null) $ Text.strip userLdapPrimaryKey''
|
||||
-> return $ Just userLdapPrimaryKey'''
|
||||
@ -265,33 +225,33 @@ upsertCampusUser upsertMode ldapData = do
|
||||
|
||||
let
|
||||
newUser = User
|
||||
{ userMaxFavourites = userDefaultMaxFavourites
|
||||
, userMaxFavouriteTerms = userDefaultMaxFavouriteTerms
|
||||
, userTheme = userDefaultTheme
|
||||
, userDateTimeFormat = userDefaultDateTimeFormat
|
||||
, userDateFormat = userDefaultDateFormat
|
||||
, userTimeFormat = userDefaultTimeFormat
|
||||
, userDownloadFiles = userDefaultDownloadFiles
|
||||
, userWarningDays = userDefaultWarningDays
|
||||
, userShowSex = userDefaultShowSex
|
||||
, userSex = Nothing
|
||||
, userExamOfficeGetSynced = userDefaultExamOfficeGetSynced
|
||||
, userExamOfficeGetLabels = userDefaultExamOfficeGetLabels
|
||||
, userNotificationSettings = def
|
||||
, userLanguages = Nothing
|
||||
, userCsvOptions = def
|
||||
, userTokensIssuedAfter = Nothing
|
||||
, userCreated = now
|
||||
, userLastLdapSynchronisation = Just now
|
||||
, userDisplayName = userDisplayName'
|
||||
, userDisplayEmail = userEmail
|
||||
, userMatrikelnummer = Nothing -- not known from LDAP, must be derived from REST interface to AVS TODO
|
||||
, userPostAddress = Nothing -- not known from LDAP, must be derived from REST interface to AVS TODO
|
||||
, userPrefersPostal = False
|
||||
{ userMaxFavourites = userDefaultMaxFavourites
|
||||
, userMaxFavouriteTerms = userDefaultMaxFavouriteTerms
|
||||
, userTheme = userDefaultTheme
|
||||
, userDateTimeFormat = userDefaultDateTimeFormat
|
||||
, userDateFormat = userDefaultDateFormat
|
||||
, userTimeFormat = userDefaultTimeFormat
|
||||
, userDownloadFiles = userDefaultDownloadFiles
|
||||
, userWarningDays = userDefaultWarningDays
|
||||
, userShowSex = userDefaultShowSex
|
||||
, userSex = Nothing
|
||||
, userExamOfficeGetSynced = userDefaultExamOfficeGetSynced
|
||||
, userExamOfficeGetLabels = userDefaultExamOfficeGetLabels
|
||||
, userNotificationSettings = def
|
||||
, userLanguages = Nothing
|
||||
, userCsvOptions = def
|
||||
, userTokensIssuedAfter = Nothing
|
||||
, userCreated = now
|
||||
, userLastLdapSynchronisation = Just now
|
||||
, userDisplayName = userDisplayName'
|
||||
, userDisplayEmail = userEmail
|
||||
, userMatrikelnummer = Nothing -- not known from LDAP, must be derived from REST interface to AVS TODO
|
||||
, userPostAddress = Nothing -- not known from LDAP, must be derived from REST interface to AVS TODO
|
||||
, userPrefersPostal = False
|
||||
, ..
|
||||
}
|
||||
userUpdate = [
|
||||
-- UserDisplayName =. userDisplayName -- never updated, since users are allowed to change their DisplayName
|
||||
-- UserDisplayName =. userDisplayName -- not updated here, since users are allowed to change their DisplayName; see line 272
|
||||
UserFirstName =. userFirstName
|
||||
, UserSurname =. userSurname
|
||||
, UserEmail =. userEmail
|
||||
@ -309,7 +269,7 @@ upsertCampusUser upsertMode ldapData = do
|
||||
user@(Entity userId userRec) <- case oldUsers of
|
||||
Just [oldUserId] -> updateGetEntity oldUserId userUpdate
|
||||
_other -> upsertBy (UniqueAuthentication userIdent) newUser userUpdate
|
||||
unless (validDisplayName Nothing userFirstName userSurname $ userDisplayName userRec) $
|
||||
unless (validDisplayName userTitle userFirstName userSurname $ userDisplayName userRec) $
|
||||
update userId [ UserDisplayName =. userDisplayName' ]
|
||||
|
||||
let
|
||||
|
||||
Loading…
Reference in New Issue
Block a user