fix(exam-users): prevent exam results without registration via csv

messages/uniworx/de-de-formal.msg

@@ -1981,6 +1981,7 @@ ExamUsersResultsReset count@Int64: Prüfungsergebnis für #{show count} Teilnehm
 ExamUsersPartResultsSet count@Int64: Teilprüfungsergebnis für #{show count} Teilnehmer angepasst
 ExamUsersBonusSet count@Int64: Bonuspunkte für #{show count} Teilnehmer angepasst
 ExamUsersResultSet count@Int64: Prüfungsergebnis für #{show count} Teilnehmer angepasst
+ExamUsersExamDataRequiresRegistration: Wenn Prüfungsbezogene Daten (Teil-/Ergebnis, Termin/Raum, Bonus) gesetzt bzw. angepasst werden sollen, muss der jeweilige Teilnehmer zur Prüfung angemeldet sein bzw. werden.
 CourseUserTutorialsDeregistered count@Int64: Teilnehmer von #{show count} #{pluralDE count "Tutorium" "Tutorien"} abgemeldet
 CourseUserNoTutorialsDeregistered: Teilnehmer ist zu keinem der gewählten Tutorien angemeldet
 CourseUserExamsDeregistered count@Int64: Teilnehmer von #{show count} #{pluralDE count "Prüfung" "Prüfungen"} abgemeldet

messages/uniworx/en-eu.msg

@@ -1980,6 +1980,7 @@ ExamUsersResultsReset count: Successfully reset result for #{show count} #{plura
 ExamUsersPartResultsSet count: Successfully modified exam part result for #{show count} #{pluralEN count "participant" "participants"}
 ExamUsersBonusSet count: Successfully modified exam bonus for #{show count} #{pluralEN count "participant" "participants"}
 ExamUsersResultSet count: Sucessfully modified exam result for #{show count} #{pluralEN count "participant" "participants"}
+ExamUsersExamDataRequiresRegistration: If exam data (part-/result, occurrence/room, bonus) is to be modified/set, the relenvant participant needs to be registered for the exam.
 CourseUserTutorialsDeregistered count: Sucessfully deregistered participant from #{show count} #{pluralEN count "tutorial" "tutorials"}
 CourseUserNoTutorialsDeregistered: Participant is not registered for any of the selected tutorials
 CourseUserExamsDeregistered count: Successfully deregistered participant from #{show count} #{pluralEN count "exam" "exams"}

src/Handler/Course/Application/List.hs

@@ -402,6 +402,7 @@ postCApplicationsR tid ssh csh = do
             CourseApplicationsTableCsvSetRatingData{}  -> CourseApplicationsTableCsvSetRating
             CourseApplicationsTableCsvSetCommentData{} -> CourseApplicationsTableCsvSetComment
         , dbtCsvCoarsenActionClass = const DBCsvActionExisting
+        , dbtCsvValidateActions = return ()
         , dbtCsvExecuteActions = do
             C.mapM_ $ \case
               CourseApplicationsTableCsvSetVetoData{..} -> do

src/Handler/Exam/Users.hs

@@ -43,6 +43,8 @@ import Control.Lens.Indexed ((<.), (.>))
 
 import Jobs.Queue
 
