feat(admin-users): allow adding users
This commit is contained in:
Gregor Kleen
parent
bb9c34fa4d
commit
67f120120f
@ -781,9 +781,9 @@ MailUserRightsIntro name@Text email@UserEmail: #{name} <#{email}> hat folgende U
|
||||
MailNoLecturerRights: Sie haben derzeit keine Dozenten-Rechte.
|
||||
MailLecturerRights n@Int: Als Dozent dürfen Sie Veranstaltungen innerhalb #{pluralDE n "Ihres Instituts" "Ihrer Institute"} anlegen.
|
||||
|
||||
MailSubjectUserAuthModeUpdate: Änderung Ihres Uni2work-Anmeldemodus
|
||||
UserAuthModePWHashChangedToLDAP: Sie melden sich nun mit Ihrer Campus-Kennung an
|
||||
UserAuthModeLDAPChangedToPWHash: Sie melden sich nun mit einer Uni2work-internen Kennung an
|
||||
MailSubjectUserAuthModeUpdate: Ihr Uni2work-Login
|
||||
UserAuthModePWHashChangedToLDAP: Sie können sich nun mit Ihrer Campus-Kennung in Uni2work einloggen
|
||||
UserAuthModeLDAPChangedToPWHash: Sie können sich nun mit einer Uni2work-internen Kennung in Uni2work einloggen
|
||||
NewPasswordLinkTip: Das Passwort Ihrer Uni2work-internen Kennung können Sie auf der folgenden Seite setzen:
|
||||
NewPasswordLink: Neues Passwort setzen
|
||||
AuthPWHashTip: Sie müssen nun das mit "Uni2work-Login" beschriftete Login-Formular verwenden. Stellen Sie bitte sicher, dass Sie ein Passwort gesetzt haben, bevor Sie versuchen sich anzumelden.
|
||||
@ -1000,6 +1000,7 @@ MenuCourseApplications: Bewerbungen
|
||||
MenuTermShow: Semester
|
||||
MenuSubmissionDelete: Abgabe löschen
|
||||
MenuUsers: Benutzer
|
||||
MenuUserAdd: Benutzer anlegen
|
||||
MenuUserNotifications: Benachrichtigungs-Einstellungen
|
||||
MenuUserPassword: Passwort
|
||||
MenuAdminTest: Admin-Demo
|
||||
@ -1631,4 +1632,17 @@ MailAllocationUnratedApplications: Für die unten aufgeführten Kurse liegen Bew
|
||||
|
||||
MailSubjectAllocationOutdatedRatings allocation@AllocationName: Bereits bewertete Bewerbungen für ihre Kurse in der Zentralanmeldung „#{allocation}“ haben sich geändert
|
||||
MailAllocationOutdatedRatings: Für die unten aufgeführten Kurse liegen Bewerbungen vor, die im Rahmen der Zentralanmeldung an den jeweiligen Kurs gestellt wurden, die sich verändert haben, seit sie zuletzt bewertet wurden.
|
||||
MailAllocationOutdatedRatingsWarning: Bewerbungen deren Bewertung veraltet ist (d.h. die Bewerbung wurde nach der Bewertung verändert) zählen als nicht bewertet.
|
||||
MailAllocationOutdatedRatingsWarning: Bewerbungen deren Bewertung veraltet ist (d.h. die Bewerbung wurde nach der Bewertung verändert) zählen als nicht bewertet.
|
||||
|
||||
AdminUserTitle: Titel
|
||||
AdminUserFirstName: Vorname
|
||||
AdminUserSurname: Nachname
|
||||
AdminUserDisplayName: Anzeige-Name
|
||||
AdminUserEmail: E-Mail Addresse
|
||||
AdminUserIdent: Identifikation
|
||||
AdminUserAuth: Authentifizierung
|
||||
AdminUserMatriculation: Matrikelnummer
|
||||
AuthKindLDAP: Campus-Kennung
|
||||
AuthKindPWHash: Uni2work-Kennung
|
||||
UserAdded: Benutzer erfolgreich angelegt
|
||||
UserCollision: Benutzer konnte wegen Eindeutigkeit nicht angelegt werden
|
||||
1
routes
1
routes
@ -51,6 +51,7 @@
|
||||
/users/#CryptoUUIDUser/password UserPasswordR GET POST !selfANDis-pw-hash
|
||||
!/users/functionary-invite/new AdminNewFunctionaryInviteR GET POST
|
||||
!/users/functionary-invite AdminFunctionaryInviteR GET POST
|
||||
!/users/add AdminUserAddR GET POST
|
||||
/admin AdminR GET
|
||||
/admin/features AdminFeaturesR GET POST
|
||||
/admin/test AdminTestR GET POST
|
||||
|
||||
@ -1752,6 +1752,7 @@ instance YesodBreadcrumbs UniWorX where
|
||||
breadcrumb (AuthR _) = return ("Login" , Just HomeR)
|
||||
breadcrumb HomeR = return ("Uni2work" , Nothing)
|
||||
breadcrumb UsersR = return ("Benutzer" , Just AdminR)
|
||||
breadcrumb AdminUserAddR = return ("Benutzer anlegen", Just UsersR)
|
||||
breadcrumb (AdminUserR _) = return ("Users" , Just UsersR)
|
||||
breadcrumb AdminR = return ("Administration", Nothing)
|
||||
breadcrumb AdminFeaturesR = return ("Test" , Just AdminR)
|
||||
@ -2096,6 +2097,14 @@ pageActions (UsersR) =
|
||||
, menuItemModal = True
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuUserAdd
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute AdminUserAddR
|
||||
, menuItemModal = True
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (AdminUserR cID) =
|
||||
[ MenuItem
|
||||
|
||||
@ -1,6 +1,8 @@
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module Handler.Users where
|
||||
module Handler.Users
|
||||
( module Handler.Users
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
@ -31,6 +33,8 @@ import qualified Data.ByteString.Base64 as Base64
|
||||
import Text.Hamlet (ihamlet)
|
||||
import Data.Aeson hiding (Result(..))
|
||||
|
||||
import Handler.Users.Add as Handler.Users
|
||||
|
||||
|
||||
hijackUserForm :: Form ()
|
||||
hijackUserForm csrf = do
|
||||
|
||||
108
src/Handler/Users/Add.hs
Normal file
108
src/Handler/Users/Add.hs
Normal file
@ -0,0 +1,108 @@
|
||||
module Handler.Users.Add
|
||||
( AuthenticationKind(..)
|
||||
, classifyAuth, mkAuthMode
|
||||
, AdminUserForm(..), adminUserForm
|
||||
, getAdminUserAddR, postAdminUserAddR
|
||||
) where
|
||||
|
||||
|
||||
import Import
|
||||
import Handler.Utils
|
||||
import Jobs
|
||||
|
||||
|
||||
data AdminUserForm = AdminUserForm
|
||||
{ aufTitle :: Maybe Text
|
||||
, aufFirstName :: Text
|
||||
, aufSurname :: UserSurname
|
||||
, aufDisplayName :: UserDisplayName
|
||||
, aufMatriculation :: Maybe UserMatriculation
|
||||
, aufEmail :: UserEmail
|
||||
, aufIdent :: UserIdent
|
||||
, aufAuth :: AuthenticationKind
|
||||
}
|
||||
|
||||
data AuthenticationKind = AuthKindLDAP | AuthKindPWHash
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
|
||||
instance Universe AuthenticationKind
|
||||
instance Finite AuthenticationKind
|
||||
embedRenderMessage ''UniWorX ''AuthenticationKind id
|
||||
nullaryPathPiece ''AuthenticationKind $ camelToPathPiece' 2
|
||||
|
||||
classifyAuth :: AuthenticationMode -> AuthenticationKind
|
||||
classifyAuth AuthLDAP = AuthKindLDAP
|
||||
classifyAuth AuthPWHash{} = AuthKindPWHash
|
||||
|
||||
mkAuthMode :: AuthenticationKind -> AuthenticationMode
|
||||
mkAuthMode AuthKindLDAP = AuthLDAP
|
||||
mkAuthMode AuthKindPWHash = AuthPWHash ""
|
||||
|
||||
adminUserForm :: Maybe AdminUserForm -> Form AdminUserForm
|
||||
adminUserForm template = renderAForm FormStandard
|
||||
$ AdminUserForm
|
||||
<$> aopt (textField & cfStrip) (fslI MsgAdminUserTitle) (aufTitle <$> template)
|
||||
<*> areq (textField & cfStrip) (fslI MsgAdminUserFirstName) (aufFirstName <$> template)
|
||||
<*> areq (textField & cfStrip) (fslI MsgAdminUserSurname) (aufSurname <$> template)
|
||||
<*> areq (textField & cfStrip) (fslI MsgAdminUserDisplayName) (aufDisplayName <$> template)
|
||||
<*> aopt (textField & cfStrip) (fslI MsgAdminUserMatriculation) (aufMatriculation <$> 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)
|
||||
|
||||
|
||||
getAdminUserAddR, postAdminUserAddR :: Handler Html
|
||||
getAdminUserAddR = postAdminUserAddR
|
||||
postAdminUserAddR = do
|
||||
((userRes, userView), userEnctype) <- runFormPost $ adminUserForm Nothing
|
||||
|
||||
formResult userRes $ \AdminUserForm{..} -> do
|
||||
now <- liftIO getCurrentTime
|
||||
UserDefaultConf{..} <- getsYesod $ view _appUserDefaults
|
||||
|
||||
let
|
||||
newUser@User{..} = User
|
||||
{ userIdent = aufIdent
|
||||
, userMaxFavourites = userDefaultMaxFavourites
|
||||
, userTheme = userDefaultTheme
|
||||
, userDateTimeFormat = userDefaultDateTimeFormat
|
||||
, userDateFormat = userDefaultDateFormat
|
||||
, userTimeFormat = userDefaultTimeFormat
|
||||
, userDownloadFiles = userDefaultDownloadFiles
|
||||
, userWarningDays = userDefaultWarningDays
|
||||
, userNotificationSettings = def
|
||||
, userMailLanguages = def
|
||||
, userTokensIssuedAfter = Nothing
|
||||
, userCreated = now
|
||||
, userLastLdapSynchronisation = Nothing
|
||||
, userLastAuthentication = Nothing
|
||||
, userEmail = aufEmail
|
||||
, userDisplayName = aufDisplayName
|
||||
, userFirstName = aufFirstName
|
||||
, userSurname = aufSurname
|
||||
, userTitle = aufTitle
|
||||
, userMatrikelnummer = aufMatriculation
|
||||
, userAuthentication = mkAuthMode aufAuth
|
||||
}
|
||||
|
||||
didInsert <- runDBJobs . runMaybeT $ do
|
||||
uid <- MaybeT $ insertUnique newUser
|
||||
lift . queueDBJob $ JobSynchroniseLdapUser uid
|
||||
lift . queueDBJob . JobQueueNotification $ NotificationUserAuthModeUpdate uid userAuthentication
|
||||
when (aufAuth == AuthKindPWHash) $
|
||||
lift . queueDBJob $ JobSendPasswordReset uid
|
||||
return uid
|
||||
|
||||
case didInsert of
|
||||
Just uid -> do
|
||||
addMessageI Success MsgUserAdded
|
||||
cID <- encrypt uid
|
||||
redirect $ AdminUserR cID
|
||||
Nothing ->
|
||||
addMessageI Error MsgUserCollision
|
||||
|
||||
siteLayoutMsg MsgMenuUserAdd $ do
|
||||
setTitleI MsgMenuUserAdd
|
||||
wrapForm userView def
|
||||
{ formAction = Just $ SomeRoute AdminUserAddR
|
||||
, formEncoding = userEnctype
|
||||
}
|
||||
@ -6,6 +6,8 @@ module Jobs.Handler.SendNotification.UserAuthModeUpdate
|
||||
|
||||
import Import
|
||||
|
||||
import Auth.PWHash (PWHashMessage(..))
|
||||
|
||||
import Handler.Utils.Mail
|
||||
import Jobs.Handler.SendNotification.Utils
|
||||
|
||||
@ -18,8 +20,8 @@ dispatchNotificationUserAuthModeUpdate nUser _nOriginalAuthMode jRecipient = us
|
||||
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
||||
setSubjectI MsgMailSubjectUserAuthModeUpdate
|
||||
|
||||
editNotifications <- mkEditNotifications jRecipient
|
||||
editNotifications <- ihamletSomeMessage <$> mkEditNotifications jRecipient
|
||||
|
||||
addAlternatives $
|
||||
providePreferredAlternative ($(ihamletFile "templates/mail/userAuthModeUpdate.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
|
||||
providePreferredAlternative ($(ihamletFile "templates/mail/userAuthModeUpdate.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX))
|
||||
|
||||
|
||||
@ -13,13 +13,18 @@ $newline never
|
||||
<h1>
|
||||
$case userAuthentication
|
||||
$of AuthLDAP
|
||||
_{MsgUserAuthModePWHashChangedToLDAP}
|
||||
_{SomeMessage MsgUserAuthModePWHashChangedToLDAP}
|
||||
$of AuthPWHash _
|
||||
_{MsgUserAuthModeLDAPChangedToPWHash}
|
||||
_{SomeMessage MsgUserAuthModeLDAPChangedToPWHash}
|
||||
$if is _AuthPWHash userAuthentication
|
||||
<p>
|
||||
_{MsgAuthPWHashTip}
|
||||
<p>
|
||||
_{MsgPasswordResetEmailIncoming}
|
||||
_{SomeMessage MsgAuthPWHashTip}
|
||||
<dd>
|
||||
<dt>_{SomeMessage MsgPWHashIdent}
|
||||
<dd style="font-family: monospace">#{userIdent}
|
||||
<dt>_{SomeMessage MsgPWHashPassword}
|
||||
<dd>
|
||||
_{SomeMessage MsgPasswordResetEmailIncoming}
|
||||
|
||||
^{editNotifications}
|
||||
$if is _Just userLastAuthentication
|
||||
^{editNotifications}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user