fix(user): add new user failed due to AuthNoLogin not treated in notification template
This commit is contained in:
Steffen Jost
parent
744b8759fc
commit
a1516d9116
@ -75,8 +75,9 @@ NotPassed: Nicht bestanden
|
||||
|
||||
#userAuthModeUpdate.hs + templates
|
||||
MailSubjectUserAuthModeUpdate: Ihr FRADrive-Login
|
||||
UserAuthModePWHashChangedToLDAP: Sie können sich nun mit Ihrer Fraport AG Kennung (Büko) in FRADrive einloggen
|
||||
UserAuthModeLDAPChangedToPWHash: Sie können sich nun mit einer FRADrive-internen Kennung einloggen
|
||||
UserAuthModeChangedToLDAP: Sie können sich nun mit Ihrer Fraport AG Kennung (Büko) in FRADrive einloggen.
|
||||
UserAuthModeChangedToPWHash: Sie können sich nun mit einer FRADrive-internen Kennung einloggen.
|
||||
UserAuthModeChangedToNoLogin: Ihr Login auf der FRADrive Webseite wurde deaktiviert, aber ihr FRADrive Konto besteht weiterhin. Gültigkeit und Verlängerungen Ihrer Qualifikationen sind dadurch nicht beeinträchtigt. Wenden Sie sich an die Fahrschuladmins, wenn der Login auf der FRADrive Webseite benötigt werden sollte.
|
||||
AuthPWHashTip: Sie müssen nun das mit "FRADrive-Login" beschriftete Login-Formular verwenden. Stellen Sie bitte sicher, dass Sie ein Passwort gesetzt haben, bevor Sie versuchen sich anzumelden.
|
||||
PasswordResetEmailIncoming: Einen Link um ihr Passwort zu setzen bzw. zu ändern bekommen Sie, aus Sicherheitsgründen, in einer separaten E-Mail.
|
||||
MailFradrive !ident-ok: FRADrive
|
||||
|
||||
@ -75,8 +75,9 @@ NotPassed: Failed
|
||||
|
||||
#userAuthModeUpdate.hs + templates
|
||||
MailSubjectUserAuthModeUpdate: Your FRADrive login
|
||||
UserAuthModePWHashChangedToLDAP: You can now log in to FRADrive using your Fraport AG account (Büko)
|
||||
UserAuthModeLDAPChangedToPWHash: You can now log in using your FRADrive-internal account
|
||||
UserAuthModeChangedToLDAP: You can now log in to FRADrive using your Fraport AG account (Büko)
|
||||
UserAuthModeChangedToPWHash: You can now log in using your FRADrive-internal account
|
||||
UserAuthModeChangedToNoLogin: Your login for the FRADrive website has been deactivated, but you FRADrive account persists. This has no effect on you qualifications. Please contact the driving school admins, if you need new login credentials for the FRADrive website.
|
||||
AuthPWHashTip: You now need to use the login form labeled "FRADrive login". Please ensure that you have already set a password when you try to log in.
|
||||
PasswordResetEmailIncoming: For security reasons you will receive a link to the page on which you can set and later change your password in a separate email.
|
||||
MailFradrive: FRADrive
|
||||
|
||||
@ -87,6 +87,8 @@ UserAccountDeleteWarning: Achtung, dies löscht den kompletten Benutzer/die komp
|
||||
UserLdapSync: LDAP-Synchronisieren
|
||||
AllUsersLdapSync: Alle LDAP-Synchronisieren
|
||||
UserHijack: Sitzung übernehmen
|
||||
UserAddSupervisor: Ansprechpartner hinzufügen
|
||||
UserSetSupervisor: Ansprechpartner ersetzen
|
||||
AuthKindLDAP: Fraport AG Kennung
|
||||
AuthKindPWHash: FRADrive Kennung
|
||||
AuthKindNoLogin: Kein Login möglich
|
||||
|
||||
@ -87,6 +87,8 @@ UserAccountDeleteWarning: Caution, this permanently deletes users and all of the
|
||||
UserLdapSync: Synchronise with LDAP
|
||||
AllUsersLdapSync: Synchronise all with LDAP
|
||||
UserHijack: Hijack session
|
||||
UserAddSupervisor: Add supervisor
|
||||
UserSetSupervisor: Replace supervisors
|
||||
AuthKindLDAP: Fraport AG account
|
||||
AuthKindPWHash: FRADrive account
|
||||
AuthKindNoLogin: No login
|
||||
|
||||
@ -289,9 +289,8 @@ data LicenceTableAction = LicenceTableChangeAvs
|
||||
| LicenceTableRevokeFDrive
|
||||
| LicenceTableGrantFDrive
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
|
||||
deriving anyclass (Universe, Finite)
|
||||
|
||||
instance Universe LicenceTableAction
|
||||
instance Finite LicenceTableAction
|
||||
nullaryPathPiece ''LicenceTableAction $ camelToPathPiece' 2
|
||||
embedRenderMessage ''UniWorX ''LicenceTableAction id
|
||||
|
||||
@ -473,7 +472,7 @@ mkLicenceTable dbtIdent aLic apids = do
|
||||
-- $ \DBRow{dbrOutput=(_,_,apid,_)} -> return apid -- return . view resultAvsPID -- does not type due to traversal
|
||||
, colUserNameLink AdminUserR
|
||||
, sortable (Just "avspersonno") (i18nCell MsgAvsPersonNo) $ \(view resultUserAvs -> a) -> avsPersonNoCell a
|
||||
-- , colUserCompany
|
||||
-- , colUserCompany
|
||||
, sortable (Just "user-company") (i18nCell MsgTableCompany) $ \(view (resultUser . _entityKey) -> uid) -> flip (set' cellContents) mempty $ do -- why does sqlCell not work here? Mismatch "YesodDB UniWorX" and "RWST (Maybe (Env,FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX"
|
||||
companies' <- liftHandler . runDB . E.select $ E.from $ \(usrComp `E.InnerJoin` comp) -> do
|
||||
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
|
||||
|
||||
@ -54,13 +54,19 @@ hijackUserForm csrf = do
|
||||
-- instance HasUser (DBRow (Entity USer)) where
|
||||
-- hasUser = _entityVal
|
||||
|
||||
data UserAction = UserLdapSync | UserHijack
|
||||
data UserAction = UserLdapSync | UserAddSupervisor | UserSetSupervisor
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
|
||||
deriving anyclass (Universe, Finite)
|
||||
|
||||
nullaryPathPiece ''UserAction $ camelToPathPiece' 1
|
||||
embedRenderMessage ''UniWorX ''UserAction id
|
||||
|
||||
data UserActionData = UserLdapSyncData
|
||||
| UserHijack
|
||||
| UserAddSupervisorData
|
||||
| UserSetSupervisorData
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
|
||||
|
||||
data AllUsersAction = AllUsersLdapSync
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
|
||||
@ -143,7 +149,7 @@ postUsersR = do
|
||||
, Just uid /= myUid
|
||||
-> lift $ do
|
||||
let
|
||||
postprocess :: FormResult () -> FormResult (First UserAction, DBFormResult UserId Bool (DBRow (Entity User)))
|
||||
postprocess :: FormResult () -> FormResult (First UserActionData, DBFormResult UserId Bool (DBRow (Entity User)))
|
||||
postprocess (FormSuccess ()) = FormSuccess (First $ Just UserHijack, DBFormResult $ Map.singleton uid (inp, const True))
|
||||
postprocess FormMissing = FormSuccess mempty
|
||||
postprocess (FormFailure errs) = FormFailure errs
|
||||
@ -161,12 +167,19 @@ postUsersR = do
|
||||
<$> selectList [] [Asc SchoolName]
|
||||
|
||||
let
|
||||
postprocess :: FormResult (First UserAction, DBFormResult UserId Bool (DBRow (Entity User))) -> FormResult (UserAction, Set UserId)
|
||||
postprocess :: FormResult (First UserActionData, DBFormResult UserId Bool (DBRow (Entity User))) -> FormResult (UserActionData, Set UserId)
|
||||
postprocess inp = do
|
||||
(First (Just act), usrMap) <- inp
|
||||
let usrSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) usrMap
|
||||
return (act, usrSet)
|
||||
|
||||
acts :: Map UserAction (AForm Handler UserActionData)
|
||||
acts = mconcat
|
||||
[ singletonMap UserLdapSync $ pure UserLdapSyncData
|
||||
, singletonMap UserAddSupervisor $ pure UserAddSupervisorData
|
||||
, singletonMap UserSetSupervisor $ pure UserSetSupervisorData
|
||||
]
|
||||
|
||||
over _1 postprocess <$> dbTable psValidator DBTable
|
||||
{ dbtSQLQuery = return :: E.SqlExpr (Entity User) -> E.SqlQuery (E.SqlExpr (Entity User))
|
||||
, dbtRowKey = (E.^. UserId)
|
||||
@ -290,7 +303,7 @@ postUsersR = do
|
||||
, dbParamsFormAdditional
|
||||
= renderAForm FormStandard
|
||||
$ (, mempty) . First . Just
|
||||
<$> areq (selectField $ optionsF [UserLdapSync]) (fslI MsgTableAction) Nothing
|
||||
<$> multiActionA acts (fslI MsgTableAction) Nothing
|
||||
, dbParamsFormEvaluate = liftHandler . runFormPost
|
||||
, dbParamsFormResult = id
|
||||
, dbParamsFormIdent = def
|
||||
@ -306,7 +319,7 @@ postUsersR = do
|
||||
| Set.null usersSet -> do
|
||||
addMessageI Info MsgActionNoUsersSelected
|
||||
redirect UsersR
|
||||
(UserLdapSync, userSet) -> do
|
||||
(UserLdapSyncData, userSet) -> do
|
||||
runDBJobs . forM_ userSet $ \uid -> queueDBJob $ JobSynchroniseLdapUser uid
|
||||
addMessageI Success . MsgSynchroniseLdapUserQueued $ Set.size userSet
|
||||
redirect UsersR
|
||||
|
||||
@ -5,7 +5,7 @@
|
||||
module Handler.Users.Add
|
||||
( getAdminUserAddR, postAdminUserAddR
|
||||
, AdminUserForm(..), AuthenticationKind(..)
|
||||
, addNewUser
|
||||
, addNewUser, addNewUserNoNotfication
|
||||
--, adminUserForm , classifyAuth, mkAuthMode -- no longer needed elsewhere
|
||||
) where
|
||||
|
||||
@ -75,8 +75,14 @@ adminUserForm template = renderAForm FormStandard
|
||||
<*> areq (textField & cfStrip & cfCI) (fslI MsgAdminUserIdent) (aufIdent <$> template)
|
||||
<*> areq (selectField optionsFinite) (fslI MsgAdminUserAuth) (aufAuth <$> template <|> Just AuthKindLDAP)
|
||||
|
||||
addNewUser :: AdminUserForm -> Handler (Maybe UserId)
|
||||
addNewUser AdminUserForm{..} = do
|
||||
addNewUser :: AdminUserForm -> Handler (Maybe UserId)
|
||||
addNewUser = addNewUser' True
|
||||
|
||||
addNewUserNoNotfication :: AdminUserForm -> Handler (Maybe UserId)
|
||||
addNewUserNoNotfication = addNewUser' False
|
||||
|
||||
addNewUser' :: Bool -> AdminUserForm -> Handler (Maybe UserId)
|
||||
addNewUser' notifyusr AdminUserForm{..} = do
|
||||
now <- liftIO getCurrentTime
|
||||
UserDefaultConf{..} <- getsYesod $ view _appUserDefaults
|
||||
let
|
||||
@ -121,7 +127,8 @@ addNewUser AdminUserForm{..} = do
|
||||
runDBJobs . runMaybeT $ do
|
||||
uid <- MaybeT $ insertUnique newUser
|
||||
lift . queueDBJob $ JobSynchroniseLdapUser uid
|
||||
lift . queueDBJob . JobQueueNotification $ NotificationUserAuthModeUpdate uid (newUser ^. _userAuthentication)
|
||||
when notifyusr $
|
||||
lift . queueDBJob . JobQueueNotification $ NotificationUserAuthModeUpdate uid (newUser ^. _userAuthentication)
|
||||
when (aufAuth == AuthKindPWHash) $
|
||||
lift . queueDBJob $ JobSendPasswordReset uid
|
||||
return uid
|
||||
|
||||
@ -375,7 +375,7 @@ upsertAvsUserById api = do
|
||||
, aufIdent = fakeIdent -- use AvsPersonId instead
|
||||
, aufAuth = maybe AuthKindNoLogin (const AuthKindLDAP) avsPersonInternalPersonalNo -- FUTURE TODO: if email is known, use AuthKinfPWHash for email invite, if no internal personal number is known
|
||||
}
|
||||
mbUid <- addNewUser newUsr -- triggers JobSynchroniseLdapUser, JobSendPasswordReset and NotificationUserAutoModeUpdate -- TODO: check if these are failsafe
|
||||
mbUid <- addNewUserNoNotfication newUsr -- triggers JobSynchroniseLdapUser, JobSendPasswordReset and NotificationUserAutoModeUpdate -- TODO: check if these are failsafe
|
||||
whenIsJust mbUid $ \uid -> runDB $ do
|
||||
now <- liftIO getCurrentTime
|
||||
insert_ $ UserAvs avsPersonPersonID uid avsPersonPersonNo
|
||||
|
||||
@ -21,9 +21,11 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
<h1>
|
||||
$case userAuthentication
|
||||
$of AuthLDAP
|
||||
_{SomeMessage MsgUserAuthModePWHashChangedToLDAP}
|
||||
_{SomeMessage MsgUserAuthModeChangedToLDAP}
|
||||
$of AuthPWHash _
|
||||
_{SomeMessage MsgUserAuthModeLDAPChangedToPWHash}
|
||||
_{SomeMessage MsgUserAuthModeChangedToPWHash}
|
||||
$of AuthNoLogin
|
||||
_{SomeMessage MsgUserAuthModeChangedToNoLogin}
|
||||
<p>
|
||||
<a href=@{NewsR}>
|
||||
_{SomeMessage MsgMailFradrive} #
|
||||
|
||||
Loading…
Reference in New Issue
Block a user