+import qualified Control.Monad.State.Class as State
+
 
 type ExamUserTableExpr = (              E.SqlExpr (Entity ExamRegistration)
                           `E.InnerJoin` E.SqlExpr (Entity User)
@@ -613,8 +615,7 @@ postEUsersR tid ssh csh examn = do
                   -> error "An UniqueExamRegistration could be found, but the ExamRegistrationKey is not among the existing keys"
                 DBCsvDiffNew{dbCsvNewKey = Nothing, dbCsvNew} -> do
                   (isPart, uid) <- lift $ guessUser' dbCsvNew
-                  unless isPart $ 
+                  yieldM $ bool ExamUserCsvCourseRegisterData ExamUserCsvRegisterData isPart uid <$> lookupOccurrence dbCsvNew
-                    yieldM $ ExamUserCsvCourseRegisterData uid <$> lookupOccurrence dbCsvNew
 
                   iforMOf_ (ifolded <. _Just) (csvEUserExamPartResults dbCsvNew) $ \epNumber epRes ->
                     when (epNumber `elem` examPartNumbers) $
@@ -706,6 +707,22 @@ postEUsersR tid ssh csh examn = do
                 ExamUserCsvRegister       -> DBCsvActionNew
                 ExamUserCsvDeregister     -> DBCsvActionMissing
                 _other                    -> DBCsvActionExisting
+            , dbtCsvValidateActions = do
+                selectedActions <- State.get
+                availableActions <- ask
+                let missingExamDataUsers = flip filter examDataUsers $ \uid -> any (isRegisterAction uid) availableActions && none (isRegisterAction uid) selectedActions
+                      where
+                        examDataUsers = flip mapMaybe selectedActions $ \case
+                          ExamUserCsvSetResultData{..}        -> Just examUserCsvActUser
+                          ExamUserCsvSetBonusData{..}         -> Just examUserCsvActUser
+                          ExamUserCsvSetPartResultData{..}    -> Just examUserCsvActUser
+                          _other -> Nothing
+                        isRegisterAction uid = \case
+                          ExamUserCsvCourseRegisterData{..} -> uid == examUserCsvActUser
+                          ExamUserCsvRegisterData{..}       -> uid == examUserCsvActUser
+                          _other -> False
+                unless (null missingExamDataUsers) $
+                  tellMPoint $ messageI Error MsgExamUsersExamDataRequiresRegistration
             , dbtCsvExecuteActions = do
                 C.mapM_ $ \case
                   ExamUserCsvCourseRegisterData{..} -> do

src/Handler/Utils/ExternalExam/Users.hs

@@ -446,6 +446,7 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do
 
               when (csvEUserExamResult /= dbCsvOld ^. resultResult . _entityVal . _externalExamResultResult) $
                 yield $ ExternalExamUserCsvSetResultData (E.unValue dbCsvOldKey) csvEUserExamResult
+        , dbtCsvValidateActions = return ()
         , dbtCsvClassifyAction = \case
             ExternalExamUserCsvRegisterData{}   -> ExternalExamUserCsvRegister
             ExternalExamUserCsvSetTimeData{}    -> ExternalExamUserCsvSetTime

src/Handler/Utils/Table/Pagination.hs

@@ -69,7 +69,7 @@ import qualified Database.Esqueleto.Internal.Sql as E (SqlSelect,unsafeSqlValue)
 
 import qualified Network.Wai as Wai
 
-import Control.Monad.RWS (RWST(..), execRWS)
+import Control.Monad.RWS (RWST(..), execRWS, execRWST)
 import Control.Monad.State (evalStateT, execStateT)
 import Control.Monad.Trans.Maybe
 import Control.Monad.State.Class (modify)
@@ -420,6 +420,9 @@ data DBCsvException k'
     { dbCsvExceptionRow :: NamedRecord
     , dbCsvException :: Text
     }
+  | DBCsvUnavailableActionRequested
+    { dbCsvActions :: Set Value
+    }
   deriving (Show, Typeable)
 
 makeLenses_ ''DBCsvException
@@ -598,6 +601,7 @@ data DBTCsvDecode r' k' csv = forall route csvAction csvActionClass csvException
   ) => DBTCsvDecode
   { dbtCsvRowKey :: csv -> MaybeT DB k'
   , dbtCsvComputeActions :: DBCsvDiff r' csv k' -> ConduitT () csvAction DB ()
+  , dbtCsvValidateActions :: RWST (Set csvAction) [Message] [csvAction] DB ()
   , dbtCsvClassifyAction :: csvAction -> csvActionClass
   , dbtCsvCoarsenActionClass :: csvActionClass -> DBCsvActionMode
   , dbtCsvExecuteActions :: ConduitT csvAction Void (YesodJobDB UniWorX) route
@@ -1177,6 +1181,8 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
                               <input id=#{theId} *{attrs} type=checkbox name=#{name} value=#{either id id val} :defaultChecked (dbtCsvClassifyAction act):checked>
                             |]
                         fieldView sJsonField (actionIdent act) (toPathPiece PostDBCsvImportAction) vAttrs (Right act) False
