From facfece7b566cb6a2aeb4bf88bf0bb5930c67e8a Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Fri, 10 Dec 2021 16:25:35 +0100 Subject: [PATCH] chore(ldap): change fild complete --- .../uniworx/categories/user/de-de-formal.msg | 4 ++ messages/uniworx/categories/user/en-eu.msg | 4 ++ routes | 1 - src/Auth/LDAP.hs | 3 +- src/Foundation/Yesod/Auth.hs | 43 ++++++++----------- src/Handler/Admin.hs | 1 - src/Handler/Users/Add.hs | 16 ++++++- src/Handler/Utils/SchoolLdap.hs | 2 +- 8 files changed, 44 insertions(+), 30 deletions(-) diff --git a/messages/uniworx/categories/user/de-de-formal.msg b/messages/uniworx/categories/user/de-de-formal.msg index 919f49587..923097b7c 100644 --- a/messages/uniworx/categories/user/de-de-formal.msg +++ b/messages/uniworx/categories/user/de-de-formal.msg @@ -8,6 +8,10 @@ AdminUserIdent: Identifikation AdminUserAuth: Authentifizierung AdminUserMatriculation: Matrikelnummer AdminUserSex: Geschlecht +AdminUserTelephone: Telefonnummer +AdminUserMobile: Mobiltelefonmummer +AdminUserFPersonalNumber: Personalnummer (nur Fraport AG) +AdminUserFDepartment: Abteilung AdminUserAssimilate: Benutzer assimilieren UserAdded: Benutzer erfolgreich angelegt UserCollision: Benutzer konnte wegen Eindeutigkeit nicht angelegt werden diff --git a/messages/uniworx/categories/user/en-eu.msg b/messages/uniworx/categories/user/en-eu.msg index 09bccc500..bd21fc1c6 100644 --- a/messages/uniworx/categories/user/en-eu.msg +++ b/messages/uniworx/categories/user/en-eu.msg @@ -8,6 +8,10 @@ AdminUserIdent: Identification AdminUserAuth: Authentication AdminUserMatriculation: Matriculation AdminUserSex: Sex +AdminUserTelephone: Phone +AdminUserMobile: Mobile +AdminUserFPersonalNumber: Personalnumber (Fraport AG only) +AdminUserFDepartment: Department AdminUserAssimilate: Assimilate user UserAdded: Successfully added user UserCollision: Could not create user due to uniqueness constraint diff --git a/routes b/routes index 40f7529bc..019712a6c 100644 --- a/routes +++ b/routes @@ -54,7 +54,6 @@ !/users/functionary-invite AdminFunctionaryInviteR GET POST !/users/add AdminUserAddR GET POST /admin AdminR GET -/admin/features AdminFeaturesR GET POST /admin/test AdminTestR GET POST /admin/errMsg AdminErrMsgR GET POST /admin/tokens AdminTokensR GET POST diff --git a/src/Auth/LDAP.hs b/src/Auth/LDAP.hs index a18dbc1b6..f0f30bd7a 100644 --- a/src/Auth/LDAP.hs +++ b/src/Auth/LDAP.hs @@ -10,6 +10,7 @@ module Auth.LDAP , ldapPrimaryKey , ldapUserPrincipalName, ldapUserEmail, ldapUserDisplayName , ldapUserFirstName, ldapUserSurname + , ldapAffiliation , ldapUserMobile, ldapUserTelephone , ldapUserFraportPersonalnummer, ldapUserFraportAbteilung ) where @@ -71,7 +72,7 @@ userSearchSettings LdapConf{..} = mconcat , Ldap.derefAliases Ldap.DerefAlways ] -ldapPrimaryKey, ldapUserPrincipalName, ldapUserDisplayName, ldapUserFirstName, ldapUserSurname, ldapUserMobile, ldapUserTelephone, ldapUserFraportPersonalnummer, ldapUserFraportAbteilung :: Ldap.Attr +ldapPrimaryKey, ldapUserPrincipalName, ldapUserDisplayName, ldapUserFirstName, ldapUserSurname, ldapAffiliation, ldapUserMobile, ldapUserTelephone, ldapUserFraportPersonalnummer, ldapUserFraportAbteilung :: Ldap.Attr ldapPrimaryKey = Ldap.Attr "cn" -- should always be identical to "sAMAccountName" ldapUserPrincipalName = Ldap.Attr "userPrincipalName" ldapUserDisplayName = Ldap.Attr "displayName" diff --git a/src/Foundation/Yesod/Auth.hs b/src/Foundation/Yesod/Auth.hs index 88e7d9473..b9d920751 100644 --- a/src/Foundation/Yesod/Auth.hs +++ b/src/Foundation/Yesod/Auth.hs @@ -12,8 +12,7 @@ import Foundation.Types import Foundation.I18n import Handler.Utils.Profile -import Handler.Utils.StudyFeatures -import Handler.Utils.SchoolLdap +-- import Handler.Utils.SchoolLdap -- Delete this module? import Handler.Utils.LdapSystemFunctions import Handler.Utils.Memcached import Foundation.Authorization (AuthorizationCacheKey(..)) @@ -28,21 +27,21 @@ import qualified Control.Monad.Catch as C (Handler(..)) 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.ByteString as ByteString import qualified Data.Set as Set -import qualified Data.Conduit.Combinators as C +-- import qualified Data.Conduit.Combinators as C -import qualified Data.List as List ((\\)) +-- import qualified Data.List as List ((\\)) -import qualified Data.UUID as UUID -import Data.ByteArray (convert) -import Crypto.Hash (SHAKE128) -import qualified Data.Binary as Binary +-- import qualified Data.UUID as UUID +-- import Data.ByteArray (convert) +-- import Crypto.Hash (SHAKE128) +-- import qualified Data.Binary as Binary -import qualified Database.Esqueleto.Legacy as E -import qualified Database.Esqueleto.Utils as E +-- import qualified Database.Esqueleto.Legacy as E +-- import qualified Database.Esqueleto.Utils as E -import Crypto.Hash.Conduit (sinkHash) +-- import Crypto.Hash.Conduit (sinkHash) authenticate :: ( MonadHandler m, HandlerSite m ~ UniWorX @@ -217,7 +216,7 @@ upsertCampusUser upsertMode ldapData = do userTelephone <- if | [bs] <- userTelephone' , Right userTelephone <- Text.decodeUtf8' bs - -> return userTelephone + -> return $ Just userTelephone | otherwise -> return Nothing userMobile <- if @@ -271,13 +270,11 @@ upsertCampusUser upsertMode ldapData = do , userTitle = Nothing , .. } - userUpdate = [ UserMatrikelnummer =. userMatrikelnummer - -- , UserDisplayName =. userDisplayName - , UserFirstName =. userFirstName - , UserSurname =. userSurname - , UserTitle =. userTitle - , UserEmail =. userEmail - , UserSex =. userSex + userUpdate = [ + -- UserDisplayName =. userDisplayName + UserFirstName =. userFirstName + , UserSurname =. userSurname + , UserEmail =. userEmail , UserLastLdapSynchronisation =. Just now , UserLdapPrimaryKey =. userLdapPrimaryKey ] ++ @@ -288,7 +285,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 userTitle userFirstName userSurname $ userDisplayName userRec) $ + unless (validDisplayName Nothing userFirstName userSurname $ userDisplayName userRec) $ update userId [ UserDisplayName =. userDisplayName' ] let @@ -305,9 +302,7 @@ upsertCampusUser upsertMode ldapData = do 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 ()) + return user associateUserSchoolsByTerms :: MonadIO m => UserId -> SqlPersistT m () associateUserSchoolsByTerms uid = do diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 18be649b1..9752d878b 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -6,7 +6,6 @@ import Import import Handler.Admin.Test as Handler.Admin import Handler.Admin.ErrorMessage as Handler.Admin -import Handler.Admin.StudyFeatures as Handler.Admin import Handler.Admin.Tokens as Handler.Admin import Handler.Admin.Crontab as Handler.Admin diff --git a/src/Handler/Users/Add.hs b/src/Handler/Users/Add.hs index 01196e7ec..3ef62f811 100644 --- a/src/Handler/Users/Add.hs +++ b/src/Handler/Users/Add.hs @@ -19,9 +19,13 @@ data AdminUserForm = AdminUserForm , aufDisplayEmail :: UserEmail , aufMatriculation :: Maybe UserMatriculation , aufSex :: Maybe Sex + , aufMobile :: Maybe Text + , aufTelephone :: Maybe Text + , aufFPersonalNumber :: Maybe Text + , aufFDepartment :: Maybe Text , aufEmail :: UserEmail , aufIdent :: UserIdent - , aufAuth :: AuthenticationKind + , aufAuth :: AuthenticationKind } data AuthenticationKind = AuthKindLDAP | AuthKindPWHash @@ -49,6 +53,10 @@ adminUserForm template = renderAForm FormStandard <*> areq (emailField & cfCI) (fslI MsgAdminUserDisplayEmail) (aufDisplayEmail <$> template) <*> aopt (textField & cfStrip) (fslI MsgAdminUserMatriculation) (aufMatriculation <$> template) <*> aopt (selectField optionsFinite) (fslI MsgAdminUserSex) (aufSex <$> template) + <*> aopt (textField & cfStrip) (fslI MsgAdminUserMobile) (aufMobile <$> template) + <*> aopt (textField & cfStrip) (fslI MsgAdminUserTelephone) (aufTelephone <$> template) + <*> aopt (textField & cfStrip) (fslI MsgAdminUserFPersonalNumber) (aufFPersonalNumber <$> template) + <*> aopt (textField & cfStrip) (fslI MsgAdminUserFDepartment) (aufFDepartment <$> template) <*> areq (emailField & cfCI) (fslI MsgAdminUserEmail) (aufEmail <$> template) <*> areq (textField & cfStrip & cfCI) (fslI MsgAdminUserIdent) (aufIdent <$> template) <*> areq (selectField optionsFinite) (fslI MsgAdminUserAuth) (aufAuth <$> template <|> Just AuthKindLDAP) @@ -89,7 +97,11 @@ postAdminUserAddR = do , userFirstName = aufFirstName , userSurname = aufSurname , userTitle = aufTitle - , userSex = aufSex + , userSex = aufSex + , userMobile = aufMobile + , userTelephone = aufTelephone + , userCompanyPersonalNumber = aufFPersonalNumber + , userCompanyDepartment = aufFDepartment , userMatrikelnummer = aufMatriculation , userAuthentication = mkAuthMode aufAuth } diff --git a/src/Handler/Utils/SchoolLdap.hs b/src/Handler/Utils/SchoolLdap.hs index b8e9bcbf8..2bfc991f3 100644 --- a/src/Handler/Utils/SchoolLdap.hs +++ b/src/Handler/Utils/SchoolLdap.hs @@ -11,7 +11,7 @@ import qualified Data.CaseInsensitive as CI import qualified Data.Set as Set - +{- PROBALY DEPRECATED -} parseLdapSchools :: Text -> Either ParseError (Set (CI Text)) parseLdapSchools = parse pLdapSchools ""