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

Merge branch 'master' of gitlab.uniworx.de:fradrive/fradrive

Browse Source
This commit is contained in:
Steffen Jost 2023-05-23 10:09:08 +00:00
commit 00d406dd13
2 changed files with 13 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
flake.nix
View File

@ -135,7 +135,7 @@
inherit (pkgs.lib) recursiveUpdate;
in {
packages = haskellFlake.packages // {
inherit (pkgs) uniworxNodeDependencies uniworxWellKnown uniworxFrontend uniworxDemoDocker uniworxDocker ciDocker changelogJson;
inherit (pkgs) uniworxNodeDependencies uniworxWellKnown uniworxFrontend uniworxDemoDocker uniworxDocker changelogJson;
};
apps = haskellFlake.apps // {

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
{-# OPTIONS_GHC -O0 -fno-ignore-interface-pragmas -fno-omit-interface-pragmas #-}
module Handler.Users.Add
( getAdminUserAddR, postAdminUserAddR
( getAdminUserAddR, postAdminUserAddR
) where
@ -25,10 +27,10 @@ adminUserForm template = renderAForm FormStandard
<*> aopt (selectField optionsFinite) (fslI MsgAdminUserSex) (audSex <$> template)
<*> aopt dayField (fslI MsgAdminUserBirthday) (audBirthday <$> 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 MsgAdminUserFDepartment) (audFDepartment <$> template)
<*> aopt htmlField (fslI MsgAdminUserPostAddress) (audPostAddress <$> template)
<*> aopt htmlField (fslI MsgAdminUserPostAddress) (audPostAddress <$> template)
<*> areq checkBoxField (fslI MsgAdminUserPrefersPostal) (audPrefersPostal <$> template)
<*> aopt (textField & cfStrip) (fslI MsgAdminUserPinPassword) (audPinPassword <$> 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)
-- | Like `addNewUser`, but starts background jobs and tries to notify users, if applicable (i.e. /= AuthNoLogin )
addNewUserNotify :: AddUserData -> Handler (Maybe UserId)
addNewUserNotify aud = do
mbUid <- addNewUser aud
addNewUserNotify :: AddUserData -> Handler (Maybe UserId)
addNewUserNotify aud = do
mbUid <- addNewUser aud
case mbUid of
Nothing -> return Nothing
Just uid -> runDBJobs $ do
queueDBJob $ JobSynchroniseLdapUser uid
Just uid -> runDBJobs $ do
queueDBJob $ JobSynchroniseLdapUser uid
let authKind = audAuth aud
when (authKind /= AuthKindNoLogin) $
queueDBJob . JobQueueNotification $ NotificationUserAuthModeUpdate uid
queueDBJob . JobQueueNotification $ NotificationUserAuthModeUpdate uid
when (authKind == AuthKindPWHash) $
queueDBJob $ JobSendPasswordReset uid
return $ Just uid