From 34b3e6ae21b38a5b8389deade5deeb77b0981ead Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sat, 17 Jul 2021 23:53:08 +0200 Subject: [PATCH] feat: demand authorship statements --- frontend/src/app.sass | 32 +++ .../courses/exam/exam/de-de-formal.msg | 4 +- .../categories/courses/sheet/de-de-formal.msg | 8 +- .../categories/courses/sheet/en-eu.msg | 6 + .../courses/submission/de-de-formal.msg | 9 +- .../categories/courses/submission/en-eu.msg | 9 +- .../authorship_statement/de-de-formal.msg | 2 + .../utils/authorship_statement/en-eu.msg | 2 + models/authorship-statements.model | 19 +- models/sheets.model | 2 + src/Foundation/I18n.hs | 16 +- src/Handler/Exam/Edit.hs | 16 +- src/Handler/Exam/Form.hs | 29 +-- src/Handler/Exam/New.hs | 4 +- src/Handler/School.hs | 29 +-- src/Handler/Sheet/Edit.hs | 8 +- src/Handler/Sheet/Form.hs | 203 +++++++++++++----- src/Handler/Sheet/New.hs | 65 +++--- src/Handler/Submission/Helper.hs | 86 ++++++-- .../Submission/SubmissionUserInvite.hs | 16 +- src/Handler/Utils.hs | 1 + src/Handler/Utils/AuthorshipStatement.hs | 116 ++++++++++ src/Handler/Utils/Form.hs | 60 ++++-- src/Model/Types/Markup.hs | 4 +- src/Model/Types/School.hs | 30 ++- src/Model/Types/Sheet.hs | 15 ++ src/Text/Blaze/Instances.hs | 6 + src/Utils/Form.hs | 12 ++ src/Utils/Lens.hs | 4 + .../authorship-statements.de-de-formal.hamlet | 2 + .../authorship-statements.en-eu.hamlet | 2 + .../disabled/de-de-formal.hamlet | 7 + .../disabled/en-eu.hamlet | 7 + .../enabled/de-de-formal.hamlet | 2 + .../enabled/en-eu.hamlet | 2 + .../exam/de-de-formal.hamlet | 14 ++ .../exam/en-eu.hamlet | 14 ++ templates/submission.hamlet | 2 + .../authorship-statement-accept.hamlet | 11 + test/Database/Fill.hs | 37 +++- test/Model/TypesSpec.hs | 7 +- test/ModelSpec.hs | 3 +- 42 files changed, 717 insertions(+), 206 deletions(-) create mode 100644 messages/uniworx/utils/authorship_statement/de-de-formal.msg create mode 100644 messages/uniworx/utils/authorship_statement/en-eu.msg create mode 100644 src/Handler/Utils/AuthorshipStatement.hs create mode 100644 templates/i18n/changelog/authorship-statements.de-de-formal.hamlet create mode 100644 templates/i18n/changelog/authorship-statements.en-eu.hamlet create mode 100644 templates/i18n/sheet-authorship-statement-mode-tip/disabled/de-de-formal.hamlet create mode 100644 templates/i18n/sheet-authorship-statement-mode-tip/disabled/en-eu.hamlet create mode 100644 templates/i18n/sheet-authorship-statement-mode-tip/enabled/de-de-formal.hamlet create mode 100644 templates/i18n/sheet-authorship-statement-mode-tip/enabled/en-eu.hamlet create mode 100644 templates/i18n/sheet-authorship-statement-mode-tip/exam/de-de-formal.hamlet create mode 100644 templates/i18n/sheet-authorship-statement-mode-tip/exam/en-eu.hamlet create mode 100644 templates/widgets/authorship-statement-accept.hamlet diff --git a/frontend/src/app.sass b/frontend/src/app.sass index f63bea3b0..41bc84929 100644 --- a/frontend/src/app.sass +++ b/frontend/src/app.sass @@ -1697,3 +1697,35 @@ video width: 90% margin: 0.5em auto background-color: var(--color-grey) + +.authorship-statement + & > dt + font-weight: 600 + color: var(--color-fontsec) + font-style: italic + font-size: .9rem + + & > dd + margin-left: 1em + + & + dt + margin-top: .5em + +.authorship-statement-accept__accept + margin-top: 1em + display: grid + grid-template-columns: 25px 1fr + grid-template-areas: 'checkbox label' + +.authorship-statement-accept__container + max-width: 600px + max-height: 25vh + overflow: auto + +.authorship-statement-accept__accept-checkbox + align-self: center + grid-area: checkbox + +.authorship-statement-accept__accept-label + grid-area: label + font-weight: 600 diff --git a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg index bbcf9f472..6ce0daf8b 100644 --- a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg +++ b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg @@ -316,6 +316,6 @@ ExamFinished: Ergebnisse sichtbar ab ExamAuthorshipStatementSection: Eigenständigkeitserklärung ExamAuthorshipStatementRequired: Eigenständigkeitserklärung für prüfungszugehörige Übungsblattabgaben einfordern? ExamAuthorshipStatementRequiredTip: Sollen für alle zu dieser Prüfung zugehörige Übungsblätter die Abgebenden (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden, eine Eigenständigkeitserklärung zu akzeptieren? -ExamAuthorshipStatementRequiredForcedTip: Für dieses Institut sind Eigenständigkeitserklärungen für prüfungszugehörige Übungsblätter vorgeschrieben. +ExamAuthorshipStatementRequiredForcedTip: Für dieses Institut ist vorgeschrieben, dass für alle zu diese Prüfung zugehörigen Übungsblätter die Abgebenden (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden, eine Eigenständigkeitserklärung zu akzeptieren. ExamAuthorshipStatementContent: Eigenständigkeitserklärung -ExamAuthorshipStatementContentForcedTip: Für dieses Institut ist die institutsweit vorgegebene Eigenständigkeitserklärung für prüfungsrelevante Übungsblätter zu verwenden. Benutzerdefinierte Erklärungen sind nicht gestattet. \ No newline at end of file +ExamAuthorshipStatementContentForcedTip: Für dieses Institut ist die institutsweit vorgegebene Eigenständigkeitserklärung für prüfungsrelevante Übungsblätter zu verwenden. Benutzerdefinierte Erklärungen sind nicht gestattet. Für alle zu diese Prüfung zugehörigen Übungsblätter werden die Abgebenden (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert, diese Eigenständigkeitserklärung zu akzeptieren. \ No newline at end of file diff --git a/messages/uniworx/categories/courses/sheet/de-de-formal.msg b/messages/uniworx/categories/courses/sheet/de-de-formal.msg index ff8357d8f..2239f3e4e 100644 --- a/messages/uniworx/categories/courses/sheet/de-de-formal.msg +++ b/messages/uniworx/categories/courses/sheet/de-de-formal.msg @@ -154,8 +154,14 @@ SheetGradingPassAlways: Automatisch bestanden, sobald korrigiert SheetAuthorshipStatementSection: Eigenständigkeitserklärung SheetAuthorshipStatementRequired: Eigenständigkeitserklärung für Übungsblattabgaben einfordern? -SheetAuthorshipStatementRequiredTip: Sollen die Abgebenden (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden, eine Eigenständigkeitserklärung zu akzeptieren? +SheetAuthorshipStatementRequiredTip: Sollen die Abgebenden (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden, eine Eigenständigkeitserklärung abzugeben? SheetAuthorshipStatementRequiredForcedTip: Für dieses Institut sind Eigenständigkeitserklärungen für nicht-prüfungszugehörige Übungsblätter vorgeschrieben. SheetAuthorshipStatementContent: Eigenständigkeitserklärung SheetAuthorshipStatementContentForcedTip: Für dieses Institut ist die institutsweit vorgegebene Eigenständigkeitserklärung für nicht-prüfungszugehörige Übungsblätter zu verwenden. Benutzerdefinierte Erklärungen sind nicht gestattet. SheetAuthorshipStatementContentOverridesExamTip: Gehört dieses Übungsblatt zu einer Prüfung mit einer prüfungsweit eingestellten Eigenständigkeitserklärung, so können Sie hier eine für dieses Übungsblatt abweichende Eigenständigkeitserklärung angeben. +SheetAuthorshipStatementExamNone: Keine Prüfung +SheetAuthorshipStatementExam: Zugeordnete Prüfung +SheetAuthorshipStatementMode: Eigenständigkeitserklärung +SheetAuthorshipStatementModeDisabled: Keine Eigenständigkeitserklärungen +SheetAuthorshipStatementModeExam: Einstellung folgt Prüfung +SheetAuthorshipStatementModeEnabled: Eigenständigkeitserklärungen fordern \ No newline at end of file diff --git a/messages/uniworx/categories/courses/sheet/en-eu.msg b/messages/uniworx/categories/courses/sheet/en-eu.msg index aec230fd4..6924f14af 100644 --- a/messages/uniworx/categories/courses/sheet/en-eu.msg +++ b/messages/uniworx/categories/courses/sheet/en-eu.msg @@ -158,3 +158,9 @@ SheetAuthorshipStatementRequiredForcedTip: This school enforces Statements of Au SheetAuthorshipStatementContent: Statement of Authorship SheetAuthorshipStatementContentForcedTip: The settings of this school dictate that the school-wide Statement of Authorship for exam-unrelated sheets must be used. Custom statements are prohibited. SheetAuthorshipStatementContentOverridesExamTip: If this exercise sheet is related to an exam with an exam-wide Statement of Authorship set, a sheet-specific adaptation can be given here. +SheetAuthorshipStatementExamNone: No Exam +SheetAuthorshipStatementExam: Related exam +SheetAuthorshipStatementMode: Statements of Authorship +SheetAuthorshipStatementModeDisabled: No Statements of Authorship +SheetAuthorshipStatementModeExam: Setting follows exam +SheetAuthorshipStatementModeEnabled: Demand Statements of Authorship diff --git a/messages/uniworx/categories/courses/submission/de-de-formal.msg b/messages/uniworx/categories/courses/submission/de-de-formal.msg index d094355da..73132dcdc 100644 --- a/messages/uniworx/categories/courses/submission/de-de-formal.msg +++ b/messages/uniworx/categories/courses/submission/de-de-formal.msg @@ -192,4 +192,11 @@ SubmissionDoneByFile: Je nach Bewertungsdatei SubmissionDoneAlways: Immer SheetGroupNoGroups: Keine Gruppenabgabe -CorrDownloadVersion !ident-ok: Version \ No newline at end of file +CorrDownloadVersion !ident-ok: Version + +SubmissionAuthorshipStatement: Eigenständigkeitserklärung +SubmissionAuthorshipStatementTip: Um abgeben zu können, müssen Sie die vorgegebene Eigenständigkeitserklärung akzeptieren. Hierfür müssen Sie die Checkbox am Ende der Erklärung zu markieren. +SubmissionLecturerAuthorshipStatement: Eigenständigkeitserklärung +SubmissionLecturerAuthorshipStatementTip: Wenn Sie sich selbst als Mitabgebende/Mitabgebender eintragen müssen Sie eine Eigenständigkeitserklärung abgeben. Beachten Sie, dass Sie eine Eigenständigkeitserklärung nur für sich selbst abgeben können, nicht für etwaige andere Mitabgebende; falls Sie eine Eigenständigkeitserklärung abgeben, wird diese nur unter Ihrem Namen in Uni2work gespeichert. +SubmissionLecturerAuthorshipStatementRequiredBecauseSubmittor: Da Sie sich selbst als Mitabgebende/Mitabgebender eingetragen haben, müssen Sie eine Eigenständigkeitserklärung abgeben. +SubmissionCoSubmittorsInviteRequiredBecauseAuthorshipStatements: Da für die Abgabe zu diesem Übungsblatt die Abgabe einer Eigenständigkeitserklärung vorausgesetzt wird, werden bekannte E-Mail Adressen bekannter Benutzer nicht aufgelöst. Mitabgebende müssen stattdessen per E-Mail eingeladen werden. \ 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 a10d9e8de..56cd7977f 100644 --- a/messages/uniworx/categories/courses/submission/en-eu.msg +++ b/messages/uniworx/categories/courses/submission/en-eu.msg @@ -191,4 +191,11 @@ SubmissionDoneByFile: According to correction file SubmissionDoneAlways: Always SheetGroupNoGroups: No group submission -CorrDownloadVersion !ident-ok: Version \ No newline at end of file +CorrDownloadVersion !ident-ok: Version + +SubmissionAuthorshipStatement: Statement of Authorship +SubmissionAuthorshipStatementTip: To submit you have to accept the provided statement of authership. To do so you have to check the box at the end of the statement. +SubmissionLecturerAuthorshipStatement: Statement of Authorship +SubmissionLecturerAuthorshipStatementTip: If you enter yourself as a submittor you have to confirm the Statement of Authorship. Note that you can only confirm the Statement of Authorship for yourself. If you confirm it, it will be recorded only under your name. +SubmissionLecturerAuthorshipStatementRequiredBecauseSubmittor: Since you have entered yourself as a submittor you have to confirm the Statement of Authorship. +SubmissionCoSubmittorsInviteRequiredBecauseAuthorshipStatements: Since Statements of Authorship are required to submit for this exercise sheet, e-mail addresses of known users are not resolved. Instead co-submittors will have to be invited via e-mail. diff --git a/messages/uniworx/utils/authorship_statement/de-de-formal.msg b/messages/uniworx/utils/authorship_statement/de-de-formal.msg new file mode 100644 index 000000000..cb8bc7829 --- /dev/null +++ b/messages/uniworx/utils/authorship_statement/de-de-formal.msg @@ -0,0 +1,2 @@ +AuthorshipStatementStatementIsRequired: Sie müssen die Eigenständigkeitserklärung als zutreffend bestätigen +AuthorshipStatementAccept: Ich habe die obenstehende Eigenständigkeitserklärung gelesen und verstanden und erkläre hiermit, dass die obenstehenden Aussagen zutreffen. \ No newline at end of file diff --git a/messages/uniworx/utils/authorship_statement/en-eu.msg b/messages/uniworx/utils/authorship_statement/en-eu.msg new file mode 100644 index 000000000..57fe51b44 --- /dev/null +++ b/messages/uniworx/utils/authorship_statement/en-eu.msg @@ -0,0 +1,2 @@ +AuthorshipStatementStatementIsRequired: You have to confirm the Statement of Authorship as true and correct +AuthorshipStatementAccept: I have read and understood the above Statement of Authorship and state that the above-mentioned statements are true and correct. \ No newline at end of file diff --git a/models/authorship-statements.model b/models/authorship-statements.model index 184071798..b93afcd06 100644 --- a/models/authorship-statements.model +++ b/models/authorship-statements.model @@ -1,17 +1,12 @@ AuthorshipStatementDefinition - content StoredMarkup -- must contain statements in all relevant languages for now, TODO: refactor (use translations as below) + hash AuthorshipStatementReference + content I18nStoredMarkup + Primary hash deriving Generic --- AuthorshipStatementDefinitionTranslation --- definition AuthorshipStatementDefinitionId --- language Lang --- content StoredMarkup --- UniqueAuthorshipStatementDefinitionTranslation definition language --- deriving Generic --- Statement of Authorship to be issued upon submitting a solution for an exercise sheet --- TODO: maybe move to SubmissionUser? (With statementSigned :: Bool, statement :: Maybe StoredMarkup) AuthorshipStatementSubmission - submissionUser SubmissionUserId - statement StoredMarkup -- stored as plain StoredMarkup as the "signed" statement needs to be persisted - UniqueAuthorshipStatementSubmission submissionUser + statement AuthorshipStatementDefinitionId + submission SubmissionId + user UserId + time UTCTime deriving Generic diff --git a/models/sheets.model b/models/sheets.model index 1fde7ec1b..6e650ca5a 100644 --- a/models/sheets.model +++ b/models/sheets.model @@ -15,6 +15,8 @@ Sheet -- exercise sheet for a given course anonymousCorrection Bool default=true requireExamRegistration ExamId Maybe -- Students may only submit if they are registered for the given exam allowNonPersonalisedSubmission Bool default=true + authorshipStatementMode SheetAuthorshipStatementMode default='exam' + authorshipStatementExam ExamId Maybe authorshipStatement AuthorshipStatementDefinitionId Maybe -- sheet-specific authorship statement; for exam-unrelated sheets and as exam setting overrides CourseSheet course name deriving Generic diff --git a/src/Foundation/I18n.hs b/src/Foundation/I18n.hs index c13fd25d1..c861a7d0e 100644 --- a/src/Foundation/I18n.hs +++ b/src/Foundation/I18n.hs @@ -14,7 +14,8 @@ module Foundation.I18n , UniWorXMetricsMessage(..), UniWorXNewsMessage(..), UniWorXSchoolMessage(..), UniWorXSystemMessageMessage(..) , UniWorXTermMessage(..), UniWorXSendMessage(..), UniWorXSiteLayoutMessage(..), UniWorXErrorMessage(..) , UniWorXI18nMessage(..),UniWorXJobsHandlerMessage(..), UniWorXModelTypesMessage(..), UniWorXYesodMiddlewareMessage(..) - , ShortTermIdentifier(..) + , UniWorXAuthorshipStatementMessage(..) + , ShortTermIdentifier(..) , MsgLanguage(..) , ShortSex(..) , ShortWeekDay(..) @@ -190,6 +191,7 @@ mkMessageAddition ''UniWorX "TablePagination" "messages/uniworx/utils/table_pagi mkMessageAddition ''UniWorX "Util" "messages/uniworx/utils/utils" "de-de-formal" mkMessageAddition ''UniWorX "Rating" "messages/uniworx/utils/rating" "de-de-formal" mkMessageAddition ''UniWorX "SiteLayout" "messages/uniworx/utils/site_layout" "de-de-formal" +mkMessageAddition ''UniWorX "AuthorshipStatement" "messages/uniworx/utils/authorship_statement" "de-de-formal" mkMessageVariant ''UniWorX ''CampusMessage "messages/auth/campus" "de" mkMessageVariant ''UniWorX ''DummyMessage "messages/auth/dummy" "de" mkMessageVariant ''UniWorX ''PWHashMessage "messages/auth/pw-hash" "de" @@ -303,6 +305,9 @@ embedRenderMessage ''UniWorX ''UrlFieldMessage id embedRenderMessageVariant ''UniWorX ''ADInvalidCredentials ("InvalidCredentials" <>) +embedRenderMessage ''UniWorX ''SchoolAuthorshipStatementMode id +embedRenderMessage ''UniWorX ''SheetAuthorshipStatementMode id + newtype ShortSex = ShortSex Sex embedRenderMessageVariant ''UniWorX ''ShortSex ("Short" <>) @@ -406,15 +411,6 @@ instance RenderMessage UniWorX ExamCloseMode where mr :: RenderMessage UniWorX msg => msg -> Text mr = renderMessage foundation ls -instance RenderMessage UniWorX SchoolAuthorshipStatementMode where - renderMessage foundation ls = \case - SchoolAuthorshipStatementModeNone -> mr MsgSchoolAuthorshipStatementModeNone - SchoolAuthorshipStatementModeOptional -> mr MsgSchoolAuthorshipStatementModeOptional - SchoolAuthorshipStatementModeRequired -> mr MsgSchoolAuthorshipStatementModeRequired - where - mr :: RenderMessage UniWorX msg => msg -> Text - mr = renderMessage foundation ls - -- ToMessage instances for converting raw numbers to Text (no internationalization) -- FIXME: Use RenderMessage always diff --git a/src/Handler/Exam/Edit.hs b/src/Handler/Exam/Edit.hs index 774913d5f..dd4bba89f 100644 --- a/src/Handler/Exam/Edit.hs +++ b/src/Handler/Exam/Edit.hs @@ -40,19 +40,7 @@ postEEditR tid ssh csh examn = do editExamAct <- formResultMaybe editExamResult $ \ExamForm{..} -> do res <- trySql @ExamEditException $ do - mAuthorshipStatementId <- case efAuthorshipStatement of - Nothing -> return Nothing - Just newStatementContent -> do - mPreviousStatement <- maybe (pure Nothing) getEntity (oldExam ^. _examAuthorshipStatement) - if - | Just (Entity previousStatementId AuthorshipStatementDefinition{authorshipStatementDefinitionContent=previousStatementContent}) <- mPreviousStatement - , newStatementContent == previousStatementContent - -> return $ Just previousStatementId - | Just (Entity previousStatementId _) <- mPreviousStatement - -> update previousStatementId [ AuthorshipStatementDefinitionContent =. newStatementContent ] >> return (Just previousStatementId) - | otherwise - -> Just <$> insert AuthorshipStatementDefinition { authorshipStatementDefinitionContent = newStatementContent } - + examAuthorshipStatement <- traverse insertAuthorshipStatement efAuthorshipStatement insertRes <- myReplaceUnique eId Exam { examCourse = cid , examName = efName @@ -75,7 +63,7 @@ postEEditR tid ssh csh examn = do , examExamMode = efExamMode , examStaff = efStaff , examPartsFrom = efPartsFrom - , examAuthorshipStatement = mAuthorshipStatementId + , examAuthorshipStatement } when (is _Just insertRes) $ diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index 40796dad0..dedf18b60 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -52,7 +52,7 @@ data ExamForm = ExamForm , efStaff :: Maybe Text , efCorrectors :: Set (Either UserEmail UserId) , efExamParts :: Set ExamPartForm - , efAuthorshipStatement :: Maybe StoredMarkup + , efAuthorshipStatement :: Maybe I18nStoredMarkup } data ExamOccurrenceForm = ExamOccurrenceForm @@ -111,7 +111,7 @@ examForm :: ( MonadHandler m ) => Entity Course -> Maybe ExamForm -> (Html -> MForm m (FormResult ExamForm, Widget)) examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do - MsgRenderer mr <- getMsgRenderer + mr'@(MsgRenderer mr) <- getMsgRenderer (School{..}, mSchoolAuthorshipStatement) <- liftHandler . runDBRead $ do school@School{..} <- getJust courseSchool mSchoolAuthorshipStatement <- maybe (pure Nothing) getEntity schoolSheetExamAuthorshipStatementDefinition @@ -148,24 +148,29 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do <* aformSection MsgExamFormParts <*> examPartsForm (efExamParts <$> template) <*> let - reqContentField :: (FieldSettings UniWorX -> FieldSettings UniWorX) -> AForm Handler StoredMarkup - reqContentField ttip = areq htmlField - (fslI MsgExamAuthorshipStatementContent & ttip) - ( (efAuthorshipStatement =<< template) - <|> (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement) + reqContentField :: (FieldSettings UniWorX -> FieldSettings UniWorX) -> AForm Handler I18nStoredMarkup + reqContentField ttip = fmapAForm (formResultUnOpt mr' MsgSheetAuthorshipStatementContent) + $ i18nFieldA htmlField True (\_ -> Nothing) ("authorship-statement" :: Text) + (fslI MsgSheetAuthorshipStatementContent & ttip) + True + ( fmap Just $ (efAuthorshipStatement =<< template) + <|> (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement) ) - forcedContentField = aforced htmlField + forcedContentField = aforced forcedAuthorshipStatementField (fslI MsgExamAuthorshipStatementContent & setTooltip MsgExamAuthorshipStatementContentForcedTip) - (maybe mempty (authorshipStatementDefinitionContent . entityVal) mSchoolAuthorshipStatement) - contentField ttipReq = bool forcedContentField (reqContentField ttipReq) schoolSheetExamAuthorshipStatementAllowOther + contentField ttipReq + | not schoolSheetExamAuthorshipStatementAllowOther + = traverse forcedContentField $ authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement + | otherwise + = Just <$> reqContentField ttipReq in case schoolSheetExamAuthorshipStatementMode of SchoolAuthorshipStatementModeNone -> pure Nothing -- suppress display of whole section incl. header otherMode -> aformSection MsgExamAuthorshipStatementSection *> case otherMode of - SchoolAuthorshipStatementModeOptional -> optionalActionA (contentField id) + SchoolAuthorshipStatementModeOptional -> optionalActionA (fmapAForm (formResultUnOpt mr' MsgSheetAuthorshipStatementContent) $ contentField id) (fslI MsgExamAuthorshipStatementRequired & setTooltip MsgExamAuthorshipStatementRequiredTip) (is _Just . efAuthorshipStatement <$> template) - SchoolAuthorshipStatementModeRequired -> fmap Just . contentField $ setTooltip MsgExamAuthorshipStatementRequiredForcedTip + SchoolAuthorshipStatementModeRequired -> contentField $ setTooltip MsgExamAuthorshipStatementRequiredForcedTip _none -> pure Nothing officeSchoolsForm :: Maybe (Set SchoolId) -> AForm Handler (Set SchoolId) diff --git a/src/Handler/Exam/New.hs b/src/Handler/Exam/New.hs index cda9f41c2..c3a8c6fc7 100644 --- a/src/Handler/Exam/New.hs +++ b/src/Handler/Exam/New.hs @@ -29,7 +29,7 @@ postCExamNewR tid ssh csh = do newExamAct <- formResultMaybe newExamResult $ \ExamForm{..} -> do now <- liftIO getCurrentTime - mAuthorshipStatementId <- maybe (return Nothing) (fmap Just . insert . AuthorshipStatementDefinition) efAuthorshipStatement + examAuthorshipStatement <- traverse insertAuthorshipStatement efAuthorshipStatement insertRes <- insertUnique Exam { examName = efName @@ -53,7 +53,7 @@ postCExamNewR tid ssh csh = do , examExamMode = efExamMode , examStaff = efStaff , examPartsFrom = efPartsFrom - , examAuthorshipStatement = mAuthorshipStatementId + , examAuthorshipStatement } whenIsJust insertRes $ \examid -> do insertMany_ diff --git a/src/Handler/School.hs b/src/Handler/School.hs index 0d31aa0bb..72dd75bbf 100644 --- a/src/Handler/School.hs +++ b/src/Handler/School.hs @@ -69,10 +69,10 @@ data SchoolForm = SchoolForm , sfExamDiscouragedModes :: ExamModeDNF , sfExamCloseMode :: ExamCloseMode , sfSheetAuthorshipStatementMode :: SchoolAuthorshipStatementMode - , sfSheetAuthorshipStatementDefinition :: Maybe StoredMarkup -- TODO: Must contain statements in all relevant languages for now; later use `Maybe (Map Lang StoredMarkup)` instead + , sfSheetAuthorshipStatementDefinition :: Maybe I18nStoredMarkup , sfSheetAuthorshipStatementAllowOther :: Bool , sfSheetExamAuthorshipStatementMode :: SchoolAuthorshipStatementMode - , sfSheetExamAuthorshipStatementDefinition :: Maybe StoredMarkup -- TODO: Must contain statements in all relevant languages for now; later use `Maybe (Map Lang StoredMarkup)` instead + , sfSheetExamAuthorshipStatementDefinition :: Maybe I18nStoredMarkup , sfSheetExamAuthorshipStatementAllowOther :: Bool } @@ -88,12 +88,13 @@ mkSchoolForm mSsh template = renderAForm FormStandard $ SchoolForm <*> (fromMaybe (ExamModeDNF predDNFFalse) <$> aopt pathPieceField (fslI MsgSchoolExamDiscouragedModes) (Just $ sfExamDiscouragedModes <$> template <|> pure (ExamModeDNF predDNFFalse))) <*> apopt (selectField optionsFinite) (fslI MsgExamCloseMode) (sfExamCloseMode <$> template <|> pure ExamCloseSeparate) <* aformSection MsgSchoolAuthorshipStatementSection - <*> areq (selectField optionsFinite) (fslI MsgSchoolAuthorshipStatementSheetMode) (sfSheetAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) -- FIXME: SchoolAuthorshipStatementModeNone leads to FormFailure - <*> aopt htmlField (fslI MsgSchoolAuthorshipStatementSheetDefinition & setTooltip MsgSchoolAuthorshipStatementSheetDefinitionTip) (sfSheetAuthorshipStatementDefinition <$> template) + <*> apopt (selectField optionsFinite) (fslI MsgSchoolAuthorshipStatementSheetMode) (sfSheetAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) + <*> i18nFieldA htmlField False (\_ -> Nothing) ("sheet-authorship-statement-definition" :: Text) (fslI MsgSchoolAuthorshipStatementSheetDefinition & setTooltip MsgSchoolAuthorshipStatementSheetDefinitionTip) False (sfSheetAuthorshipStatementDefinition <$> template) <*> apopt checkBoxField (fslI MsgSchoolAuthorshipStatementSheetAllowOther) (sfSheetAuthorshipStatementAllowOther <$> template <|> pure True) - <*> areq (selectField optionsFinite) (fslI MsgSchoolAuthorshipStatementSheetExamMode) (sfSheetExamAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) -- FIXME: SchoolAuthorshipStatementModeNone leads to FormFailure - <*> aopt htmlField (fslI MsgSchoolAuthorshipStatementSheetExamDefinition & setTooltip MsgSchoolAuthorshipStatementSheetExamDefinitionTip) (sfSheetExamAuthorshipStatementDefinition <$> template) + <*> apopt (selectField optionsFinite) (fslI MsgSchoolAuthorshipStatementSheetExamMode) (sfSheetExamAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) + <*> i18nFieldA htmlField False (\_ -> Nothing) ("exam-authorship-statement-definition" :: Text) (fslI MsgSchoolAuthorshipStatementSheetExamDefinition & setTooltip MsgSchoolAuthorshipStatementSheetExamDefinitionTip) False (sfSheetExamAuthorshipStatementDefinition <$> template) <*> apopt checkBoxField (fslI MsgSchoolAuthorshipStatementSheetExamAllowOther) (sfSheetExamAuthorshipStatementAllowOther <$> template <|> pure True) + -- TODO(AuthorshipStatements): disallow not allowOther && is _Nothing definition where ldapOrgs :: HandlerFor UniWorX (OptionList (CI Text)) ldapOrgs = fmap (mkOptionList . map (\t -> Option (CI.original t) t (CI.original t)) . Set.toAscList) . runDB $ @@ -104,11 +105,6 @@ schoolToForm ssh = do School{..} <- get404 ssh ldapFrags <- selectList [SchoolLdapSchool ==. Just ssh] [] - -- TODO: allow for separate translations - -- let getAuthorshipStatementDefs = maybe (return Nothing) (\definitionId -> Just <$> selectList [ AuthorshipStatementDefinitionTranslationDefinition ==. definitionId ] []) - -- authorshipStatementDefs <- getAuthorshipStatementDefs schoolSheetAuthorshipStatementDefinition - -- examAuthorshipStatementDefs <- getAuthorshipStatementDefs schoolSheetExamAuthorshipStatementDefinition - mSheetAuthorshipStatementDefinition <- maybe (return Nothing) get schoolSheetAuthorshipStatementDefinition mSheetExamAuthorshipStatementDefinition <- maybe (return Nothing) get schoolSheetExamAuthorshipStatementDefinition @@ -129,7 +125,6 @@ schoolToForm ssh = do , sfSheetExamAuthorshipStatementAllowOther = schoolSheetExamAuthorshipStatementAllowOther } - getSchoolEditR, postSchoolEditR :: SchoolId -> Handler Html getSchoolEditR = postSchoolEditR postSchoolEditR ssh = do @@ -139,9 +134,8 @@ postSchoolEditR ssh = do formResult sfResult $ \SchoolForm{..} -> do runDB $ do - let insertAuthorshipStatement = maybe (pure Nothing) $ fmap Just . insert . AuthorshipStatementDefinition - mSheetAuthorshipStatementId <- insertAuthorshipStatement sfSheetAuthorshipStatementDefinition - mSheetExamAuthorshipStatementId <- insertAuthorshipStatement sfSheetExamAuthorshipStatementDefinition + mSheetAuthorshipStatementId <- traverse insertAuthorshipStatement sfSheetAuthorshipStatementDefinition + mSheetExamAuthorshipStatementId <- traverse insertAuthorshipStatement sfSheetExamAuthorshipStatementDefinition update ssh [ SchoolName =. sfName , SchoolExamMinimumRegisterBeforeStart =. sfExamMinimumRegisterBeforeStart @@ -189,9 +183,8 @@ postSchoolNewR = do formResult sfResult $ \SchoolForm{..} -> do let ssh = SchoolKey sfShorthand insertOkay <- runDB $ do - let insertAuthorshipStatement = maybe (pure Nothing) $ fmap Just . insert . AuthorshipStatementDefinition - mSheetAuthorshipStatementId <- insertAuthorshipStatement sfSheetExamAuthorshipStatementDefinition - mSheetExamAuthorshipStatementId <- insertAuthorshipStatement sfSheetExamAuthorshipStatementDefinition + mSheetAuthorshipStatementId <- traverse insertAuthorshipStatement sfSheetExamAuthorshipStatementDefinition + mSheetExamAuthorshipStatementId <- traverse insertAuthorshipStatement sfSheetExamAuthorshipStatementDefinition didInsert <- is _Just <$> insertUnique School { schoolShorthand = sfShorthand , schoolName = sfName diff --git a/src/Handler/Sheet/Edit.hs b/src/Handler/Sheet/Edit.hs index 76dfd4448..080e49b51 100644 --- a/src/Handler/Sheet/Edit.hs +++ b/src/Handler/Sheet/Edit.hs @@ -61,6 +61,8 @@ postSEditR tid ssh csh shn = do , spffAllowNonPersonalisedSubmission = sheetAllowNonPersonalisedSubmission , spffFiles = Nothing } + , sfAuthorshipStatementMode = sheetAuthorshipStatementMode + , sfAuthorshipStatementExam = sheetAuthorshipStatementExam , sfAuthorshipStatement = authorshipStatementDefinitionContent . entityVal <$> mAuthorshipStatement } @@ -101,6 +103,8 @@ handleSheetEdit tid ssh csh msId template dbAction = do -- -- statement not modified: return id of old statement -- | otherwise -> return $ entityKey <$> mOldAuthorshipStatement -- mNewAuthorshipStatementId <- insertNewOrKeepStatement sfAuthorshipStatement + + sheetAuthorshipStatement <- traverse insertAuthorshipStatement sfAuthorshipStatement let newSheet = Sheet { sheetCourse = cid @@ -119,7 +123,9 @@ handleSheetEdit tid ssh csh msId template dbAction = do , sheetAnonymousCorrection = sfAnonymousCorrection , sheetRequireExamRegistration = sfRequireExamRegistration , sheetAllowNonPersonalisedSubmission = maybe True spffAllowNonPersonalisedSubmission sfPersonalF - , sheetAuthorshipStatement = Nothing -- TODO: implement sheet-specific statements + , sheetAuthorshipStatementMode = sfAuthorshipStatementMode + , sheetAuthorshipStatementExam = sfAuthorshipStatementExam + , sheetAuthorshipStatement } mbsid <- dbAction newSheet case mbsid of diff --git a/src/Handler/Sheet/Form.hs b/src/Handler/Sheet/Form.hs index cbb5a71b0..8d08e200e 100644 --- a/src/Handler/Sheet/Form.hs +++ b/src/Handler/Sheet/Form.hs @@ -10,6 +10,7 @@ import Handler.Utils import Handler.Utils.Invitations import qualified Database.Esqueleto.Legacy as E +import qualified Database.Esqueleto.Utils as E import qualified Data.Set as Set import qualified Data.Map as Map @@ -42,7 +43,9 @@ data SheetForm = SheetForm , sfMarkingText :: Maybe StoredMarkup , sfAnonymousCorrection :: Bool , sfCorrectors :: Loads - , sfAuthorshipStatement :: Maybe StoredMarkup + , sfAuthorshipStatementMode :: SheetAuthorshipStatementMode + , sfAuthorshipStatementExam :: Maybe ExamId + , sfAuthorshipStatement :: Maybe I18nStoredMarkup } data SheetPersonalisedFilesForm = SheetPersonalisedFilesForm @@ -64,7 +67,7 @@ makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateS oldFileIds <- (return.) <$> case msId of Nothing -> return $ partitionFileType mempty (Just sId) -> liftHandler $ runDB $ getFtIdMap sId - MsgRenderer mr <- getMsgRenderer + mr'@(MsgRenderer mr) <- getMsgRenderer ctime <- ceilingQuarterHour <$> liftIO getCurrentTime ((School{..}, mSchoolAuthorshipStatement), _course) <- liftHandler . runDB $ do course@Course{courseSchool} <- get404 cId @@ -74,59 +77,149 @@ makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateS MaybeT . getEntity $ statementId return ((school, mSchoolAuthorshipStatement), course) sheetPersonalisedFilesForm <- makeSheetPersonalisedFilesForm $ template >>= sfPersonalF - flip (renderAForm FormStandard) html $ SheetForm - <$> areq (textField & cfStrip & cfCI) (fslI MsgSheetName) (sfName <$> template) - <*> aopt htmlField (fslI MsgSheetDescription) (sfDescription <$> template) - <*> optionalActionA (apreq (examField Nothing cId) (fslI MsgSheetRequiredExam) (sfRequireExamRegistration =<< template)) (fslI MsgSheetRequireExam & setTooltip MsgSheetRequireExamTip) (is _Just . sfRequireExamRegistration <$> template) - <* aformSection MsgSheetFormFiles - <*> aopt (multiFileField $ oldFileIds SheetExercise) (fslI MsgSheetExercise) (sfSheetF <$> template) - <*> aopt (multiFileField $ oldFileIds SheetHint) (fslI MsgSheetHint) (sfHintF <$> template) - <*> aopt (multiFileField $ oldFileIds SheetSolution) (fslI MsgSheetSolution) (sfSolutionF <$> template) - <*> aopt (multiFileField $ oldFileIds SheetMarking) (fslI MsgSheetMarkingFiles - & setTooltip MsgSheetMarkingTip) (sfMarkingF <$> template) - <*> optionalActionA sheetPersonalisedFilesForm (fslI MsgSheetPersonalisedFiles & setTooltip MsgSheetPersonalisedFilesTip) (is _Just . sfPersonalF <$> template) - <* aformSection MsgSheetFormTimes - <*> aopt utcTimeField (fslI MsgSheetVisibleFrom - & setTooltip MsgSheetVisibleFromTip) - ((sfVisibleFrom <$> template) <|> pure (Just ctime)) - <*> aopt utcTimeField (fslI MsgSheetActiveFrom - & setTooltip MsgSheetActiveFromTip) - (sfActiveFrom <$> template) - <*> aopt utcTimeField (fslI MsgSheetActiveTo & setTooltip MsgSheetActiveToTip) (sfActiveTo <$> template) - <*> aopt utcTimeField (fslpI MsgSheetHintFrom (mr MsgSheetHintFromPlaceholder) - & setTooltip MsgSheetHintFromTip) (sfHintFrom <$> template) - <*> aopt utcTimeField (fslpI MsgSheetSolutionFrom (mr MsgSheetSolutionFromPlaceholder) - & setTooltip MsgSheetSolutionFromTip) (sfSolutionFrom <$> template) - <* aformSection MsgSheetFormType - <*> submissionModeForm ((sfSubmissionMode <$> template) <|> pure (SubmissionMode False . Just $ UploadAny True defaultExtensionRestriction False)) - <*> sheetGroupAFormReq (fslI MsgSheetGroup) ((sfGrouping <$> template) <|> pure NoGroups) - <*> sheetTypeAFormReq cId (fslI MsgSheetSheetType) (sfType <$> template) - <*> apopt checkBoxField (fslI MsgAutoAssignCorrs) (sfAutoDistribute <$> template) - <*> aopt htmlField (fslI MsgSheetMarking) (sfMarkingText <$> template) - <*> apopt checkBoxField (fslI MsgSheetAnonymousCorrection & setTooltip MsgSheetAnonymousCorrectionTip) (sfAnonymousCorrection <$> template) - <*> correctorForm (maybe mempty sfCorrectors template) - -- TODO: add info: define exam-unrelated/related, if exam-unrelated: applies to sheet, if exam-related: overrides exam-wide authship statement settings - -- TODO: compare versions of current school statement and template statement: school > template if school statement is newer than template statement, template > school otherwise (TODO: add lastEdited to models?) - <*> let - reqContentField :: (FieldSettings UniWorX -> FieldSettings UniWorX) -> AForm Handler StoredMarkup - reqContentField ttip = areq htmlField - (fslI MsgSheetAuthorshipStatementContent & ttip) - ( (sfAuthorshipStatement =<< template) - <|> (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement) - ) - forcedContentField = aforced htmlField - (fslI MsgSheetAuthorshipStatementContent & setTooltip MsgSheetAuthorshipStatementContentForcedTip) - (maybe mempty (authorshipStatementDefinitionContent . entityVal) mSchoolAuthorshipStatement) - contentField ttipReq = bool forcedContentField (reqContentField ttipReq) schoolSheetAuthorshipStatementAllowOther - in case schoolSheetAuthorshipStatementMode of - SchoolAuthorshipStatementModeNone -> pure Nothing -- suppress display of whole section incl. header - otherMode -> aformSection MsgSheetAuthorshipStatementSection - *> case otherMode of - SchoolAuthorshipStatementModeOptional -> optionalActionA (contentField id) - (fslI MsgSheetAuthorshipStatementRequired & setTooltip MsgSheetAuthorshipStatementRequiredTip) - (is _Just . sfAuthorshipStatement <$> template) - SchoolAuthorshipStatementModeRequired -> fmap Just . contentField $ setTooltip MsgSheetAuthorshipStatementRequiredForcedTip - _none -> pure Nothing + flip (renderWForm FormStandard) html $ do + sfNameRes <- wreq (textField & cfStrip & cfCI) (fslI MsgSheetName) (sfName <$> template) + sfDescriptionRes <- wopt htmlField (fslI MsgSheetDescription) (sfDescription <$> template) + sfRequireExamRegistrationRes <- optionalActionW (apreq (examField Nothing cId) (fslI MsgSheetRequiredExam) (sfRequireExamRegistration =<< template)) (fslI MsgSheetRequireExam & setTooltip MsgSheetRequireExamTip) (is _Just . sfRequireExamRegistration <$> template) + + wformSection MsgSheetFormFiles + sfSheetFRes <- wopt (multiFileField $ oldFileIds SheetExercise) (fslI MsgSheetExercise) (sfSheetF <$> template) + sfHintFRes <- wopt (multiFileField $ oldFileIds SheetHint) (fslI MsgSheetHint) (sfHintF <$> template) + sfSolutionFRes <- wopt (multiFileField $ oldFileIds SheetSolution) (fslI MsgSheetSolution) (sfSolutionF <$> template) + sfMarkingFRes <- wopt (multiFileField $ oldFileIds SheetMarking) (fslI MsgSheetMarkingFiles & setTooltip MsgSheetMarkingTip) (sfMarkingF <$> template) + sfPersonalFRes <- optionalActionW sheetPersonalisedFilesForm (fslI MsgSheetPersonalisedFiles & setTooltip MsgSheetPersonalisedFilesTip) (is _Just . sfPersonalF <$> template) + + wformSection MsgSheetFormTimes + sfVisibleFromRes <- wopt utcTimeField (fslI MsgSheetVisibleFrom & setTooltip MsgSheetVisibleFromTip) ((sfVisibleFrom <$> template) <|> pure (Just ctime)) + sfActiveFromRes <- wopt utcTimeField (fslI MsgSheetActiveFrom & setTooltip MsgSheetActiveFromTip) (sfActiveFrom <$> template) + sfActiveToRes <- wopt utcTimeField (fslI MsgSheetActiveTo & setTooltip MsgSheetActiveToTip) (sfActiveTo <$> template) + sfHintFromRes <- wopt utcTimeField (fslpI MsgSheetHintFrom (mr MsgSheetHintFromPlaceholder) & setTooltip MsgSheetHintFromTip) (sfHintFrom <$> template) + sfSolutionFromRes <- wopt utcTimeField (fslpI MsgSheetSolutionFrom (mr MsgSheetSolutionFromPlaceholder) & setTooltip MsgSheetSolutionFromTip) (sfSolutionFrom <$> template) + + wformSection MsgSheetFormType + sfSubmissionModeRes <- aFormToWForm . submissionModeForm $ (sfSubmissionMode <$> template) <|> pure (SubmissionMode False . Just $ UploadAny True defaultExtensionRestriction False) + sfGroupingRes <- aFormToWForm $ sheetGroupAFormReq (fslI MsgSheetGroup) ((sfGrouping <$> template) <|> pure NoGroups) + sfTypeRes <- aFormToWForm $ sheetTypeAFormReq cId (fslI MsgSheetSheetType) (sfType <$> template) + sfAutoDistributeRes <- wpopt checkBoxField (fslI MsgAutoAssignCorrs) (sfAutoDistribute <$> template) + sfMarkingTextRes <- wopt htmlField (fslI MsgSheetMarking) (sfMarkingText <$> template) + sfAnonymousCorrectionRes <- wpopt checkBoxField (fslI MsgSheetAnonymousCorrection & setTooltip MsgSheetAnonymousCorrectionTip) (sfAnonymousCorrection <$> template) + sfCorrectorsRes <- aFormToWForm . correctorForm $ maybe mempty sfCorrectors template + + let sfAuthorshipStatementExam' = sfAuthorshipStatementExam =<< template + sfAuthorshipStatement' = sfAuthorshipStatement =<< template + (sfAuthorshipStatementModeRes, sfAuthorshipStatementExamRes, sfAuthorshipStatementRes) + <- if | isn't _SchoolAuthorshipStatementModeNone schoolSheetAuthorshipStatementMode -> do + wformSection MsgSheetAuthorshipStatementSection + + let + reqContentField :: AForm Handler I18nStoredMarkup + reqContentField = formResultUnOpt mr' MsgSheetAuthorshipStatementContent + `fmapAForm` i18nFieldA htmlField True (\_ -> Nothing) ("authorship-statement" :: Text) + (fslI MsgSheetAuthorshipStatementContent) + True + ( fmap Just $ (sfAuthorshipStatement =<< template) + <|> (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement) + ) + forcedContentField = wforced forcedAuthorshipStatementField (fslI MsgSheetAuthorshipStatementContent & setTooltip MsgSheetAuthorshipStatementContentForcedTip) + + if | not schoolSheetAuthorshipStatementAllowOther + -> (pure SheetAuthorshipStatementModeEnabled, pure sfAuthorshipStatementExam', ) + <$> fmap sequenceA (traverse forcedContentField $ authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement) + | otherwise -> do + examOpts <- + let examFieldQuery = E.from $ \exam -> do + E.where_ $ exam E.^. ExamCourse E.==. E.val cId + when (is _SchoolAuthorshipStatementModeRequired schoolSheetAuthorshipStatementMode) $ + E.where_ . E.isJust $ exam E.^. ExamAuthorshipStatement + return exam + in liftHandler $ optionsCryptoIdE examFieldQuery examName + + let modeOpts = case schoolSheetAuthorshipStatementMode of + SchoolAuthorshipStatementModeNone -> Set.singleton SheetAuthorshipStatementModeDisabled + SchoolAuthorshipStatementModeOptional -> Set.fromList universeF + SchoolAuthorshipStatementModeRequired -> Set.fromList universeF + & Set.delete SheetAuthorshipStatementModeDisabled + & bool id (Set.delete SheetAuthorshipStatementModeExam) (hasn't (_olOptions . folded) examOpts) + modeOpts' = explainOptionList (optionsPathPiece . map (id &&& id) $ Set.toList modeOpts) $ \case + SheetAuthorshipStatementModeDisabled -> return $(i18nWidgetFile "sheet-authorship-statement-mode-tip/disabled") + SheetAuthorshipStatementModeExam -> return $(i18nWidgetFile "sheet-authorship-statement-mode-tip/exam") + SheetAuthorshipStatementModeEnabled -> return $(i18nWidgetFile "sheet-authorship-statement-mode-tip/enabled") + examField' = selectField' (Just $ SomeMessage MsgSheetAuthorshipStatementExamNone) . return $ entityKey <$> examOpts + examField'' :: AForm Handler (Maybe ExamId) + examField'' + | isn't _SchoolAuthorshipStatementModeRequired schoolSheetAuthorshipStatementMode + = aopt examField' (fslI MsgSheetAuthorshipStatementExam) (sfAuthorshipStatementExam <$> template) + | otherwise + = Just <$> apreq examField' (fslI MsgSheetAuthorshipStatementExam) (sfAuthorshipStatementExam =<< template) + modeForms = flip Map.fromSet modeOpts $ \case + SheetAuthorshipStatementModeDisabled -> pure + ( SheetAuthorshipStatementModeDisabled + , sfAuthorshipStatementExam' + , sfAuthorshipStatement' + ) + SheetAuthorshipStatementModeExam -> (SheetAuthorshipStatementModeExam,, ) + <$> examField'' + <*> pure sfAuthorshipStatement' + SheetAuthorshipStatementModeEnabled -> (SheetAuthorshipStatementModeEnabled, sfAuthorshipStatementExam', ) + <$> fmap Just reqContentField + + massage res = (view _1 <$> res, view _2 <$> res, view _3 <$> res) + + massage <$> explainedMultiActionW modeForms modeOpts' (fslI MsgSheetAuthorshipStatementRequired & setTooltip (bool MsgSheetAuthorshipStatementRequiredTip MsgSheetAuthorshipStatementRequiredForcedTip $ is _SchoolAuthorshipStatementModeRequired schoolSheetAuthorshipStatementMode)) (sfAuthorshipStatementMode <$> template) + | otherwise -> return + ( pure SheetAuthorshipStatementModeDisabled + , pure sfAuthorshipStatementExam' + , pure sfAuthorshipStatement' + ) + + return $ SheetForm + <$> sfNameRes + <*> sfDescriptionRes + <*> sfRequireExamRegistrationRes + <*> sfSheetFRes <*> sfHintFRes <*> sfSolutionFRes <*> sfMarkingFRes + <*> sfPersonalFRes + <*> sfVisibleFromRes + <*> sfActiveFromRes + <*> sfActiveToRes + <*> sfHintFromRes + <*> sfSolutionFromRes + <*> sfSubmissionModeRes + <*> sfGroupingRes + <*> sfTypeRes + <*> sfAutoDistributeRes + <*> sfMarkingTextRes + <*> sfAnonymousCorrectionRes + <*> sfCorrectorsRes + <*> sfAuthorshipStatementModeRes + <*> sfAuthorshipStatementExamRes + <*> sfAuthorshipStatementRes + + -- <*> let + -- reqContentField :: (FieldSettings UniWorX -> FieldSettings UniWorX) -> AForm Handler I18nStoredMarkup + -- reqContentField ttip = fmapAForm (formResultUnOpt mr' MsgSheetAuthorshipStatementContent) + -- $ i18nFieldA htmlField True (\_ -> Nothing) ("authorship-statement" :: Text) + -- (fslI MsgSheetAuthorshipStatementContent & ttip) + -- True + -- ( fmap Just $ (sfAuthorshipStatement =<< template) + -- <|> (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement) + -- ) + -- forcedContentField = aforced forcedAuthorshipStatementField + -- (fslI MsgSheetAuthorshipStatementContent & setTooltip MsgSheetAuthorshipStatementContentForcedTip) + -- contentField ttipReq + -- | not schoolSheetAuthorshipStatementAllowOther + -- = traverse forcedContentField $ authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement + -- | otherwise + -- = Just <$> reqContentField ttipReq + -- in case schoolSheetAuthorshipStatementMode of + -- SchoolAuthorshipStatementModeNone -> pure Nothing -- suppress display of whole section incl. header + -- otherMode -> aformSection MsgSheetAuthorshipStatementSection + -- *> aformMessage authorshipStatementExamRelatedTipMsg + -- *> case otherMode of + -- SchoolAuthorshipStatementModeOptional -> optionalActionA (fmapAForm (formResultUnOpt mr' MsgSheetAuthorshipStatementContent) $ contentField id) + -- (fslI MsgSheetAuthorshipStatementRequired & setTooltip MsgSheetAuthorshipStatementRequiredTip) + -- (is _Just . sfAuthorshipStatement <$> template) + -- SchoolAuthorshipStatementModeRequired -> contentField $ setTooltip MsgSheetAuthorshipStatementRequiredForcedTip + -- _none -> pure Nothing where makeSheetPersonalisedFilesForm :: Maybe SheetPersonalisedFilesForm -> MForm Handler (AForm Handler SheetPersonalisedFilesForm) makeSheetPersonalisedFilesForm template' = do diff --git a/src/Handler/Sheet/New.hs b/src/Handler/Sheet/New.hs index f235e9363..9ec4770c6 100644 --- a/src/Handler/Sheet/New.hs +++ b/src/Handler/Sheet/New.hs @@ -25,8 +25,9 @@ postSheetNewR tid ssh csh = do let searchShn sheet = case parShn of (FormSuccess (Just shn)) -> E.where_ $ sheet E.^. SheetName E.==. E.val shn _other -> return () - (lastSheets, loads) <- runDB $ do - lSheets <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do + now <- liftIO getCurrentTime + template <- runDB $ do + lastSheets <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse E.where_ $ course E.^. CourseTerm E.==. E.val tid E.&&. course E.^. CourseSchool E.==. E.val ssh @@ -38,41 +39,37 @@ postSheetNewR tid ssh csh = do firstEdit = E.subSelectMaybe . E.from $ \sheetEdit -> do E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId return . E.min_ $ sheetEdit E.^. SheetEditTime - -- mAuthorshipStatement = E.subSelect . E.from $ \authorshipStatementDefinition -> do - -- E.where_ $ E.just (authorshipStatementDefinition E.^. AuthorshipStatementDefinitionId) E.==. sheet E.^. SheetAuthorshipStatement - -- return $ authorshipStatementDefinition E.^. AuthorshipStatementDefinitionContent return (sheet, firstEdit) cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh loads <- defaultLoads cid - return (lSheets, loads) - now <- liftIO getCurrentTime - let template = case lastSheets of - ((Entity {entityVal=Sheet{..}}, E.Value fEdit):_) -> - let addTime = addWeeks $ max 1 $ weeksToAdd (fromMaybe (UTCTime systemEpochDay 0) $ sheetActiveTo <|> fEdit) now - in Just $ SheetForm - { sfName = stepTextCounterCI sheetName - , sfDescription = sheetDescription - , sfType = review _SqlKey <$> sheetType - , sfGrouping = sheetGrouping - , sfVisibleFrom = addTime <$> sheetVisibleFrom - , sfActiveFrom = addTime <$> sheetActiveFrom - , sfActiveTo = addTime <$> sheetActiveTo - , sfSubmissionMode = sheetSubmissionMode - , sfSheetF = Nothing - , sfHintFrom = addTime <$> sheetHintFrom - , sfHintF = Nothing - , sfSolutionFrom = addTime <$> sheetSolutionFrom - , sfSolutionF = Nothing - , sfMarkingF = Nothing - , sfMarkingText = sheetMarkingText - , sfAutoDistribute = sheetAutoDistribute - , sfCorrectors = loads - , sfAnonymousCorrection = sheetAnonymousCorrection - , sfRequireExamRegistration = Nothing - , sfPersonalF = Nothing - , sfAuthorshipStatement = Nothing -- TODO: implement sheet-specific statements - } - _other -> Nothing + for (lastSheets ^? _head) $ \(Entity _ Sheet{..}, E.Value fEdit) -> do + let addTime = addWeeks $ max 1 $ weeksToAdd (fromMaybe (UTCTime systemEpochDay 0) $ sheetActiveTo <|> fEdit) now + mStmt <- traverse getJust sheetAuthorshipStatement + return SheetForm + { sfName = stepTextCounterCI sheetName + , sfDescription = sheetDescription + , sfType = review _SqlKey <$> sheetType + , sfGrouping = sheetGrouping + , sfVisibleFrom = addTime <$> sheetVisibleFrom + , sfActiveFrom = addTime <$> sheetActiveFrom + , sfActiveTo = addTime <$> sheetActiveTo + , sfSubmissionMode = sheetSubmissionMode + , sfSheetF = Nothing + , sfHintFrom = addTime <$> sheetHintFrom + , sfHintF = Nothing + , sfSolutionFrom = addTime <$> sheetSolutionFrom + , sfSolutionF = Nothing + , sfMarkingF = Nothing + , sfMarkingText = sheetMarkingText + , sfAutoDistribute = sheetAutoDistribute + , sfCorrectors = loads + , sfAnonymousCorrection = sheetAnonymousCorrection + , sfRequireExamRegistration = Nothing + , sfPersonalF = Nothing + , sfAuthorshipStatementMode = sheetAuthorshipStatementMode + , sfAuthorshipStatementExam = sheetAuthorshipStatementExam + , sfAuthorshipStatement = authorshipStatementDefinitionContent <$> mStmt + } let action = -- More specific error message for new sheet could go here, if insertUnique returns Nothing insertUnique handleSheetEdit tid ssh csh Nothing template action diff --git a/src/Handler/Submission/Helper.hs b/src/Handler/Submission/Helper.hs index bb4e29217..229cd8838 100644 --- a/src/Handler/Submission/Helper.hs +++ b/src/Handler/Submission/Helper.hs @@ -32,15 +32,40 @@ import Handler.Submission.SubmissionUserInvite import qualified Data.Conduit.Combinators as C -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' +makeSubmissionForm :: forall m. (MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m) + => CourseId -> Entity Sheet -> 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 + uploadRes <- aFormToWForm uploadForm + submittorsRes <- submittorsForm' + lecturerIsSubmittor <- case submittorsRes of + FormSuccess subs -> maybe False ((`Set.member` subs) . Right) <$> maybeAuthId + _other -> return False + authorshipStatementRes <- authorshipStatementForm lecturerIsSubmittor + return $ (,,) <$> uploadRes <*> submittorsRes <*> authorshipStatementRes where - uploadForm - | is _NoUpload uploadMode = pure Nothing - | is _Nothing msmid = uploadForm' - | otherwise = join <$> optionalActionNegatedA uploadForm' (fslI MsgSubmissionFilesUnchanged & setTooltip MsgSubmissionFilesUnchangedTip) (Just False) + -- TODO(AuthorshipStatements): for lecturer: optionally only invite (co-)submittors instead of adding directly; so they will be forced to make authorship statements + -- also take care that accepting the invite (optionally) remains possible even after the submission deadline (for creating submissions for course users as a lecturer) + + authorshipStatementForm :: Bool -> WForm (ReaderT SqlBackend m) (FormResult (Maybe AuthorshipStatementDefinitionId)) + authorshipStatementForm lecturerIsSubmittor = maybeT (return $ FormSuccess Nothing) $ do + asd <- MaybeT . lift . lift $ getSheetAuthorshipStatement sheetEnt + let authorshipStatementForm' = apopt (acceptAuthorshipStatementField asd) (fslI MsgSubmissionAuthorshipStatement & setTooltip MsgSubmissionAuthorshipStatementTip) Nothing + authorshipStatementRes <- lift . hoist (hoist liftHandler) $ if + | isLecturer + -> optionalActionW authorshipStatementForm' (fslI MsgSubmissionLecturerAuthorshipStatement & setTooltip MsgSubmissionLecturerAuthorshipStatementTip) (Just False) + | otherwise + -> fmap Just <$> aFormToWForm authorshipStatementForm' + if + | FormSuccess Nothing <- authorshipStatementRes + , lecturerIsSubmittor -> formFailure [MsgSubmissionLecturerAuthorshipStatementRequiredBecauseSubmittor] + | otherwise -> return authorshipStatementRes + + uploadForm :: AForm (ReaderT SqlBackend m) (Maybe FileUploads) + uploadForm = hoistAForm liftHandler $ if + | is _NoUpload uploadMode -> pure Nothing + | is _Nothing msmid -> uploadForm' + | otherwise -> join <$> optionalActionNegatedA uploadForm' (fslI MsgSubmissionFilesUnchanged & setTooltip MsgSubmissionFilesUnchangedTip) (Just False) uploadForm' = fileUploadForm (not isLecturer) (fslI . bool MsgSubmissionFile MsgSubmissionArchive) uploadMode mPrev @@ -98,9 +123,11 @@ makeSubmissionForm cid shid msmid uploadMode grouping mPrev isLecturer prefillUs E.orderBy [E.asc $ user E.^. UserEmail] return user - addField :: (MonadHandler m, HandlerSite m ~ UniWorX) => UserId -> Field m (Set (Either UserEmail UserId)) + addField :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => UserId -> Field m' (Set (Either UserEmail UserId)) addField uid = multiUserInvitationField . MUILookupSuggested (SomeMessage MsgMultiUserFieldExplanationPrevCoSubmittors) $ previousCoSubmittors uid + addFieldLecturer, addFieldAuthorshipStatements :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => Field m' (Set (Either UserEmail UserId)) addFieldLecturer = multiUserInvitationField $ MUILookupSuggested (SomeMessage MsgMultiUserFieldExplanationCourseParticipants) courseUsers + addFieldAuthorshipStatements = multiUserInvitationField MUIAlwaysInvite addFieldSettings :: (forall msg. RenderMessage UniWorX msg => msg -> Text) -> FieldSettings UniWorX addFieldSettings mr = fslpI MsgSubmissionMembers $ mr MsgLdapIdentificationOrEmail @@ -119,6 +146,7 @@ makeSubmissionForm cid shid msmid uploadMode grouping mPrev isLecturer prefillUs miButtonAction' :: forall p. PathPiece p => Maybe (Route UniWorX) -> p -> Maybe (SomeRoute UniWorX) miButtonAction' mCurrent frag = mCurrent <&> \current -> SomeRoute (current :#: frag) + submittorsForm' :: WForm (ReaderT SqlBackend m) (FormResult (Set (Either UserEmail UserId))) submittorsForm' = maybeT submittorsForm $ do restr <- MaybeT (liftHandler $ maybeCurrentBearerRestrictions @Value) >>= hoistMaybe . preview (_Object . ix "submittors" . _Array) let _Submittor = prism (either toJSON toJSON) $ \x -> first (const x) $ JSON.parseEither (\x' -> fmap Right (parseJSON x') <|> fmap Left (parseJSON x')) x @@ -126,10 +154,11 @@ makeSubmissionForm cid shid msmid uploadMode grouping mPrev isLecturer prefillUs fmap Set.fromList <$> forMOf (traverse . traverse . _Right) submittors decrypt + submittorsForm :: WForm (ReaderT SqlBackend m) (FormResult (Set (Either UserEmail UserId))) submittorsForm | isLecturer = do -- Form is being used by lecturer; allow Everything™ let - miAdd :: (Text -> Text) -> FieldView UniWorX -> Form ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId]) + miAdd :: (Text -> Text) -> FieldView UniWorX -> (Markup -> MForm (ReaderT SqlBackend m) (FormResult ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId]), Widget)) miAdd nudge btn csrf = do MsgRenderer mr <- getMsgRenderer (addRes, addView) <- mpreq addFieldLecturer (addFieldSettings mr & addName (nudge "emails")) Nothing @@ -150,6 +179,12 @@ makeSubmissionForm cid shid msmid uploadMode grouping mPrev isLecturer prefillUs | otherwise = do uid <- liftHandler requireAuthId mRoute <- getCurrentRoute + doAuthorshipStatements <- lift . lift $ is _Just <$> getSheetAuthorshipStatement sheetEnt + + prefillUsers' <- lift . lift . fmap catMaybes . for (Set.toList prefillUsers) $ \case + Right uid' | doAuthorshipStatements + -> fmap (Left . userEmail) <$> get uid' + other -> return $ pure other let miAdd :: ListPosition @@ -157,10 +192,14 @@ makeSubmissionForm cid shid msmid uploadMode grouping mPrev isLecturer prefillUs -> ListLength -> (Text -> Text) -> FieldView UniWorX - -> Maybe (Form (Map ListPosition (Either UserEmail UserId) -> FormResult (Map ListPosition (Either UserEmail UserId)))) + -> Maybe (Markup -> MForm (ReaderT SqlBackend m) (FormResult (Map ListPosition (Either UserEmail UserId) -> FormResult (Map ListPosition (Either UserEmail UserId))), Widget)) miAdd dim pos liveliness nudge btn = guardOn (miAllowAdd dim pos liveliness) $ \csrf -> do MsgRenderer mr <- getMsgRenderer - (addRes, addView) <- mpreq (addField uid) (addFieldSettings mr & addName (nudge "emails")) Nothing + (addRes, addView) <- if + | doAuthorshipStatements + -> mpreq addFieldAuthorshipStatements (addFieldSettings mr & addName (nudge "emails") & setTooltip MsgSubmissionCoSubmittorsInviteRequiredBecauseAuthorshipStatements) Nothing + | otherwise + -> mpreq (addField uid) (addFieldSettings mr & addName (nudge "emails")) Nothing let addRes' = addRes <&> \newData oldData -> if | existing <- newData `Set.intersection` setOf folded oldData , not $ Set.null existing @@ -173,12 +212,12 @@ makeSubmissionForm cid shid msmid uploadMode grouping mPrev isLecturer prefillUs -> Either UserEmail UserId -> Maybe () -> (Text -> Text) - -> Form () + -> (Markup -> MForm (ReaderT SqlBackend m) (FormResult (), Widget)) miCell _ dat _ _ csrf = return (FormSuccess (), miCell' csrf dat) miDelete :: Map ListPosition (Either UserEmail UserId) -> ListPosition - -> MaybeT (MForm Handler) (Map ListPosition ListPosition) + -> MaybeT (MForm (ReaderT SqlBackend m)) (Map ListPosition ListPosition) miDelete dat delPos = do guard mayEdit guard $ Map.size dat > 1 @@ -215,7 +254,7 @@ makeSubmissionForm cid shid msmid uploadMode grouping mPrev isLecturer prefillUs where resultUsers = setOf (folded . _1) valMap -- when (maxSize > Just 1) $ -- wformMessage =<< messageI Info MsgCosubmittorTip - fmap postProcess <$> massInputW MassInput{..} submittorSettings' True (Just . Map.fromList . zip [0..] . map (, ()) $ Set.toList prefillUsers) + fmap postProcess <$> massInputW MassInput{..} submittorSettings' True (Just . Map.fromList . zip [0..] . map (, ()) $ prefillUsers') submissionHelper :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Maybe CryptoFileNameSubmission -> Handler Html submissionHelper tid ssh csh shn mcid = do @@ -329,10 +368,10 @@ 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 shid Sheet{..}, buddies, _, _, isLecturer, isOwner, _, _) <- runDB getSheetInfo + ((res,formWidget'), formEnctype) <- runDB $ do + (sheet@(Entity _ Sheet{..}), buddies, _, _, isLecturer, isOwner, _, _) <- getSheetInfo let mPrevUploads = msmid <&> \smid -> runDBSource $ selectSource [SubmissionFileSubmission ==. smid, SubmissionFileIsUpdate ==. False] [Asc SubmissionFileTitle] .| C.map (view $ _FileReference . _1) - 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 + 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 let formWidget = wrapForm' BtnHandIn formWidget' def { formAction = Just $ SomeRoute actionUrl , formEncoding = formEnctype @@ -369,7 +408,7 @@ submissionHelper tid ssh csh shn mcid = do res' <- case res of FormMissing -> return FormMissing (FormFailure failmsgs) -> return $ FormFailure failmsgs - (FormSuccess res'@(_, groupMembers)) + (FormSuccess res'@(_, groupMembers, _)) | groupMembers == subUsersOld -> return $ FormSuccess res' | isLecturer -> return $ FormSuccess res' | Arbitrary{..} <- sheetGrouping -> do -- Validate AdHoc Group Members @@ -412,7 +451,9 @@ submissionHelper tid ssh csh shn mcid = do | otherwise -> return $ FormSuccess res' - formResultMaybe res' $ \(mFiles, adhocMembers) -> do + formResultMaybe res' $ \(mFiles, adhocMembers, mASDId) -> do + now <- liftIO getCurrentTime + smid <- case (mFiles, msmid) of (Nothing, Just smid) -- no new files, existing submission partners updated -> return smid @@ -430,7 +471,6 @@ submissionHelper tid ssh csh shn mcid = do } audit $ TransactionSubmissionEdit sid shid - now <- liftIO getCurrentTime insert_ $ SubmissionEdit muid now sid return sid @@ -485,6 +525,10 @@ submissionHelper tid ssh csh shn mcid = do unless (Just subUid == muid) $ queueDBJob . JobQueueNotification $ NotificationSubmissionUserDeleted subUid shid smid + forM_ mASDId $ \asdId -> do + uid <- maybe notAuthenticated return muid + insert_ $ AuthorshipStatementSubmission asdId smid uid now + addMessageI Success $ if | Nothing <- msmid -> MsgSubmissionCreated | otherwise -> MsgSubmissionUpdated Just <$> encrypt smid diff --git a/src/Handler/Submission/SubmissionUserInvite.hs b/src/Handler/Submission/SubmissionUserInvite.hs index b2c7b9e41..d8095f164 100644 --- a/src/Handler/Submission/SubmissionUserInvite.hs +++ b/src/Handler/Submission/SubmissionUserInvite.hs @@ -7,8 +7,10 @@ module Handler.Submission.SubmissionUserInvite ) where import Import +import Utils.Form import Handler.Utils.Invitations +import Handler.Utils.AuthorshipStatement import Data.Aeson hiding (Result(..)) @@ -79,8 +81,18 @@ submissionUserInvitationConfig = InvitationConfig{..} itStartsAt = Nothing return InvitationTokenConfig{..} invitationRestriction _ _ = return Authorized - invitationForm _ _ _ = pure (JunctionSubmissionUser, ()) - invitationInsertHook _ _ _ _ _ = id + invitationForm (Entity _ Submission{..}) _ _ = wFormToAForm $ do + -- TODO(AuthorshipStatements): allow invitee to download submission files/see co-submittors iff authorship-statement is required + authorshipStatementRes <- maybeT (return $ FormSuccess Nothing) . fmap (fmap Just) $ do + sheetEnt <- lift . lift . lift $ getJustEntity submissionSheet + asd <- MaybeT . lift . lift $ getSheetAuthorshipStatement sheetEnt + lift $ wpopt (acceptAuthorshipStatementField asd) (fslI MsgSubmissionAuthorshipStatement & setTooltip MsgSubmissionAuthorshipStatementTip) Nothing + return $ (JunctionSubmissionUser, ) <$> authorshipStatementRes + invitationInsertHook _ (Entity smid _) _ SubmissionUser{..} masdId act = do + for_ masdId $ \asdId -> do + now <- liftIO getCurrentTime + insert_ $ AuthorshipStatementSubmission asdId smid submissionUserUser now + act invitationSuccessMsg (Entity _ Submission{..}) _ = do Sheet{..} <- getJust submissionSheet return . SomeMessage $ MsgSubmissionUserInvitationAccepted sheetName diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs index 7ca9e1843..5d635e60e 100644 --- a/src/Handler/Utils.hs +++ b/src/Handler/Utils.hs @@ -25,6 +25,7 @@ import Handler.Utils.Occurrences as Handler.Utils import Handler.Utils.Memcached as Handler.Utils hiding (manageMemcachedLocalInvalidations) import Handler.Utils.Files as Handler.Utils import Handler.Utils.Download as Handler.Utils +import Handler.Utils.AuthorshipStatement as Handler.Utils import Handler.Utils.Term as Handler.Utils diff --git a/src/Handler/Utils/AuthorshipStatement.hs b/src/Handler/Utils/AuthorshipStatement.hs new file mode 100644 index 000000000..7fa8d6d86 --- /dev/null +++ b/src/Handler/Utils/AuthorshipStatement.hs @@ -0,0 +1,116 @@ +module Handler.Utils.AuthorshipStatement + ( insertAuthorshipStatement + , forcedAuthorshipStatementField + , authorshipStatementWidget + , getSheetAuthorshipStatement + , acceptAuthorshipStatementField + ) where + +import Import +import Utils.Form + +import qualified Data.Map.Strict as Map + +import Handler.Utils.Form (i18nLangMap, I18nLang(..)) + +import qualified Database.Esqueleto.Legacy as E +import qualified Database.Esqueleto.Utils as E + + +insertAuthorshipStatement :: MonadIO m + => I18nStoredMarkup -> SqlWriteT m AuthorshipStatementDefinitionId +insertAuthorshipStatement authorshipStatementDefinitionContent = withCompatibleBackend @SqlBackend $ do + let authorshipStatementDefinitionHash = toAuthorshipStatementReference authorshipStatementDefinitionContent + unlessM (exists [AuthorshipStatementDefinitionHash ==. authorshipStatementDefinitionHash]) $ + insert_ AuthorshipStatementDefinition{..} + return $ AuthorshipStatementDefinitionKey authorshipStatementDefinitionHash + +forcedAuthorshipStatementField :: (MonadHandler handler, HandlerSite handler ~ UniWorX) + => Field handler I18nStoredMarkup +forcedAuthorshipStatementField = Field{..} + where + fieldParse _ _ = pure . Left $ SomeMessage ("Result of forcedAuthorshipStatementField inspected" :: Text) + fieldEnctype = UrlEncoded + fieldView theId _name attrs (preview _Right -> mVal) _isReq + = [whamlet| + $newline never +
+ ^{maybe mempty authorshipStatementWidget mVal} + |] + +authorshipStatementWidget :: I18nStoredMarkup -> Widget +authorshipStatementWidget stmt + = [whamlet| + $newline never +
+ $forall (I18nLang l, t) <- Map.toList (review i18nLangMap stmt) +
+ _{MsgLanguageEndonym l} +
+ #{markupOutput t} + |] + +acceptAuthorshipStatementField :: forall m. + (MonadHandler m, HandlerSite m ~ UniWorX) + => Entity AuthorshipStatementDefinition + -> Field m AuthorshipStatementDefinitionId +acceptAuthorshipStatementField (Entity asdId AuthorshipStatementDefinition{..}) + = checkBoxField + & _fieldView %~ adjFieldView + & checkMap (bool (Left MsgAuthorshipStatementStatementIsRequired) (Right asdId)) (== asdId) + where + adjFieldView :: FieldViewFunc m Bool -> FieldViewFunc m Bool + adjFieldView checkboxView theId theName attrs val isReq = do + let checkboxWdgt = checkboxView checkboxId theName [] val isReq + checkboxId = theId <> "__checkbox" + $(widgetFile "widgets/authorship-statement-accept") + + +getSheetAuthorshipStatement :: MonadIO m + => Entity Sheet + -> SqlReadT m (Maybe (Entity AuthorshipStatementDefinition)) +getSheetAuthorshipStatement (Entity _ Sheet{..}) = withCompatibleBackend @SqlBackend $ traverse getJustEntity <=< runMaybeT $ do + Entity _ School{..} <- MaybeT . E.selectMaybe . E.from $ \(school `E.InnerJoin` course) -> do + E.on $ school E.^. SchoolId E.==. course E.^. CourseSchool + E.where_ $ course E.^. CourseId E.==. E.val sheetCourse + return school + + let examId = sheetAuthorshipStatementExam + <|> sheetType ^? _examPart . re _SqlKey + <|> sheetRequireExamRegistration + exam <- lift $ traverse getJust examId + + let + examAuthorshipStatement' = exam >>= examAuthorshipStatement + sheetAuthorshipStatement' = guardOnM (is _SheetAuthorshipStatementModeEnabled sheetAuthorshipStatementMode) sheetAuthorshipStatement + sheetDoAuthorshipStatements + = is _SheetAuthorshipStatementModeEnabled sheetAuthorshipStatementMode + || (is _SheetAuthorshipStatementModeExam sheetAuthorshipStatementMode && is _Just examAuthorshipStatement') + + if + | is _Just exam + , is _SchoolAuthorshipStatementModeNone schoolSheetExamAuthorshipStatementMode + -> mzero + | is _Just exam + , not schoolSheetExamAuthorshipStatementAllowOther + -> guardOnM (is _SchoolAuthorshipStatementModeRequired schoolSheetExamAuthorshipStatementMode || sheetDoAuthorshipStatements) $ hoistMaybe schoolSheetExamAuthorshipStatementDefinition + | is _Just exam + , is _SchoolAuthorshipStatementModeRequired schoolSheetExamAuthorshipStatementMode + -> hoistMaybe $ sheetAuthorshipStatement' + <|> guardOnM (is _SheetAuthorshipStatementModeExam sheetAuthorshipStatementMode) examAuthorshipStatement' + <|> schoolSheetExamAuthorshipStatementDefinition + + | is _Nothing exam + , is _SchoolAuthorshipStatementModeNone schoolSheetAuthorshipStatementMode + -> mzero + | is _Nothing exam + , not schoolSheetAuthorshipStatementAllowOther + -> guardOnM (is _SchoolAuthorshipStatementModeRequired schoolSheetAuthorshipStatementMode || sheetDoAuthorshipStatements) $ hoistMaybe schoolSheetAuthorshipStatementDefinition + | is _Nothing exam + , is _SchoolAuthorshipStatementModeRequired schoolSheetAuthorshipStatementMode + -> hoistMaybe $ sheetAuthorshipStatement' <|> schoolSheetAuthorshipStatementDefinition + + | otherwise + -> case exam of + Just _ -> hoistMaybe $ sheetAuthorshipStatement' <|> examAuthorshipStatement' + Nothing -> hoistMaybe sheetAuthorshipStatement' diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 8ecee5e33..d3462f37e 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -462,6 +462,15 @@ explainedMultiActionA :: forall action a. -> AForm Handler a explainedMultiActionA acts mActsOpts fSettings defAction = formToAForm $ explainedMultiAction acts mActsOpts fSettings defAction mempty +explainedMultiActionW :: forall action a. + Ord action + => Map action (AForm Handler a) + -> Handler ([(Option action, Maybe Widget)], Text -> Maybe action) + -> FieldSettings UniWorX + -> Maybe action + -> WForm Handler (FormResult a) +explainedMultiActionW acts mActsOpts fSettings defAction = aFormToWForm $ explainedMultiActionA acts mActsOpts fSettings defAction + ------------ -- Fields -- ------------ @@ -2407,20 +2416,13 @@ i18nForm :: forall a ident handler. -> ident -> FieldSettings UniWorX -> Bool - -> Maybe (I18n a) - -> (Markup -> MForm handler (FormResult (I18n a), FieldView UniWorX)) + -> Maybe (Maybe (I18n a)) + -> (Markup -> MForm handler (FormResult (Maybe (I18n a)), FieldView UniWorX)) i18nForm strForm onlyAppLanguages miButtonAction miIdent fSettings fRequired mPrev' csrf' - = fmap (over _1 massageFormResult) . ($ csrf') . massInput MassInput{..} fSettings fRequired $ fmap ((), ) . review i18nLangMap <$> mPrev' + = fmap (over _1 massageFormResult) . ($ csrf') . massInput MassInput{..} fSettings fRequired $ fmap ((), ) . review i18nLangMap <$> join mPrev' where - massageFormResult :: FormResult (Map I18nLang ((), a)) -> FormResult (I18n a) - massageFormResult = \case - FormSuccess xs - | Just xs' <- preview i18nLangMap $ map (view _2) xs - -> FormSuccess xs' - | otherwise - -> FormMissing - FormFailure errs -> FormFailure errs - FormMissing -> FormMissing + massageFormResult :: FormResult (Map I18nLang ((), a)) -> FormResult (Maybe (I18n a)) + massageFormResult = fmap $ preview i18nLangMap . map (view _2) miAdd :: I18nLang -> Natural -> I18nLangs -> (Text -> Text) -> FieldView UniWorX @@ -2494,6 +2496,36 @@ i18nField :: forall a ident handler. -> ident -> FieldSettings UniWorX -> Bool - -> Maybe (I18n a) - -> (Markup -> MForm handler (FormResult (I18n a), FieldView UniWorX)) + -> Maybe (Maybe (I18n a)) + -> (Markup -> MForm handler (FormResult (Maybe (I18n a)), FieldView UniWorX)) i18nField strField = i18nForm $ \nudge mPrev csrf -> over _2 ((toWidget csrf <>) . fvWidget) <$> mpreq strField (def & addName (nudge "string")) mPrev + +i18nFieldA :: forall a ident handler. + ( PathPiece ident + , MonadHandler handler, HandlerSite handler ~ UniWorX + , MonadThrow handler + ) + => Field handler a + -> Bool -- ^ Allow only languages from `appLanguages`? + -> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)) + -> ident + -> FieldSettings UniWorX + -> Bool + -> Maybe (Maybe (I18n a)) + -> AForm handler (Maybe (I18n a)) +i18nFieldA strField onlyAppLanguages miButtonAction miIdent fSettings fRequired mPrev' = formToAForm $ over _2 pure <$> i18nField strField onlyAppLanguages miButtonAction miIdent fSettings fRequired mPrev' mempty + +i18nFieldW :: forall a ident handler. + ( PathPiece ident + , MonadHandler handler, HandlerSite handler ~ UniWorX + , MonadThrow handler + ) + => Field handler a + -> Bool -- ^ Allow only languages from `appLanguages`? + -> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)) + -> ident + -> FieldSettings UniWorX + -> Bool + -> Maybe (Maybe (I18n a)) + -> WForm handler (FormResult (Maybe (I18n a))) +i18nFieldW strField onlyAppLanguages miButtonAction miIdent fSettings fRequired mPrev' = aFormToWForm $ i18nFieldA strField onlyAppLanguages miButtonAction miIdent fSettings fRequired mPrev' diff --git a/src/Model/Types/Markup.hs b/src/Model/Types/Markup.hs index 08bce4f4d..ef644c961 100644 --- a/src/Model/Types/Markup.hs +++ b/src/Model/Types/Markup.hs @@ -31,7 +31,7 @@ data MarkupFormat | MarkupHtml | MarkupPlaintext deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable) - deriving anyclass (Universe, Finite, NFData) + deriving anyclass (Universe, Finite, Binary, Hashable, NFData) nullaryPathPiece ''MarkupFormat $ camelToPathPiece' 1 pathPieceJSON ''MarkupFormat @@ -41,7 +41,7 @@ data StoredMarkup = StoredMarkup , markupOutput :: Html } deriving (Read, Show, Generic, Typeable) - deriving anyclass (NFData) + deriving anyclass (Binary, Hashable, NFData) htmlToStoredMarkup :: Html -> StoredMarkup htmlToStoredMarkup html = StoredMarkup diff --git a/src/Model/Types/School.hs b/src/Model/Types/School.hs index fe9b43e5b..9fb8820fc 100644 --- a/src/Model/Types/School.hs +++ b/src/Model/Types/School.hs @@ -3,6 +3,16 @@ module Model.Types.School where import Import.NoModel import Model.Types.TH.PathPiece +import Database.Persist.Sql (PersistFieldSql(..)) +import Web.HttpApiData (ToHttpApiData, FromHttpApiData) +import Data.ByteArray (ByteArrayAccess) + +import qualified Crypto.Hash as Crypto +import qualified Data.Binary as Binary + +import Model.Types.Markup + + data SchoolFunction = SchoolAdmin | SchoolLecturer @@ -25,8 +35,26 @@ data SchoolAuthorshipStatementMode deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable) deriving anyclass (Universe, Finite, NFData) -finitePathPiece ''SchoolAuthorshipStatementMode [ "no-statement", "optional", "required" ] +finitePathPiece ''SchoolAuthorshipStatementMode [ "no-statement", "optional", "required" ] -- avoid @none@ since it does not play nice with yesod-form (`selectField` etc.) pathPieceJSON ''SchoolAuthorshipStatementMode pathPieceJSONKey ''SchoolAuthorshipStatementMode derivePersistFieldPathPiece ''SchoolAuthorshipStatementMode pathPieceBinary ''SchoolAuthorshipStatementMode +pathPieceHttpApiData ''SchoolAuthorshipStatementMode + +newtype AuthorshipStatementReference = AuthorshipStatementReference (Digest SHA3_512) + deriving (Eq, Ord, Read, Show, Lift, Generic, Typeable) + deriving newtype ( PersistField + , PathPiece, ToHttpApiData, FromHttpApiData, ToJSON, FromJSON + , Hashable, NFData + , ByteArrayAccess + , Binary + ) + +instance PersistFieldSql AuthorshipStatementReference where + sqlType _ = sqlType $ Proxy @(Digest SHA3_512) + +makeWrapped ''AuthorshipStatementReference + +toAuthorshipStatementReference :: I18nStoredMarkup -> AuthorshipStatementReference +toAuthorshipStatementReference = review _Wrapped . Crypto.hashlazy . Binary.encode diff --git a/src/Model/Types/Sheet.hs b/src/Model/Types/Sheet.hs index c9cac4fd9..69f2a0791 100644 --- a/src/Model/Types/Sheet.hs +++ b/src/Model/Types/Sheet.hs @@ -12,6 +12,7 @@ module Model.Types.Sheet import Import.NoModel import Model.Types.Common import Utils.Lens.TH +import Model.Types.TH.PathPiece import Generics.Deriving.Monoid (memptydefault, mappenddefault) @@ -406,3 +407,17 @@ instance Csv.ToField (SheetType epid, Maybe Points) where = Csv.toField res toField (_, Just _) = "submitted" + +data SheetAuthorshipStatementMode + = SheetAuthorshipStatementModeDisabled + | SheetAuthorshipStatementModeExam + | SheetAuthorshipStatementModeEnabled + deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) + deriving anyclass (Universe, Finite, NFData) + +nullaryPathPiece ''SheetAuthorshipStatementMode $ camelToPathPiece' 4 +derivePersistFieldPathPiece ''SheetAuthorshipStatementMode +pathPieceJSON ''SheetAuthorshipStatementMode +pathPieceJSONKey ''SheetAuthorshipStatementMode +pathPieceBinary ''SheetAuthorshipStatementMode +pathPieceHttpApiData ''SheetAuthorshipStatementMode diff --git a/src/Text/Blaze/Instances.hs b/src/Text/Blaze/Instances.hs index 19c479aa9..6b4597576 100644 --- a/src/Text/Blaze/Instances.hs +++ b/src/Text/Blaze/Instances.hs @@ -15,6 +15,8 @@ import qualified Data.Aeson as Aeson import qualified Data.Csv as Csv +import Data.Binary (Binary(..)) + instance Eq Markup where (==) = (==) `on` Text.renderMarkup @@ -45,3 +47,7 @@ instance Csv.FromField Markup where instance NFData Markup where rnf = rnf . Text.renderMarkup + +instance Binary Markup where + put = put . Text.renderMarkup + get = preEscapedText <$> get diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs index 0a1e4d89c..2c0815014 100644 --- a/src/Utils/Form.hs +++ b/src/Utils/Form.hs @@ -1280,6 +1280,18 @@ aSetTooltip tip = wFormToAForm . wSetTooltip tip . aFormToWForm data ValueRequired site = forall msg. RenderMessage site msg => ValueRequired msg +formResultUnOpt :: forall a site msg. + ( RenderMessage site msg + , RenderMessage site (ValueRequired site) + ) + => MsgRendererS site -> msg -> FormResult (Maybe a) -> FormResult a +formResultUnOpt (MsgRenderer mr) label = \case + FormFailure errs -> FormFailure errs + FormMissing -> FormMissing + FormSuccess Nothing -> FormFailure . pure $ mr (ValueRequired label :: ValueRequired site) + FormSuccess (Just x) -> FormSuccess x + + mreq :: forall m a. ( MonadHandler m , RenderMessage (HandlerSite m) (ValueRequired (HandlerSite m)) diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs index e48ac5dd5..048a6f49d 100644 --- a/src/Utils/Lens.hs +++ b/src/Utils/Lens.hs @@ -176,6 +176,7 @@ makeLenses_ ''StudyTermNameCandidate makeLenses_ ''StudySubTermParentCandidate makeLenses_ ''StudyTermStandaloneCandidate +makeLenses_ ''Field makeLenses_ ''FieldView makeLenses_ ''FieldSettings @@ -281,6 +282,9 @@ makeLenses_ ''JobMode -- makeClassy_ ''Load +makePrisms ''SchoolAuthorshipStatementMode +makePrisms ''SheetAuthorshipStatementMode + -------------------------- -- Fields for `UniWorX` -- -------------------------- diff --git a/templates/i18n/changelog/authorship-statements.de-de-formal.hamlet b/templates/i18n/changelog/authorship-statements.de-de-formal.hamlet new file mode 100644 index 000000000..679e4a027 --- /dev/null +++ b/templates/i18n/changelog/authorship-statements.de-de-formal.hamlet @@ -0,0 +1,2 @@ +$newline never +Es kann die Abgabe einer Eigenständigkeitserklärung bei Anlegen einer Übungsblattabgabe gefordert werden. diff --git a/templates/i18n/changelog/authorship-statements.en-eu.hamlet b/templates/i18n/changelog/authorship-statements.en-eu.hamlet new file mode 100644 index 000000000..2172a5abc --- /dev/null +++ b/templates/i18n/changelog/authorship-statements.en-eu.hamlet @@ -0,0 +1,2 @@ +$newline never +Submittors can be required to make a Statement of Authorship when creating their submission for an exercise sheet. diff --git a/templates/i18n/sheet-authorship-statement-mode-tip/disabled/de-de-formal.hamlet b/templates/i18n/sheet-authorship-statement-mode-tip/disabled/de-de-formal.hamlet new file mode 100644 index 000000000..6b7cea00e --- /dev/null +++ b/templates/i18n/sheet-authorship-statement-mode-tip/disabled/de-de-formal.hamlet @@ -0,0 +1,7 @@ +$newline never +Es werden keine Eigenständigkeitserklärungen gefordert. + +$if is _SchoolAuthorshipStatementModeRequired schoolSheetExamAuthorshipStatementMode +
+ + Wegen Regeln des Instituts, unter dem der Kurs angelegt wurde, wird trotz dieser Einstellung eine Eigenständigkeitserklärung gefordert, wenn das Übungsblatt Prüfungsbezug hat. diff --git a/templates/i18n/sheet-authorship-statement-mode-tip/disabled/en-eu.hamlet b/templates/i18n/sheet-authorship-statement-mode-tip/disabled/en-eu.hamlet new file mode 100644 index 000000000..c8f61b475 --- /dev/null +++ b/templates/i18n/sheet-authorship-statement-mode-tip/disabled/en-eu.hamlet @@ -0,0 +1,7 @@ +$newline never +No Statements of Authorship will be required. + +$if is _SchoolAuthorshipStatementModeRequired schoolSheetExamAuthorshipStatementMode +
+ + Due to rules of the school this course is associated with, Statements of Authorship will be required anyways if this exercise sheet is associated with an exam. diff --git a/templates/i18n/sheet-authorship-statement-mode-tip/enabled/de-de-formal.hamlet b/templates/i18n/sheet-authorship-statement-mode-tip/enabled/de-de-formal.hamlet new file mode 100644 index 000000000..c1e1be89f --- /dev/null +++ b/templates/i18n/sheet-authorship-statement-mode-tip/enabled/de-de-formal.hamlet @@ -0,0 +1,2 @@ +$newline never +Alle Abgebende müssen jeweils eine Eigenständigkeitserklärung abgeben. diff --git a/templates/i18n/sheet-authorship-statement-mode-tip/enabled/en-eu.hamlet b/templates/i18n/sheet-authorship-statement-mode-tip/enabled/en-eu.hamlet new file mode 100644 index 000000000..503eb4161 --- /dev/null +++ b/templates/i18n/sheet-authorship-statement-mode-tip/enabled/en-eu.hamlet @@ -0,0 +1,2 @@ +$newline never +All submittors are required to make a Statement of Authorship. diff --git a/templates/i18n/sheet-authorship-statement-mode-tip/exam/de-de-formal.hamlet b/templates/i18n/sheet-authorship-statement-mode-tip/exam/de-de-formal.hamlet new file mode 100644 index 000000000..a2b443d8b --- /dev/null +++ b/templates/i18n/sheet-authorship-statement-mode-tip/exam/de-de-formal.hamlet @@ -0,0 +1,14 @@ +$newline never +Falls das Übungsblatt Prüfungsbezug hat, greifen die Einstellungen der jeweiligen Prüfung. + +
+ +Ein Übungsblatt steht im Bezug zu einer Prüfung, falls eine der folgenden Bedingungen erfüllt ist: + +
    +
  • + Es wird unter „_{MsgSheetAuthorshipStatementExam}“ manuell eine Prüfung eingestellt +
  • + Das Übungsblatt wird „_{MsgSheetTypeExamPartPoints}“ gewertet +
  • + Die Anmeldung zur Prüfung wird vorausgesetzt um für das Übungsblatt abgeben zu dürfen („_{MsgSheetRequireExam}“) diff --git a/templates/i18n/sheet-authorship-statement-mode-tip/exam/en-eu.hamlet b/templates/i18n/sheet-authorship-statement-mode-tip/exam/en-eu.hamlet new file mode 100644 index 000000000..72564a3bc --- /dev/null +++ b/templates/i18n/sheet-authorship-statement-mode-tip/exam/en-eu.hamlet @@ -0,0 +1,14 @@ +$newline never +If the exercise sheet is associated with an exam, the settings of the exam are applied. + +
    + +An exercise sheet is associated with an exam if one of the following is true: + +
      +
    • + An exam was manually configured under “_{MsgSheetAuthorshipStatementExam}” +
    • + The exercise sheet is valued “_{MsgSheetTypeExamPartPoints}” +
    • + Registration for an exam is required to submit for the exercise sheet (“_{MsgSheetRequireExam}”) diff --git a/templates/submission.hamlet b/templates/submission.hamlet index a6661c4b5..e1eddf56a 100644 --- a/templates/submission.hamlet +++ b/templates/submission.hamlet @@ -46,6 +46,8 @@ $if is _Just mcid $nothing
    • #{time} + $# TODO(AuthorshipStatements): show statements confirmed (iff display is not anonymous (lecturer/submittor/non-anonymous corrector)?) + $if maySubmit

      _{MsgSubmissionReplace} diff --git a/templates/widgets/authorship-statement-accept.hamlet b/templates/widgets/authorship-statement-accept.hamlet new file mode 100644 index 000000000..df9e72615 --- /dev/null +++ b/templates/widgets/authorship-statement-accept.hamlet @@ -0,0 +1,11 @@ +$newline never +
      +
      + ^{authorshipStatementWidget authorshipStatementDefinitionContent} + +