fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore: don't optimize Handler.Users.Add for build time

Browse Source
This commit is contained in:
Gregor Kleen 2023-05-22 18:20:32 +00:00
parent d15cdf29e1
commit d496fbe085
1 changed files with 12 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
src/Handler/Users/Add.hs
View File

@ -1,9 +1,11 @@
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@cip.ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de> -- SPDX-FileCopyrightText: 2022-2023 Gregor Kleen <gregor@kleen.consulting>, Sarah Vaupel <sarah.vaupel@ifi.lmu.de>, Steffen Jost <jost@tcs.ifi.lmu.de>, Winnie Ros <winnie.ros@campus.lmu.de>
-- --
-- SPDX-License-Identifier: AGPL-3.0-or-later -- SPDX-License-Identifier: AGPL-3.0-or-later
{-# OPTIONS_GHC -O0 -fno-ignore-interface-pragmas -fno-omit-interface-pragmas #-}
module Handler.Users.Add module Handler.Users.Add
( getAdminUserAddR, postAdminUserAddR ( getAdminUserAddR, postAdminUserAddR
) where ) where
@ -25,10 +27,10 @@ adminUserForm template = renderAForm FormStandard
<*> aopt (selectField optionsFinite) (fslI MsgAdminUserSex) (audSex <$> template) <*> aopt (selectField optionsFinite) (fslI MsgAdminUserSex) (audSex <$> template)
<*> aopt dayField (fslI MsgAdminUserBirthday) (audBirthday <$> template) <*> aopt dayField (fslI MsgAdminUserBirthday) (audBirthday <$> template)
<*> aopt (textField & cfStrip) (fslI MsgAdminUserMobile) (audMobile <$> template) <*> aopt (textField & cfStrip) (fslI MsgAdminUserMobile) (audMobile <$> template)
<*> aopt (textField & cfStrip) (fslI MsgAdminUserTelephone) (audTelephone <$> template) <*> aopt (textField & cfStrip) (fslI MsgAdminUserTelephone) (audTelephone <$> template)
<*> aopt (textField & cfStrip) (fslI MsgAdminUserFPersonalNumber) (audFPersonalNumber <$> template) <*> aopt (textField & cfStrip) (fslI MsgAdminUserFPersonalNumber) (audFPersonalNumber <$> template)
<*> aopt (textField & cfStrip) (fslI MsgAdminUserFDepartment) (audFDepartment <$> template) <*> aopt (textField & cfStrip) (fslI MsgAdminUserFDepartment) (audFDepartment <$> template)
<*> aopt htmlField (fslI MsgAdminUserPostAddress) (audPostAddress <$> template) <*> aopt htmlField (fslI MsgAdminUserPostAddress) (audPostAddress <$> template)
<*> areq checkBoxField (fslI MsgAdminUserPrefersPostal) (audPrefersPostal <$> template) <*> areq checkBoxField (fslI MsgAdminUserPrefersPostal) (audPrefersPostal <$> template)
<*> aopt (textField & cfStrip) (fslI MsgAdminUserPinPassword) (audPinPassword <$> template) <*> aopt (textField & cfStrip) (fslI MsgAdminUserPinPassword) (audPinPassword <$> template)
<*> areq (emailField & cfCI) (fslI MsgAdminUserEmail) (audEmail <$> template) <*> areq (emailField & cfCI) (fslI MsgAdminUserEmail) (audEmail <$> template)
@ -36,16 +38,16 @@ adminUserForm template = renderAForm FormStandard
<*> areq (selectField optionsFinite) (fslI MsgAdminUserAuth & setTooltip MsgAdminUserAuthTooltip) (audAuth <$> template <|> Just AuthKindLDAP) <*> areq (selectField optionsFinite) (fslI MsgAdminUserAuth & setTooltip MsgAdminUserAuthTooltip) (audAuth <$> template <|> Just AuthKindLDAP)
-- | Like `addNewUser`, but starts background jobs and tries to notify users, if applicable (i.e. /= AuthNoLogin ) -- | Like `addNewUser`, but starts background jobs and tries to notify users, if applicable (i.e. /= AuthNoLogin )
addNewUserNotify :: AddUserData -> Handler (Maybe UserId) addNewUserNotify :: AddUserData -> Handler (Maybe UserId)
addNewUserNotify aud = do addNewUserNotify aud = do
mbUid <- addNewUser aud mbUid <- addNewUser aud
case mbUid of case mbUid of
Nothing -> return Nothing Nothing -> return Nothing
Just uid -> runDBJobs $ do Just uid -> runDBJobs $ do
queueDBJob $ JobSynchroniseLdapUser uid queueDBJob $ JobSynchroniseLdapUser uid
let authKind = audAuth aud let authKind = audAuth aud
when (authKind /= AuthKindNoLogin) $ when (authKind /= AuthKindNoLogin) $
queueDBJob . JobQueueNotification $ NotificationUserAuthModeUpdate uid queueDBJob . JobQueueNotification $ NotificationUserAuthModeUpdate uid
when (authKind == AuthKindPWHash) $ when (authKind == AuthKindPWHash) $
queueDBJob $ JobSendPasswordReset uid queueDBJob $ JobSendPasswordReset uid
return $ Just uid return $ Just uid