chore(ldap): change fild complete

2021-12-10 16:25:35 +01:00 · 2021-12-10 16:25:35 +01:00 · facfece7b5
commit facfece7b5
parent ec32a24af7
8 changed files with 44 additions and 30 deletions
--- 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
--- 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
--- a/1
+++ b/1
@ -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
--- 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"
--- 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
--- 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

--- 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
        }
--- 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 ""