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

src/Handler/Course/User.hs

@@ -118,31 +118,43 @@ postCUserR tid ssh csh uCId = do
   let regButton
         | is _Just mRegistration = BtnCourseDeregister
         | 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
       registrationButtonFrag = "registration-button"
-      regButtonWidget = wrapForm regButtonView FormSettings
+      regButtonWidget = wrapForm' regButton regButtonView FormSettings
         { formMethod = POST
         , formAction = Just . SomeRoute $ currentRoute :#: registrationButtonFrag
         , formEncoding = regButtonEnctype
         , formAttrs = []
-        , formSubmit = FormNoSubmit
+        , formSubmit = FormSubmit
         , formAnchor = Just registrationButtonFrag
         }
   formResult regButtonRes $ \case
     _
       | not mayRegister
         -> permissionDenied "User may not be registered"
-    BtnCourseDeregister
-      | Just (Entity pId _) <- mRegistration
+    (BtnCourseDeregister, mbReason)
+      | Just (Entity pId CourseParticipant{..}) <- mRegistration
         -> 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
           redirect $ CourseR tid ssh csh CUsersR
       | otherwise
         -> invalidArgs ["User not registered"]
-    BtnCourseRegister -> do
+    (BtnCourseRegister, _) -> do
       now <- liftIO getCurrentTime
       let field
             | [(Entity featId _, _, _)] <- filter (\(Entity _ StudyFeatures{..}, _, _) -> studyFeaturesValid) studies

templates/default-layout.lucius

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