+                      availableActs :: Widget
+                      availableActs = fieldView (secretJsonField :: Field Handler (Set csvAction)) "" (toPathPiece PostDBCsvImportAvailableActions) [] (Right . Set.unions $ Map.elems actionMap) False
                   (csvImportConfirmForm', csvImportConfirmEnctype) <- liftHandler . generateFormPost . withButtonForm' [BtnCsvImportConfirm, BtnCsvImportAbort] . identifyForm (FIDDBTableCsvImportConfirm dbtIdent) $ \csrf -> return (error "No meaningful FormResult", $(widgetFile "csv-import-confirmation"))
                   let csvImportConfirmForm = wrapForm csvImportConfirmForm' FormSettings
                         { formMethod = POST
@@ -1231,6 +1237,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
                          <section>
                            ^{csvReImport}
                        |]
+              other -> throwM other
           , Catch.Handler $ \(csvParseError :: CsvParseError)
               -> liftHandler $ sendResponseStatus badRequest400 =<< do
                    mr <- getMessageRender
@@ -1389,18 +1396,29 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
       ]
 
   ((csvImportConfirmRes, _confirmView), _enctype) <- case dbtCsvDecode of
-    Just (DBTCsvDecode{dbtCsvExecuteActions} :: DBTCsvDecode r' k' csv) -> do
+    Just (DBTCsvDecode{dbtCsvExecuteActions, dbtCsvValidateActions} :: DBTCsvDecode r' k' csv) -> do
       lift . runFormPost . withButtonForm' [BtnCsvImportConfirm, BtnCsvImportAbort] . identifyForm (FIDDBTableCsvImportConfirm dbtIdent) $ \_csrf -> do
+        availableActs <- fromMaybe Set.empty <$> globalPostParamField PostDBCsvImportAvailableActions secretJsonField
         acts <- globalPostParamFields PostDBCsvImportAction secretJsonField
-        return . (, mempty) $ if
+        return . (, mempty) . FormSuccess $ if
-          | null acts -> FormSuccess $ do
+          | unavailableActs <- filter (`Set.notMember` availableActs) acts
-              addMessageI Info MsgCsvImportAborted
+          , not $ null unavailableActs -> do
-              redirect $ tblLink id
+              throwM . DBCsvUnavailableActionRequested @k' . Set.fromList $ map toJSON unavailableActs
-          | otherwise -> FormSuccess $ do
+          | otherwise -> do
-              finalDest <- runDBJobs' . runConduit $ C.sourceList acts .| dbtCsvExecuteActions
+              (acts', validationMsgs) <- execRWST dbtCsvValidateActions availableActs acts
-              addMessageI Success . MsgCsvImportSuccessful $ length acts
+              if | not $ null validationMsgs -> do
-              E.transactionSave
+                     mapM_ addMessage' validationMsgs
-              redirect finalDest
+                     E.transactionUndo
+                     redirect $ tblLink id
+                 | null acts' -> do
+                     addMessageI Info MsgCsvImportAborted
+                     redirect $ tblLink id
+                 | otherwise -> do
+                     finalDest <- runDBJobs' . runConduit $ C.sourceList acts' .| dbtCsvExecuteActions
+                     addMessageI Success . MsgCsvImportSuccessful $ length acts'
+                     E.transactionSave
+                     redirect finalDest
+              
     _other -> return ((FormMissing, mempty), mempty)
   formResult csvImportConfirmRes $ \case
     (_, BtnCsvImportAbort) -> do

src/Utils.hs

@@ -884,6 +884,9 @@ tellM = tell <=< lift
 
 tellPoint :: (MonadWriter mono m, MonoPointed mono) => Element mono -> m ()
 tellPoint = tell . opoint
+  
+tellMPoint :: (MonadTrans t, MonadWriter mono (t m), Monad m, MonoPointed mono) => m (Element mono) -> t m ()
+tellMPoint = tellM . fmap opoint
 
 -------------
 -- Conduit --

src/Utils/Parameters.hs

@@ -57,7 +57,7 @@ data GlobalPostParam = PostFormIdentifier
                      | PostDeleteTarget
                      | PostMassInputShape
                      | PostBearer
-                     | PostDBCsvImportAction
+                     | PostDBCsvImportAction | PostDBCsvImportAvailableActions
                      | PostDBCsvReImport
                      | PostLoginDummy
                      | PostExamAutoOccurrencePrevious

templates/csv-import-confirmation.hamlet

@@ -1,5 +1,6 @@
 $newline never
 #{csrf}
+^{availableActs}
 <div .actions>
   $forall actionClass <- sortOn dbtCsvCoarsenActionClass (Map.keys actionMap)
     <div .action>