diff --git a/frontend/src/app.sass b/frontend/src/app.sass index 41bc84929..0e71e6f8d 100644 --- a/frontend/src/app.sass +++ b/frontend/src/app.sass @@ -567,15 +567,14 @@ ul.list--inline .deflist__dt font-weight: 600 + font-size: 1.12em + margin-bottom: .6em .deflist__explanation color: var(--color-fontsec) - font-size: 0.9rem + font-size: 0.9em .deflist__dd - font-size: 18px - margin-bottom: 10px - > p, > .div-p margin-top: 0 @@ -592,9 +591,13 @@ ul.list--inline .deflist__dt, .deflist__dd - padding: 12px 0 + padding: .75em 0 margin: 0 - font-size: 16px + font-size: unset + + .explanation & + padding-top: 0 + padding-bottom: 0 &:last-of-type border: 0 diff --git a/messages/uniworx/categories/courses/submission/de-de-formal.msg b/messages/uniworx/categories/courses/submission/de-de-formal.msg index 16cd74988..effc3d615 100644 --- a/messages/uniworx/categories/courses/submission/de-de-formal.msg +++ b/messages/uniworx/categories/courses/submission/de-de-formal.msg @@ -62,6 +62,7 @@ SubmissionCreated: Abgabe erfolgreich angelegt SubmissionUpdated: Abgabe erfolgreich ersetzt SubmissionUsersUpdated: Liste von Abgebenden erfolgreich angepasst SubmissionUnchanged: Abgabe unverändert +SubmissionUpdatedAuthorshipStatement: Eigenständigkeitserklärung erfolgreich aktualisiert FileCorrected: Korrigiert (Dateien) Corrected: Korrigiert HeadingSubmissionEditHead tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: #{tid}-#{ssh}-#{csh} #{sheetName}: Abgabe editieren/anlegen @@ -206,4 +207,9 @@ SubmissionCoSubmittorsInviteRequiredBecauseAuthorshipStatements: Da für die Abg SubmissionUserTable: Abgebende SubmissionUserDisplayName !ident-ok: Name SubmissionUserMatriculation: Matrikelnummer -SubmissionUserEmail: E-Mail \ No newline at end of file +SubmissionUserEmail: E-Mail +SubmissionUserAuthorshipStatementState: Eigenständigkeitserklärung + +SubmissionAuthorshipStatementStateOkay: In Ordnung +SubmissionAuthorshipStatementStateOldStatement: Unpassender Wortlaut +SubmissionAuthorshipStatementStateMissing: Fehlt \ No newline at end of file diff --git a/messages/uniworx/categories/courses/submission/en-eu.msg b/messages/uniworx/categories/courses/submission/en-eu.msg index 67e8ad1a7..2e2c5a7d5 100644 --- a/messages/uniworx/categories/courses/submission/en-eu.msg +++ b/messages/uniworx/categories/courses/submission/en-eu.msg @@ -60,6 +60,7 @@ SubmissionCreated: Successfully created submission SubmissionUpdated: Successfully replaced submission SubmissionUsersUpdated: Successfully changed list of submittors SubmissionUnchanged: Submission unchanged +SubmissionUpdatedAuthorshipStatement: Successfully updated Statement of Authorship FileCorrected: Marked (files) Corrected: Marked HeadingSubmissionEditHead tid ssh csh sheetName: #{tid}-#{ssh}-#{csh} #{sheetName}: Edit/Create submission @@ -206,3 +207,8 @@ SubmissionUserTable: Submittors SubmissionUserDisplayName: Name SubmissionUserMatriculation: Matriculation SubmissionUserEmail: Email +SubmissionUserAuthorshipStatementState: Statement of Authorship + +SubmissionAuthorshipStatementStateOkay: Okay +SubmissionAuthorshipStatementStateOldStatement: Wrong wording +SubmissionAuthorshipStatementStateMissing: Missing diff --git a/src/Handler/Submission/Helper.hs b/src/Handler/Submission/Helper.hs index e70e89308..36f28f1e1 100644 --- a/src/Handler/Submission/Helper.hs +++ b/src/Handler/Submission/Helper.hs @@ -31,10 +31,22 @@ import Handler.Submission.SubmissionUserInvite import qualified Data.Conduit.Combinators as C +data AuthorshipStatementSubmissionState + = ASOkay + | ASOldStatement + | ASMissing + deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) + deriving anyclass (Universe, Finite) + +nullaryPathPiece ''AuthorshipStatementSubmissionState $ camelToPathPiece' 1 + +embedRenderMessage ''UniWorX ''AuthorshipStatementSubmissionState $ concat . ("SubmissionAuthorshipStatementState" :) . drop 1 . splitCamel + + makeSubmissionForm :: forall m. (MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m) - => CourseId -> Entity Sheet -> Maybe SubmissionId -> UploadMode -> SheetGroup -> Maybe FileUploads -> Bool -> Set (Either UserEmail UserId) + => CourseId -> SheetId -> Maybe (Entity AuthorshipStatementDefinition) -> Maybe SubmissionId -> UploadMode -> SheetGroup -> Maybe FileUploads -> Bool -> Set (Either UserEmail UserId) -> (Markup -> MForm (ReaderT SqlBackend m) (FormResult (Maybe FileUploads, Set (Either UserEmail UserId), Maybe AuthorshipStatementDefinitionId), Widget)) -makeSubmissionForm cid sheetEnt@(Entity shid _) msmid uploadMode grouping mPrev isLecturer prefillUsers = identifyForm FIDsubmission . renderWForm FormStandard $ do +makeSubmissionForm cid shid mASDefinition msmid uploadMode grouping mPrev isLecturer prefillUsers = identifyForm FIDsubmission . renderWForm FormStandard $ do uploadRes <- aFormToWForm uploadForm submittorsRes <- submittorsForm' lecturerIsSubmittor <- case submittorsRes of @@ -48,7 +60,7 @@ makeSubmissionForm cid sheetEnt@(Entity shid _) msmid uploadMode grouping mPrev authorshipStatementForm :: Bool -> WForm (ReaderT SqlBackend m) (FormResult (Maybe AuthorshipStatementDefinitionId)) authorshipStatementForm lecturerIsSubmittor = maybeT (return $ FormSuccess Nothing) $ do - asd <- MaybeT . lift . lift $ getSheetAuthorshipStatement sheetEnt + asd <- hoistMaybe mASDefinition let authorshipStatementForm' = apopt (acceptAuthorshipStatementField asd) (fslI MsgSubmissionAuthorshipStatement & setTooltip MsgSubmissionAuthorshipStatementTip) Nothing authorshipStatementRes <- lift . hoist (hoist liftHandler) $ if | isLecturer @@ -178,7 +190,7 @@ makeSubmissionForm cid sheetEnt@(Entity shid _) msmid uploadMode grouping mPrev | otherwise = do uid <- liftHandler requireAuthId mRoute <- getCurrentRoute - doAuthorshipStatements <- lift . lift $ is _Just <$> getSheetAuthorshipStatement sheetEnt + let doAuthorshipStatements = is _Just mASDefinition prefillUsers' <- lift . lift . fmap catMaybes . for (Set.toList prefillUsers) $ \case Right uid' | doAuthorshipStatements @@ -265,6 +277,7 @@ submissionHelper tid ssh csh shn mcid = do let getSheetInfo = do csheet@(Entity shid Sheet{..}) <- fetchSheet tid ssh csh shn + mASDefinition <- getSheetAuthorshipStatement csheet maySubmit <- (== Authorized) <$> evalAccessDB actionUrl True isLecturer <- (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh shn SSubsR) True @@ -297,6 +310,7 @@ submissionHelper tid ssh csh shn mcid = do , isLecturer , not isLecturer , Nothing, Nothing + , mASDefinition ) (Nothing, RegisteredGroups) -> do buddies <- E.select . E.from $ \(submissionGroup `E.InnerJoin` user) -> do @@ -326,8 +340,9 @@ submissionHelper tid ssh csh shn mcid = do , isLecturer , not isLecturer , Nothing, Nothing + , mASDefinition ) - (Nothing, _) -> return (csheet, Set.empty, [], maySubmit, isLecturer, not isLecturer, Nothing, Nothing) + (Nothing, _) -> return (csheet, Set.empty, [], maySubmit, isLecturer, not isLecturer, Nothing, Nothing, mASDefinition) (Just smid, _) -> do void $ submissionMatchesSheet tid ssh csh shn (fromJust mcid) @@ -364,14 +379,14 @@ submissionHelper tid ssh csh shn mcid = do corrector <- join <$> traverse getEntity submissionRatingBy - return (csheet,buddies,lastEdits,maySubmit,isLecturer,isOwner,Just sub,corrector) + return (csheet,buddies,lastEdits,maySubmit,isLecturer,isOwner,Just sub,corrector,mASDefinition) -- @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 ((formWidget', formEnctype), mAct) <- runDBJobs . setSerializable $ do - (sheet@(Entity shid Sheet{..}), buddies, _, _, isLecturer, isOwner, msubmission, _) <- hoist lift getSheetInfo + (Entity shid Sheet{..}, buddies, _, _, isLecturer, isOwner, msubmission, _, mASDefinition) <- hoist lift getSheetInfo let mPrevUploads = msmid <&> \smid -> runDBSource $ selectSource [SubmissionFileSubmission ==. smid, SubmissionFileIsUpdate ==. False] [Asc SubmissionFileTitle] .| C.map (view $ _FileReference . _1) - ((res, formWidget'), formEnctype) <- hoist lift . runFormPost . makeSubmissionForm sheetCourse sheet msmid (fromMaybe (UploadAny True Nothing True) . submissionModeUser $ sheetSubmissionMode) sheetGrouping mPrevUploads isLecturer $ bool id (maybe id (Set.insert . Right) muid) isOwner buddies + ((res, formWidget'), formEnctype) <- hoist lift . runFormPost . makeSubmissionForm sheetCourse shid mASDefinition msmid (fromMaybe (UploadAny True Nothing True) . submissionModeUser $ sheetSubmissionMode) sheetGrouping mPrevUploads isLecturer $ bool id (maybe id (Set.insert . Right) muid) isOwner buddies -- Calling `msgSubmissionErrors` within a `runDB` is okay as long as we handle `transactionUndo` ourselves iff it returns nothing mAct' <- msgSubmissionErrors $ do @@ -520,14 +535,22 @@ submissionHelper tid ssh csh shn mcid = do unless (Just subUid == muid) $ queueDBJob . JobQueueNotification $ NotificationSubmissionUserDeleted subUid shid smid + hasAuthorshipStatement <- maybeT (return True) $ do + uid <- hoistMaybe muid + asDId <- hoistMaybe mASDId + lift $ exists [AuthorshipStatementSubmissionStatement ==. asDId, AuthorshipStatementSubmissionSubmission ==. smid, AuthorshipStatementSubmissionUser ==. uid] + forM_ mASDId $ \asdId -> do uid <- maybe notAuthenticated return muid insert_ $ AuthorshipStatementSubmission asdId smid uid now - if | is _Nothing msmid -> addMessageI Success MsgSubmissionCreated - | is _Just mFiles -> addMessageI Success MsgSubmissionUpdated - | subUsers == subUsersOld -> addMessageI Info MsgSubmissionUnchanged - | otherwise -> addMessageI Success MsgSubmissionUsersUpdated + + if | is _Nothing msmid -> addMessageI Success MsgSubmissionCreated + | is _Just mFiles -> addMessageI Success MsgSubmissionUpdated + | subUsers == subUsersOld + , not hasAuthorshipStatement -> addMessageI Success MsgSubmissionUpdatedAuthorshipStatement + | subUsers == subUsersOld -> addMessageI Info MsgSubmissionUnchanged + | otherwise -> addMessageI Success MsgSubmissionUsersUpdated cID <- encrypt smid let showRoute = CSubmissionR tid ssh csh shn cID SubShowR @@ -547,8 +570,8 @@ submissionHelper tid ssh csh shn mcid = do , formEncoding = formEnctype } - ((Entity _ Sheet{..}, _, lastEdits, maySubmit, _, _, msubmission, corrector), (showCorrection, correctionInvisible), mFileTable, filesCorrected, sheetTypeDesc, multipleSubmissionWarnWidget, subUsers, isLecturer) <- runDB $ do - sheetInfo@(Entity shid Sheet{..}, buddies, _, _, isLecturer, isOwner, msubmission, _) <- getSheetInfo + ((Entity _ Sheet{..}, _, lastEdits, maySubmit, _, _, msubmission, corrector, _), (showCorrection, correctionInvisible), mFileTable, filesCorrected, sheetTypeDesc, multipleSubmissionWarnWidget, subUsers, isLecturer, doAuthorshipStatements) <- runDB $ do + sheetInfo@(Entity shid Sheet{..}, buddies, _, _, isLecturer, isOwner, msubmission, _, mASDefinition) <- getSheetInfo (showCorrection, correctionInvisible) <- fmap (fromMaybe (False, Nothing)) . for ((,) <$> mcid <*> (Entity <$> msmid <*> msubmission)) $ \(cid, subEnt) -> do showCorrection <- hasReadAccessTo $ CSubmissionR tid ssh csh shn cid CorrectionR @@ -581,14 +604,36 @@ submissionHelper tid ssh csh shn mcid = do E.&&. submissionUser E.^. SubmissionUserSubmission E.==. E.val subId return $ notification NotificationBroad =<< messageIconI Warning IconSubmissionUserDuplicate MsgSubmissionSomeUsersDuplicateWarning - subUsers <- do - let subUsers' = Set.toList $ bool id (maybe id (Set.insert . Right) muid) isOwner buddies - subUsers'' <- forMOf (traverse . _Right) subUsers' $ \uid -> (,) <$> (encrypt uid :: DB CryptoUUIDUser) <*> getJust uid - return $ subUsers'' - & sortOn (over _Right $ (,,,) <$> views _2 userSurname <*> views _2 userDisplayName <*> views _2 userEmail <*> view _1) + subUsers <- maybeT (return []) $ do + subId <- hoistMaybe msmid + let + getUserAuthorshipStatement :: UserId + -> DB AuthorshipStatementSubmissionState + getUserAuthorshipStatement uid = runConduit $ + getStmts + .| fmap toRes (execWriterC . C.mapM_ $ tell . toPoint) + where + getStmts = E.selectSource . E.from $ \authorshipStatementSubmission -> do + E.where_ $ authorshipStatementSubmission E.^. AuthorshipStatementSubmissionSubmission E.==. E.val subId + E.&&. authorshipStatementSubmission E.^. AuthorshipStatementSubmissionUser E.==. E.val uid + return authorshipStatementSubmission + toPoint :: Entity AuthorshipStatementSubmission -> Maybe Any + toPoint (Entity _ AuthorshipStatementSubmission{..}) = Just . Any $ fmap entityKey mASDefinition == Just authorshipStatementSubmissionStatement + toRes :: Maybe Any -> AuthorshipStatementSubmissionState + toRes = \case + Just (Any True) -> ASOkay + Just (Any False) -> ASOldStatement + Nothing -> ASMissing + lift $ buddies + & bool id (maybe id (Set.insert . Right) muid) isOwner + & Set.toList + & mapMOf (traverse . _Right) (\uid -> (,,) <$> (encrypt uid :: DB CryptoUUIDUser) <*> getJust uid <*> getUserAuthorshipStatement uid) + & fmap (sortOn . over _Right $ (,,,) <$> views _2 userSurname <*> views _2 userDisplayName <*> views _2 userEmail <*> view _1) - return (sheetInfo, (showCorrection, correctionInvisible), mFileTable, filesCorrected, sheetTypeDesc, multipleSubmissionWarnWidget, subUsers, isLecturer) + return (sheetInfo, (showCorrection, correctionInvisible), mFileTable, filesCorrected, sheetTypeDesc, multipleSubmissionWarnWidget, subUsers, isLecturer, is _Just mASDefinition) + -- TODO(AuthorshipStatements): discuss whether to display prompt for user to update their authorship statement, if lecturer changed it + defaultLayout $ do setTitleI $ MsgHeadingSubmissionEditHead tid ssh csh shn (urlArchive, urlOriginal) <- fmap ((,) <$> preview (_Just . _1) <*> preview (_Just . _2)) . for mcid $ \cID @@ -603,4 +648,9 @@ submissionHelper tid ssh csh shn mcid = do , is _Just submissionRatingPoints, is _Just submissionRatingComment ] correctionVisibleWarnWidget = guardOnM (is _Just msubmission && is _Just mcid && showCorrection) correctionInvisible + asStatusExplain = $(i18nWidgetFiles "authorship-statement-submission-explanation") + asStatuses = setOf (folded . _Right . _3) subUsers + & Set.union (Set.fromList [ASOkay, ASMissing]) + & Set.toList + & mapMaybe (\stmt -> (stmt, ) <$> asStatusExplain Map.!? toPathPiece stmt) $(widgetFile "submission") diff --git a/templates/i18n/authorship-statement-submission-explanation/missing.de-de-formal.hamlet b/templates/i18n/authorship-statement-submission-explanation/missing.de-de-formal.hamlet new file mode 100644 index 000000000..ad2d01c9d --- /dev/null +++ b/templates/i18n/authorship-statement-submission-explanation/missing.de-de-formal.hamlet @@ -0,0 +1,2 @@ +$newline never +Keine Eigenständigkeitserklärung vorhanden. diff --git a/templates/i18n/authorship-statement-submission-explanation/missing.en-eu.hamlet b/templates/i18n/authorship-statement-submission-explanation/missing.en-eu.hamlet new file mode 100644 index 000000000..fb12c3633 --- /dev/null +++ b/templates/i18n/authorship-statement-submission-explanation/missing.en-eu.hamlet @@ -0,0 +1,2 @@ +$newline never +No Statement of Authorship exists. diff --git a/templates/i18n/authorship-statement-submission-explanation/okay.de-de-formal.hamlet b/templates/i18n/authorship-statement-submission-explanation/okay.de-de-formal.hamlet new file mode 100644 index 000000000..897ec7ade --- /dev/null +++ b/templates/i18n/authorship-statement-submission-explanation/okay.de-de-formal.hamlet @@ -0,0 +1,2 @@ +$newline never +Eigenständigkeitserklärung ist vorhanden und entspricht dem aktuell geforderten Wortlaut. diff --git a/templates/i18n/authorship-statement-submission-explanation/okay.en-eu.hamlet b/templates/i18n/authorship-statement-submission-explanation/okay.en-eu.hamlet new file mode 100644 index 000000000..8bd4c7b4b --- /dev/null +++ b/templates/i18n/authorship-statement-submission-explanation/okay.en-eu.hamlet @@ -0,0 +1,2 @@ +$newline never +Statement of Authorship exists and matches the wording as currently required. diff --git a/templates/i18n/authorship-statement-submission-explanation/old-statement.de-de-formal.hamlet b/templates/i18n/authorship-statement-submission-explanation/old-statement.de-de-formal.hamlet new file mode 100644 index 000000000..c3215f2dc --- /dev/null +++ b/templates/i18n/authorship-statement-submission-explanation/old-statement.de-de-formal.hamlet @@ -0,0 +1,2 @@ +$newline never +Eigenständigkeitserklärung ist zwar vorhanden, entspricht aber nicht dem aktuell geforderten Wortlaut. diff --git a/templates/i18n/authorship-statement-submission-explanation/old-statement.en-eu.hamlet b/templates/i18n/authorship-statement-submission-explanation/old-statement.en-eu.hamlet new file mode 100644 index 000000000..09ca727fe --- /dev/null +++ b/templates/i18n/authorship-statement-submission-explanation/old-statement.en-eu.hamlet @@ -0,0 +1,2 @@ +$newline never +Statement of Authorship exists but does not match the wording as currently required. diff --git a/templates/submission.hamlet b/templates/submission.hamlet index c13d87f0e..d08823b91 100644 --- a/templates/submission.hamlet +++ b/templates/submission.hamlet @@ -18,41 +18,70 @@ $if is _Just mcid $if not (null subUsers)
- - + - - + $forall subUser <- subUsers + $case subUser + $of Left email + + + +
-
- _{MsgSubmissionUserDisplayName} - $if isLecturer +
- _{MsgSubmissionUserMatriculation} -
-
- _{MsgSubmissionUserEmail} - $forall subUser <- subUsers - $case subUser - $of Left email -
- -
-
- ^{simpleLink (nameWidget userDisplayName userSurname) (CourseR tid ssh csh (CUserR uCId))} - $if isLecturer + _{MsgSubmissionUserDisplayName} + $if isLecturer +
+
+ _{MsgSubmissionUserMatriculation} +
+
+ _{MsgSubmissionUserEmail} + $if isLecturer && doAuthorshipStatements +
+
+ _{MsgSubmissionUserAuthorshipStatementState} +
+ $if isLecturer + + + + $of Right (uCId, User{userDisplayName, userSurname, userEmail, userMatrikelnummer}, stmt) +
- $maybe matriculation <- userMatrikelnummer - #{matriculation} -
- +
+ $maybe matriculation <- userMatrikelnummer + #{matriculation} +
+ +
+ _{stmt} + $if isLecturer && doAuthorshipStatements +
+ + + +
+
+ $forall (stmt, explanation) <- asStatuses +
+ _{stmt} +
+ ^{explanation} +
$case sheetSubmissionMode $of SubmissionMode False Nothing @@ -88,8 +117,6 @@ $if is _Just mcid $nothing
  • #{time} - $# TODO(AuthorshipStatements): show statements confirmed (iff display is not anonymous (lecturer/submittor/non-anonymous corrector)?) - $if maySubmit

    _{MsgSubmissionReplace}