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

fix(course-user): handle allocations when deregistering single users

Browse Source
This commit is contained in:
Gregor Kleen 2019-10-05 11:44:21 +02:00
parent 852089381c
commit ef5bb70b65
2 changed files with 21 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
src/Handler/Course/User.hs
View File

@ -118,31 +118,43 @@ postCUserR tid ssh csh uCId = do
let regButton let regButton
| is _Just mRegistration = BtnCourseDeregister | is _Just mRegistration = BtnCourseDeregister
| otherwise = BtnCourseRegister | otherwise = BtnCourseRegister
((regButtonRes, regButtonView), regButtonEnctype) <- runFormPost . identifyForm FIDcRegButton $ buttonForm' [regButton] ((regButtonRes, regButtonView), regButtonEnctype) <- runFormPost . identifyForm FIDcRegButton $
if | is _Just $ courseParticipantAllocated . entityVal =<< mRegistration
-> renderWForm FormStandard $ fmap (regButton, )
<$ (wformMessage =<< messageIconI Warning IconEnrolFalse MsgCourseDeregistrationAllocationShouldLogTip)
<*> optionalActionW (areq (textField & cfStrip & guardField (not . null)) (fslI MsgCourseDeregistrationAllocationReason & setTooltip MsgCourseDeregistrationAllocationReasonTip) Nothing) (fslI MsgCourseDeregistrationAllocationShouldLog) (Just True)
| otherwise
-> \csrf -> pure (FormSuccess (regButton, Nothing), toWidget csrf)
let registrationButtonFrag :: Text let registrationButtonFrag :: Text
registrationButtonFrag = "registration-button" registrationButtonFrag = "registration-button"
regButtonWidget = wrapForm regButtonView FormSettings regButtonWidget = wrapForm' regButton regButtonView FormSettings
{ formMethod = POST { formMethod = POST
, formAction = Just . SomeRoute $ currentRoute :#: registrationButtonFrag , formAction = Just . SomeRoute $ currentRoute :#: registrationButtonFrag
, formEncoding = regButtonEnctype , formEncoding = regButtonEnctype
, formAttrs = [] , formAttrs = []
, formSubmit = FormNoSubmit , formSubmit = FormSubmit
, formAnchor = Just registrationButtonFrag , formAnchor = Just registrationButtonFrag
} }
formResult regButtonRes $ \case formResult regButtonRes $ \case
_ _
| not mayRegister | not mayRegister
-> permissionDenied "User may not be registered" -> permissionDenied "User may not be registered"
BtnCourseDeregister (BtnCourseDeregister, mbReason)
| Just (Entity pId _) <- mRegistration | Just (Entity pId CourseParticipant{..}) <- mRegistration
-> do -> do
runDB $ delete pId runDB $ do
delete pId
audit $ TransactionCourseParticipantDeleted cid courseParticipantUser
whenIsJust mbReason $ \reason -> do
now <- liftIO getCurrentTime
insert_ $ AllocationDeregister courseParticipantUser (Just cid) now (Just reason)
addMessageIconI Info IconEnrolFalse MsgCourseDeregisterOk addMessageIconI Info IconEnrolFalse MsgCourseDeregisterOk
redirect $ CourseR tid ssh csh CUsersR redirect $ CourseR tid ssh csh CUsersR
| otherwise | otherwise
-> invalidArgs ["User not registered"] -> invalidArgs ["User not registered"]
BtnCourseRegister -> do (BtnCourseRegister, _) -> do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
let field let field
| [(Entity featId _, _, _)] <- filter (\(Entity _ StudyFeatures{..}, _, _) -> studyFeaturesValid) studies | [(Entity featId _, _, _)] <- filter (\(Entity _ StudyFeatures{..}, _, _) -> studyFeaturesValid) studies

4
templates/default-layout.lucius
View File

@ -650,7 +650,7 @@ section {
} }
} }
.form-section-notification { .form-section-notification, .form-section-notification fieldset {
display: grid; display: grid;
grid-template-columns: 1fr 3fr; grid-template-columns: 1fr 3fr;
grid-gap: 5px; grid-gap: 5px;
@ -669,7 +669,7 @@ section {
} }
@media (max-width: 768px) { @media (max-width: 768px) {
.form-section-notification { .form-section-notification, .form-section-notification fieldset {
grid-template-columns: 1fr; grid-template-columns: 1fr;
margin-top: 17px; margin-top: 17px;
} }