diff --git a/frontend/src/app.sass b/frontend/src/app.sass index 9029b76c5..3da114507 100644 --- a/frontend/src/app.sass +++ b/frontend/src/app.sass @@ -403,6 +403,9 @@ input[type="button"].btn-info:not(.btn-link):hover, font-weight: 600 color: var(--color-fontsec) +.table__td--tooltip + width: 2em + .table__td font-size: 16px color: var(--color-font) diff --git a/messages/uniworx/misc/de-de-formal.msg b/messages/uniworx/misc/de-de-formal.msg index 341acec97..b8a3e8ebd 100644 --- a/messages/uniworx/misc/de-de-formal.msg +++ b/messages/uniworx/misc/de-de-formal.msg @@ -404,6 +404,8 @@ SubmissionFilesCorrected: Abgegebene & Korrigierte Dateien RatingUpdatedFiles: Bei der Korrektur wurden Dateien angepasst oder hinzugefügt SubmissionFilesUnchanged: Abgabedateien beibehalten SubmissionFilesUnchangedTip: Sollen die bestehenden Abgabedateien beim Ersetzen der Abgabe unverändert übernommen werden? +SubmissionUserDuplicateWarning: Dieser Teilnehmende ist bereits an einer anderen Abgabe beteiligt +SubmissionSomeUsersDuplicateWarning: Manche Abgebende sind auch an einer anderen Abgabe beteiligt SubmissionsDeleteQuestion n@Int: Wollen Sie #{pluralDE n "die unten aufgeführte Abgabe" "die unten aufgeführten Abgaben"} wirklich löschen? SubmissionsDeleted n@Int: #{pluralDE n "Abgabe gelöscht" "Abgaben gelöscht"} diff --git a/messages/uniworx/misc/en-eu.msg b/messages/uniworx/misc/en-eu.msg index f92661d7a..dde4e0b5e 100644 --- a/messages/uniworx/misc/en-eu.msg +++ b/messages/uniworx/misc/en-eu.msg @@ -402,6 +402,8 @@ SubmissionFilesCorrected: Submitted & Corrected files RatingUpdatedFiles: During correction files were added or changed SubmissionFilesUnchanged: Keep submission files SubmissionFilesUnchangedTip: Should the existing submission files be retained unchanged while replacing the submission? +SubmissionUserDuplicateWarning: This participant is already a submittor for a different submission +SubmissionSomeUsersDuplicateWarning: Some submittors are also submittors for a different submission SubmissionsDeleteQuestion n: Do you really want to delete the #{pluralEN n "submission" "submissions"} mentioned below? SubmissionsDeleted n: #{pluralEN n "Submission" "Submissions"} deleted diff --git a/src/Handler/Submission/Helper.hs b/src/Handler/Submission/Helper.hs index 3044c2d2c..749f80ffb 100644 --- a/src/Handler/Submission/Helper.hs +++ b/src/Handler/Submission/Helper.hs @@ -32,8 +32,8 @@ import Handler.Submission.SubmissionUserInvite import qualified Data.Conduit.Combinators as C -makeSubmissionForm :: CourseId -> Maybe SubmissionId -> UploadMode -> SheetGroup -> Maybe FileUploads -> Bool -> Set (Either UserEmail UserId) -> Form (Maybe FileUploads, Set (Either UserEmail UserId)) -makeSubmissionForm cid msmid uploadMode grouping mPrev isLecturer prefillUsers = identifyForm FIDsubmission . renderAForm FormStandard $ (,) +makeSubmissionForm :: CourseId -> SheetId -> Maybe SubmissionId -> UploadMode -> SheetGroup -> Maybe FileUploads -> Bool -> Set (Either UserEmail UserId) -> Form (Maybe FileUploads, Set (Either UserEmail UserId)) +makeSubmissionForm cid shid msmid uploadMode grouping mPrev isLecturer prefillUsers = identifyForm FIDsubmission . renderAForm FormStandard $ (,) <$> uploadForm <*> wFormToAForm submittorsForm' where @@ -51,7 +51,17 @@ makeSubmissionForm cid msmid uploadMode grouping mPrev isLecturer prefillUsers = | otherwise -> MsgEmailInvitationWarningPrevCoSubmittors $(widgetFile "widgets/massinput/submissionUsers/cellInvitation") miCell' csrf (Right uid) = do - User{..} <- liftHandler . runDB $ getJust uid + (User{..}, hasSubmitted) <- liftHandler . runDB $ do + user <- getJust uid + hasSubmitted <- E.selectExists . E.from $ \(submissionUser `E.InnerJoin` submission) -> do + E.on $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId + E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val uid + E.&&. submission E.^. SubmissionSheet E.==. E.val shid + whenIsJust msmid $ \smid -> + E.where_ $ submission E.^. SubmissionId E.!=. E.val smid + return (user, hasSubmitted) + knownWarning <- runMaybeT $ + guardOnM hasSubmitted $ messageIconI Error IconSubmissionUserDuplicate MsgSubmissionUserDuplicateWarning $(widgetFile "widgets/massinput/submissionUsers/cellKnown") miLayout :: ListLength @@ -319,9 +329,9 @@ submissionHelper tid ssh csh shn mcid = do -- @submissionModeUser == Nothing@ below iff we are currently serving a user with elevated rights (lecturer, admin, ...) -- Therefore we do not restrict upload behaviour in any way in that case ((res,formWidget'), formEnctype) <- do - (Entity _ Sheet{..}, buddies, _, _, isLecturer, isOwner, _, _) <- runDB getSheetInfo + (Entity shid Sheet{..}, buddies, _, _, isLecturer, isOwner, _, _) <- runDB getSheetInfo let mPrevUploads = msmid <&> \smid -> runDBSource $ selectSource [SubmissionFileSubmission ==. smid, SubmissionFileIsUpdate ==. False] [Asc SubmissionFileTitle] .| C.map (view $ _FileReference . _1) - runFormPost . makeSubmissionForm sheetCourse msmid (fromMaybe (UploadAny True Nothing True) . submissionModeUser $ sheetSubmissionMode) sheetGrouping mPrevUploads isLecturer $ bool id (maybe id (Set.insert . Right) muid) isOwner buddies + runFormPost . makeSubmissionForm sheetCourse shid msmid (fromMaybe (UploadAny True Nothing True) . submissionModeUser $ sheetSubmissionMode) sheetGrouping mPrevUploads isLecturer $ bool id (maybe id (Set.insert . Right) muid) isOwner buddies let formWidget = wrapForm' BtnHandIn formWidget' def { formAction = Just $ SomeRoute actionUrl , formEncoding = formEnctype @@ -360,6 +370,7 @@ submissionHelper tid ssh csh shn mcid = do (FormFailure failmsgs) -> return $ FormFailure failmsgs (FormSuccess res'@(_, groupMembers)) | groupMembers == subUsersOld -> return $ FormSuccess res' + | isLecturer -> return $ FormSuccess res' | Arbitrary{..} <- sheetGrouping -> do -- Validate AdHoc Group Members let (gEMails, gIds) = partitionEithers $ Set.toList groupMembers prep :: [(E.Value UserEmail, (E.Value UserId, E.Value Bool, E.Value Bool))] -> Map UserEmail (Maybe (UserId, Bool, Bool)) @@ -486,7 +497,7 @@ submissionHelper tid ssh csh shn mcid = do | otherwise -> redirect $ CSheetR tid ssh csh shn SShowR Nothing -> return () - (Entity _ Sheet{..}, _, lastEdits, maySubmit, _, _, msubmission, corrector) <- runDB getSheetInfo + (Entity shid Sheet{..}, _, lastEdits, maySubmit, _, _, msubmission, corrector) <- runDB getSheetInfo (showCorrection, correctionInvisible) <- fmap (fromMaybe (False, Nothing)) . for ((,) <$> mcid <*> (Entity <$> msmid <*> msubmission)) $ \(cid, subEnt) -> runDB $ do showCorrection <- hasReadAccessTo $ CSubmissionR tid ssh csh shn cid CorrectionR @@ -565,6 +576,22 @@ submissionHelper tid ssh csh shn mcid = do sheetTypeDesc <- liftHandler . runDB $ sheetTypeDescription sheetCourse sheetType + multipleSubmissionWarnWidget <- runDB . runMaybeT $ do + subId <- hoistMaybe msmid + cID <- hoistMaybe mcid + guardM . lift $ orM + [ hasWriteAccessTo $ CSubmissionR tid ssh csh shn cID SubDelR + , hasWriteAccessTo $ CSubmissionR tid ssh csh shn cID SubShowR + ] + guardM . lift . E.selectExists . E.from $ \(submissionUser `E.InnerJoin` (otherSubmissionUser `E.InnerJoin` submission)) -> do + E.on $ otherSubmissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId + E.on $ submissionUser E.^. SubmissionUserSubmission E.!=. otherSubmissionUser E.^. SubmissionUserSubmission + E.&&. submissionUser E.^. SubmissionUserUser E.==. otherSubmissionUser E.^. SubmissionUserUser + E.where_ $ submission E.^. SubmissionSheet E.==. E.val shid + E.&&. submission E.^. SubmissionId E.!=. E.val subId + E.&&. submissionUser E.^. SubmissionUserSubmission E.==. E.val subId + return $ notification NotificationBroad =<< messageIconI Warning IconSubmissionUserDuplicate MsgSubmissionSomeUsersDuplicateWarning + defaultLayout $ do setTitleI $ MsgSubmissionEditHead tid ssh csh shn (urlArchive, urlOriginal) <- fmap ((,) <$> preview (_Just . _1) <*> preview (_Just . _2)) . for mcid $ \cID diff --git a/src/Utils/Icon.hs b/src/Utils/Icon.hs index 36904d962..dc1c46e8b 100644 --- a/src/Utils/Icon.hs +++ b/src/Utils/Icon.hs @@ -92,6 +92,7 @@ data Icon | IconPersonalIdentification | IconMenuWorkflows | IconVideo + | IconSubmissionUserDuplicate deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable) iconText :: Icon -> Text @@ -164,6 +165,7 @@ iconText = \case IconPersonalIdentification -> "id-card" IconMenuWorkflows -> "project-diagram" IconVideo -> "video" + IconSubmissionUserDuplicate -> "copy" instance Universe Icon instance Finite Icon diff --git a/templates/submission.hamlet b/templates/submission.hamlet index 7e1096ff3..4d8e79cd5 100644 --- a/templates/submission.hamlet +++ b/templates/submission.hamlet @@ -8,6 +8,8 @@ $if is _Just mcid ^{warning} ^{wdgt} + + ^{maybeVoid multipleSubmissionWarnWidget}
$case sheetSubmissionMode diff --git a/templates/widgets/massinput/examCorrectors/cellInvitation.hamlet b/templates/widgets/massinput/examCorrectors/cellInvitation.hamlet index 284762127..d82845273 100644 --- a/templates/widgets/massinput/examCorrectors/cellInvitation.hamlet +++ b/templates/widgets/massinput/examCorrectors/cellInvitation.hamlet @@ -2,5 +2,5 @@ $newline never #{email} - + ^{messageTooltip invWarnMsg} diff --git a/templates/widgets/massinput/examOfficeUsers/cellInvitation.hamlet b/templates/widgets/massinput/examOfficeUsers/cellInvitation.hamlet index 5b4ba5e51..c8a8cfd70 100644 --- a/templates/widgets/massinput/examOfficeUsers/cellInvitation.hamlet +++ b/templates/widgets/massinput/examOfficeUsers/cellInvitation.hamlet @@ -2,5 +2,5 @@ #{email} - + ^{messageTooltip invWarnMsg} diff --git a/templates/widgets/massinput/submissionUsers/cellInvitation.hamlet b/templates/widgets/massinput/submissionUsers/cellInvitation.hamlet index 9e991062e..9fd5ad9cb 100644 --- a/templates/widgets/massinput/submissionUsers/cellInvitation.hamlet +++ b/templates/widgets/massinput/submissionUsers/cellInvitation.hamlet @@ -3,5 +3,5 @@ #{csrf} #{email} - + ^{messageTooltip invWarnMsg} diff --git a/templates/widgets/massinput/submissionUsers/cellKnown.hamlet b/templates/widgets/massinput/submissionUsers/cellKnown.hamlet index f6d3beaef..28a46351f 100644 --- a/templates/widgets/massinput/submissionUsers/cellKnown.hamlet +++ b/templates/widgets/massinput/submissionUsers/cellKnown.hamlet @@ -1,4 +1,11 @@ $newline never - - #{csrf} - ^{nameEmailWidget userEmail userDisplayName userSurname} +$maybe wrn <- knownWarning + + #{csrf} + ^{nameEmailWidget userEmail userDisplayName userSurname} + + ^{messageTooltip wrn} +$nothing + + #{csrf} + ^{nameEmailWidget userEmail userDisplayName userSurname}