feat: demand authorship statements

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

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.
+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.

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

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

messages/uniworx/categories/courses/submission/de-de-formal.msg

@@ -193,3 +193,10 @@ SubmissionDoneAlways: Immer
 SheetGroupNoGroups: Keine Gruppenabgabe
 
 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.

messages/uniworx/categories/courses/submission/en-eu.msg

@@ -192,3 +192,10 @@ SubmissionDoneAlways: Always
 SheetGroupNoGroups: No group submission
 
 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.

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.

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.

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 AuthorshipStatementDefinitionId
-    statement StoredMarkup  -- stored as plain StoredMarkup as the "signed" statement needs to be persisted
+    submission SubmissionId
-    UniqueAuthorshipStatementSubmission submissionUser
+    user UserId
+    time UTCTime
     deriving Generic

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

src/Foundation/I18n.hs

@@ -14,6 +14,7 @@ module Foundation.I18n
   , UniWorXMetricsMessage(..), UniWorXNewsMessage(..), UniWorXSchoolMessage(..), UniWorXSystemMessageMessage(..)
   , UniWorXTermMessage(..), UniWorXSendMessage(..), UniWorXSiteLayoutMessage(..), UniWorXErrorMessage(..)
   , UniWorXI18nMessage(..),UniWorXJobsHandlerMessage(..), UniWorXModelTypesMessage(..), UniWorXYesodMiddlewareMessage(..)
+  , UniWorXAuthorshipStatementMessage(..)
   , ShortTermIdentifier(..)
   , MsgLanguage(..)
   , ShortSex(..)
@@ -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
 

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
+        examAuthorshipStatement <- traverse insertAuthorshipStatement efAuthorshipStatement
-          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 }
-
         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) $

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 :: (FieldSettings UniWorX -> FieldSettings UniWorX) -> AForm Handler I18nStoredMarkup
-          reqContentField ttip = areq htmlField
+          reqContentField ttip = fmapAForm (formResultUnOpt mr' MsgSheetAuthorshipStatementContent)
-                                 (fslI MsgExamAuthorshipStatementContent & ttip)
+                               $ i18nFieldA htmlField True (\_ -> Nothing) ("authorship-statement" :: Text)
-                                 (     (efAuthorshipStatement =<< template)
+                                 (fslI MsgSheetAuthorshipStatementContent & ttip)
-                                   <|> (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement)
+                                 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
-          contentField ttipReq = bool forcedContentField (reqContentField ttipReq) schoolSheetExamAuthorshipStatementAllowOther
+            | 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)

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_

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
+  <*> apopt (selectField optionsFinite) (fslI MsgSchoolAuthorshipStatementSheetMode) (sfSheetAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional)
-  <*> aopt htmlField (fslI MsgSchoolAuthorshipStatementSheetDefinition & setTooltip MsgSchoolAuthorshipStatementSheetDefinitionTip) (sfSheetAuthorshipStatementDefinition <$> template)
+  <*> 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
+  <*> apopt (selectField optionsFinite) (fslI MsgSchoolAuthorshipStatementSheetExamMode) (sfSheetExamAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional)
-  <*> aopt htmlField (fslI MsgSchoolAuthorshipStatementSheetExamDefinition & setTooltip MsgSchoolAuthorshipStatementSheetExamDefinitionTip) (sfSheetExamAuthorshipStatementDefinition <$> template)
+  <*> 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 <- traverse insertAuthorshipStatement sfSheetAuthorshipStatementDefinition
-      mSheetAuthorshipStatementId <- insertAuthorshipStatement sfSheetAuthorshipStatementDefinition
+      mSheetExamAuthorshipStatementId <- traverse insertAuthorshipStatement sfSheetExamAuthorshipStatementDefinition
-      mSheetExamAuthorshipStatementId <- 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 <- traverse insertAuthorshipStatement sfSheetExamAuthorshipStatementDefinition
-      mSheetAuthorshipStatementId <- insertAuthorshipStatement sfSheetExamAuthorshipStatementDefinition
+      mSheetExamAuthorshipStatementId <- traverse insertAuthorshipStatement sfSheetExamAuthorshipStatementDefinition
-      mSheetExamAuthorshipStatementId <- insertAuthorshipStatement sfSheetExamAuthorshipStatementDefinition
       didInsert <- is _Just <$> insertUnique School
         { schoolShorthand = sfShorthand
         , schoolName = sfName

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
         }
 
@@ -102,6 +104,8 @@ handleSheetEdit tid ssh csh msId template dbAction = do
        --           | otherwise -> return $ entityKey <$> mOldAuthorshipStatement
        -- mNewAuthorshipStatementId <- insertNewOrKeepStatement sfAuthorshipStatement
   
+        sheetAuthorshipStatement <- traverse insertAuthorshipStatement sfAuthorshipStatement
+
         let newSheet = Sheet
               { sheetCourse         = cid
               , sheetName           = sfName
@@ -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

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
+    flip (renderWForm FormStandard) html $ do
-      <$> areq (textField & cfStrip & cfCI) (fslI MsgSheetName)         (sfName        <$> template)
+      sfNameRes <- wreq (textField & cfStrip & cfCI) (fslI MsgSheetName) (sfName <$> template)
-      <*> aopt htmlField      (fslI MsgSheetDescription) (sfDescription <$> template)
+      sfDescriptionRes <- wopt htmlField (fslI MsgSheetDescription) (sfDescription <$> template)
-      <*> optionalActionA (apreq (examField Nothing cId) (fslI MsgSheetRequiredExam) (sfRequireExamRegistration =<< template)) (fslI MsgSheetRequireExam & setTooltip MsgSheetRequireExamTip) (is _Just . sfRequireExamRegistration <$> template)
+      sfRequireExamRegistrationRes <- optionalActionW (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)
+      wformSection MsgSheetFormFiles
-      <*> aopt (multiFileField $ oldFileIds SheetHint)     (fslI MsgSheetHint)      (sfHintF <$> template)
+      sfSheetFRes <- wopt (multiFileField $ oldFileIds SheetExercise) (fslI MsgSheetExercise) (sfSheetF <$> template)
-      <*> aopt (multiFileField $ oldFileIds SheetSolution) (fslI MsgSheetSolution) (sfSolutionF <$> template)
+      sfHintFRes <- wopt (multiFileField $ oldFileIds SheetHint) (fslI MsgSheetHint) (sfHintF <$> template)
-      <*> aopt (multiFileField $ oldFileIds SheetMarking)  (fslI MsgSheetMarkingFiles
+      sfSolutionFRes <- wopt (multiFileField $ oldFileIds SheetSolution) (fslI MsgSheetSolution) (sfSolutionF <$> template)
-            & setTooltip MsgSheetMarkingTip)                  (sfMarkingF <$> template)
+      sfMarkingFRes <- wopt (multiFileField $ oldFileIds SheetMarking) (fslI MsgSheetMarkingFiles & setTooltip MsgSheetMarkingTip) (sfMarkingF <$> template)
-      <*> optionalActionA sheetPersonalisedFilesForm (fslI MsgSheetPersonalisedFiles & setTooltip MsgSheetPersonalisedFilesTip) (is _Just . sfPersonalF <$> template)
+      sfPersonalFRes <- optionalActionW sheetPersonalisedFilesForm (fslI MsgSheetPersonalisedFiles & setTooltip MsgSheetPersonalisedFilesTip) (is _Just . sfPersonalF <$> template)
-      <* aformSection MsgSheetFormTimes
+
-      <*> aopt utcTimeField   (fslI MsgSheetVisibleFrom
+      wformSection MsgSheetFormTimes
-            & setTooltip MsgSheetVisibleFromTip)
+      sfVisibleFromRes <- wopt utcTimeField (fslI MsgSheetVisibleFrom & setTooltip MsgSheetVisibleFromTip) ((sfVisibleFrom <$> template) <|> pure (Just ctime))
-                                                              ((sfVisibleFrom  <$> template) <|> pure (Just ctime))
+      sfActiveFromRes <- wopt utcTimeField (fslI MsgSheetActiveFrom & setTooltip MsgSheetActiveFromTip) (sfActiveFrom <$> template)
-      <*> aopt utcTimeField   (fslI MsgSheetActiveFrom
+      sfActiveToRes <- wopt utcTimeField (fslI MsgSheetActiveTo & setTooltip MsgSheetActiveToTip) (sfActiveTo <$> template)
-            & setTooltip MsgSheetActiveFromTip)
+      sfHintFromRes <- wopt utcTimeField (fslpI MsgSheetHintFrom (mr MsgSheetHintFromPlaceholder) & setTooltip MsgSheetHintFromTip) (sfHintFrom <$> template)
-                                                              (sfActiveFrom   <$> template)
+      sfSolutionFromRes <- wopt utcTimeField (fslpI MsgSheetSolutionFrom (mr MsgSheetSolutionFromPlaceholder) & setTooltip MsgSheetSolutionFromTip) (sfSolutionFrom <$> template)
-      <*> aopt utcTimeField   (fslI MsgSheetActiveTo & setTooltip MsgSheetActiveToTip) (sfActiveTo <$> template)
+
-      <*> aopt utcTimeField   (fslpI MsgSheetHintFrom (mr MsgSheetHintFromPlaceholder)
+      wformSection MsgSheetFormType
-            & setTooltip MsgSheetHintFromTip)                 (sfHintFrom     <$> template)
+      sfSubmissionModeRes <- aFormToWForm . submissionModeForm $ (sfSubmissionMode <$> template) <|> pure (SubmissionMode False . Just $ UploadAny True defaultExtensionRestriction False)
-      <*> aopt utcTimeField   (fslpI MsgSheetSolutionFrom (mr MsgSheetSolutionFromPlaceholder)
+      sfGroupingRes <- aFormToWForm $ sheetGroupAFormReq (fslI MsgSheetGroup) ((sfGrouping <$> template) <|> pure NoGroups)
-            & setTooltip MsgSheetSolutionFromTip)             (sfSolutionFrom <$> template)
+      sfTypeRes <- aFormToWForm $ sheetTypeAFormReq cId (fslI MsgSheetSheetType) (sfType <$> template)
-      <* aformSection MsgSheetFormType
+      sfAutoDistributeRes <- wpopt checkBoxField (fslI MsgAutoAssignCorrs) (sfAutoDistribute <$> template)
-      <*> submissionModeForm ((sfSubmissionMode <$> template) <|> pure (SubmissionMode False . Just $ UploadAny True defaultExtensionRestriction False))
+      sfMarkingTextRes <- wopt htmlField (fslI MsgSheetMarking) (sfMarkingText <$> template)
-      <*> sheetGroupAFormReq  (fslI MsgSheetGroup)        ((sfGrouping <$> template) <|> pure NoGroups)
+      sfAnonymousCorrectionRes <- wpopt checkBoxField (fslI MsgSheetAnonymousCorrection & setTooltip MsgSheetAnonymousCorrectionTip) (sfAnonymousCorrection <$> template)
-      <*> sheetTypeAFormReq cId (fslI MsgSheetSheetType) (sfType <$> template)
+      sfCorrectorsRes <- aFormToWForm . correctorForm $ maybe mempty sfCorrectors template
-      <*> apopt checkBoxField (fslI MsgAutoAssignCorrs) (sfAutoDistribute <$> template)
+
-      <*> aopt htmlField    (fslI MsgSheetMarking) (sfMarkingText <$> template)
+      let sfAuthorshipStatementExam' = sfAuthorshipStatementExam =<< template
-      <*> apopt checkBoxField (fslI MsgSheetAnonymousCorrection & setTooltip MsgSheetAnonymousCorrectionTip) (sfAnonymousCorrection <$> template)
+          sfAuthorshipStatement' = sfAuthorshipStatement =<< template
-      <*> correctorForm (maybe mempty sfCorrectors template)
+      (sfAuthorshipStatementModeRes, sfAuthorshipStatementExamRes, sfAuthorshipStatementRes)
-      -- TODO: add info: define exam-unrelated/related, if exam-unrelated: applies to sheet, if exam-related: overrides exam-wide authship statement settings
+        <- if | isn't _SchoolAuthorshipStatementModeNone schoolSheetAuthorshipStatementMode -> do
-      -- 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?)
+                  wformSection MsgSheetAuthorshipStatementSection
-      <*> let
+
-            reqContentField :: (FieldSettings UniWorX -> FieldSettings UniWorX) -> AForm Handler StoredMarkup
+                  let 
-            reqContentField ttip = areq htmlField
+                    reqContentField :: AForm Handler I18nStoredMarkup
-                                   (fslI MsgSheetAuthorshipStatementContent & ttip)
+                    reqContentField = formResultUnOpt mr' MsgSheetAuthorshipStatementContent
-                                   (     (sfAuthorshipStatement =<< template)
+                          `fmapAForm` i18nFieldA htmlField True (\_ -> Nothing) ("authorship-statement" :: Text)
-                                     <|> (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement)
+                                      (fslI MsgSheetAuthorshipStatementContent)
-                                   )
+                                      True
-            forcedContentField   = aforced htmlField
+                                      ( fmap Just $     (sfAuthorshipStatement =<< template)
-                                   (fslI MsgSheetAuthorshipStatementContent & setTooltip MsgSheetAuthorshipStatementContentForcedTip)
+                                                    <|> (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement)
-                                   (maybe mempty (authorshipStatementDefinitionContent . entityVal) mSchoolAuthorshipStatement)
+                                      )
-            contentField ttipReq = bool forcedContentField (reqContentField ttipReq) schoolSheetAuthorshipStatementAllowOther
+                    forcedContentField = wforced forcedAuthorshipStatementField (fslI MsgSheetAuthorshipStatementContent & setTooltip MsgSheetAuthorshipStatementContentForcedTip)
-          in case schoolSheetAuthorshipStatementMode of
+ 
-            SchoolAuthorshipStatementModeNone -> pure Nothing  -- suppress display of whole section incl. header
+                  if | not schoolSheetAuthorshipStatementAllowOther
-            otherMode -> aformSection MsgSheetAuthorshipStatementSection
+                       -> (pure SheetAuthorshipStatementModeEnabled, pure sfAuthorshipStatementExam', )
-                      *> case otherMode of
+                          <$> fmap sequenceA (traverse forcedContentField $ authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement)
-                           SchoolAuthorshipStatementModeOptional -> optionalActionA (contentField id)
+                     | otherwise -> do
-                                                                    (fslI MsgSheetAuthorshipStatementRequired & setTooltip MsgSheetAuthorshipStatementRequiredTip)
+                         examOpts <-
-                                                                    (is _Just . sfAuthorshipStatement <$> template)
+                           let examFieldQuery = E.from $ \exam -> do
-                           SchoolAuthorshipStatementModeRequired -> fmap Just . contentField $ setTooltip MsgSheetAuthorshipStatementRequiredForcedTip
+                                 E.where_ $ exam E.^. ExamCourse E.==. E.val cId
-                           _none                                 -> pure Nothing
+                                 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

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
+  now <- liftIO getCurrentTime
-    lSheets <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
+  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)
+    for (lastSheets ^? _head) $ \(Entity _ Sheet{..}, E.Value fEdit) -> do
-  now <- liftIO getCurrentTime
+      let addTime = addWeeks $ max 1 $ weeksToAdd (fromMaybe (UTCTime systemEpochDay 0) $ sheetActiveTo <|> fEdit) now
-  let template = case lastSheets of
+      mStmt <- traverse getJust sheetAuthorshipStatement
-        ((Entity {entityVal=Sheet{..}}, E.Value fEdit):_)  ->
+      return SheetForm
-          let addTime = addWeeks $ max 1 $ weeksToAdd (fromMaybe (UTCTime systemEpochDay 0) $ sheetActiveTo <|> fEdit) now
+        { sfName           = stepTextCounterCI sheetName
-          in Just $ SheetForm
+        , sfDescription    = sheetDescription
-            { sfName           = stepTextCounterCI sheetName
+        , sfType           = review _SqlKey <$> sheetType
-            , sfDescription    = sheetDescription
+        , sfGrouping       = sheetGrouping
-            , sfType           = review _SqlKey <$> sheetType
+        , sfVisibleFrom    = addTime <$> sheetVisibleFrom
-            , sfGrouping       = sheetGrouping
+        , sfActiveFrom     = addTime <$> sheetActiveFrom
-            , sfVisibleFrom    = addTime <$> sheetVisibleFrom
+        , sfActiveTo       = addTime <$> sheetActiveTo
-            , sfActiveFrom     = addTime <$> sheetActiveFrom
+        , sfSubmissionMode = sheetSubmissionMode
-            , sfActiveTo       = addTime <$> sheetActiveTo
+        , sfSheetF         = Nothing
-            , sfSubmissionMode = sheetSubmissionMode
+        , sfHintFrom       = addTime <$> sheetHintFrom
-            , sfSheetF         = Nothing
+        , sfHintF          = Nothing
-            , sfHintFrom       = addTime <$> sheetHintFrom
+        , sfSolutionFrom   = addTime <$> sheetSolutionFrom
-            , sfHintF          = Nothing
+        , sfSolutionF      = Nothing
-            , sfSolutionFrom   = addTime <$> sheetSolutionFrom
+        , sfMarkingF       = Nothing
-            , sfSolutionF      = Nothing
+        , sfMarkingText    = sheetMarkingText
-            , sfMarkingF       = Nothing
+        , sfAutoDistribute = sheetAutoDistribute
-            , sfMarkingText    = sheetMarkingText
+        , sfCorrectors     = loads
-            , sfAutoDistribute = sheetAutoDistribute
+        , sfAnonymousCorrection = sheetAnonymousCorrection
-            , sfCorrectors     = loads
+        , sfRequireExamRegistration = Nothing
-            , sfAnonymousCorrection = sheetAnonymousCorrection
+        , sfPersonalF      = Nothing
-            , sfRequireExamRegistration = Nothing
+        , sfAuthorshipStatementMode = sheetAuthorshipStatementMode
-            , sfPersonalF      = Nothing
+        , sfAuthorshipStatementExam = sheetAuthorshipStatementExam
-            , sfAuthorshipStatement = Nothing  -- TODO: implement sheet-specific statements
+        , sfAuthorshipStatement = authorshipStatementDefinitionContent <$> mStmt
-            }
+        }
-        _other -> Nothing
   let action = -- More specific error message for new sheet could go here, if insertUnique returns Nothing
         insertUnique
   handleSheetEdit tid ssh csh Nothing template action

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 :: forall m. (MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m)
-makeSubmissionForm cid shid msmid uploadMode grouping mPrev isLecturer prefillUsers = identifyForm FIDsubmission . renderAForm FormStandard $ (,)
+                   => CourseId -> Entity Sheet -> Maybe SubmissionId -> UploadMode -> SheetGroup -> Maybe FileUploads -> Bool -> Set (Either UserEmail UserId)
-  <$> uploadForm
+                   -> (Markup -> MForm (ReaderT SqlBackend m) (FormResult (Maybe FileUploads, Set (Either UserEmail UserId), Maybe AuthorshipStatementDefinitionId), Widget))
-  <*> wFormToAForm submittorsForm'
+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
+    -- TODO(AuthorshipStatements): for lecturer: optionally only invite (co-)submittors instead of adding directly; so they will be forced to make authorship statements
-      | is _NoUpload uploadMode = pure Nothing
+    -- also take care that accepting the invite (optionally) remains possible even after the submission deadline (for creating submissions for course users as a lecturer)
-      | is _Nothing msmid = uploadForm'
+    
-      | otherwise = join <$> optionalActionNegatedA uploadForm' (fslI MsgSubmissionFilesUnchanged & setTooltip MsgSubmissionFilesUnchangedTip) (Just False)
+    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
+  ((res,formWidget'), formEnctype) <- runDB $ do
-    (Entity shid Sheet{..}, buddies, _, _, isLecturer, isOwner, _, _) <- runDB getSheetInfo
+    (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

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, ())
+    invitationForm (Entity _ Submission{..}) _ _ = wFormToAForm $ do
-    invitationInsertHook _ _ _ _ _ = id
+      -- 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

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
 

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
+          <div ##{theId} *{attrs}>
+            ^{maybe mempty authorshipStatementWidget mVal}
+        |]
+
+authorshipStatementWidget :: I18nStoredMarkup -> Widget
+authorshipStatementWidget stmt
+  = [whamlet|
+      $newline never
+      <dl .authorship-statement>
+        $forall (I18nLang l, t) <- Map.toList (review i18nLangMap stmt)
+          <dt>
+            _{MsgLanguageEndonym l}
+          <dd>
+            #{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'

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)
+         -> Maybe (Maybe (I18n a))
-         -> (Markup -> MForm handler (FormResult (I18n a), FieldView UniWorX))
+         -> (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 :: FormResult (Map I18nLang ((), a)) -> FormResult (Maybe (I18n a))
-    massageFormResult = \case
+    massageFormResult = fmap $ preview i18nLangMap . map (view _2)
-      FormSuccess xs
-        | Just xs' <- preview i18nLangMap $ map (view _2) xs
-          -> FormSuccess xs'
-        | otherwise
-          -> FormMissing
-      FormFailure errs -> FormFailure errs
-      FormMissing -> FormMissing
 
     miAdd :: I18nLang -> Natural -> I18nLangs
           -> (Text -> Text) -> FieldView UniWorX
@@ -2494,6 +2496,36 @@ i18nField :: forall a ident handler.
           -> ident
           -> FieldSettings UniWorX
           -> Bool
-          -> Maybe (I18n a)
+          -> Maybe (Maybe (I18n a))
-          -> (Markup -> MForm handler (FormResult (I18n a), FieldView UniWorX))
+          -> (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'

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

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

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

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

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))

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` --
 --------------------------

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.

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.

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
+  <br>
+
+  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.

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
+  <br>
+
+  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.

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.

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.

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.
+
+<br>
+  
+Ein Übungsblatt steht im Bezug zu einer Prüfung, falls eine der folgenden Bedingungen erfüllt ist:
+
+<ul>
+  <li>
+    Es wird unter „_{MsgSheetAuthorshipStatementExam}“ manuell eine Prüfung eingestellt
+  <li>
+    Das Übungsblatt wird „_{MsgSheetTypeExamPartPoints}“ gewertet
+  <li>
+    Die Anmeldung zur Prüfung wird vorausgesetzt um für das Übungsblatt abgeben zu dürfen („_{MsgSheetRequireExam}“)

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.
+
+<br>
+
+An exercise sheet is associated with an exam if one of the following is true:
+
+<ul>
+  <li>
+    An exam was manually configured under “_{MsgSheetAuthorshipStatementExam}”
+  <li>
+    The exercise sheet is valued “_{MsgSheetTypeExamPartPoints}”
+  <li>
+    Registration for an exam is required to submit for the exercise sheet (“_{MsgSheetRequireExam}”)

templates/submission.hamlet

@@ -46,6 +46,8 @@ $if is _Just mcid
           $nothing
             <li>#{time}
 
+    $# TODO(AuthorshipStatements): show statements confirmed (iff display is not anonymous (lecturer/submittor/non-anonymous corrector)?)
+
   $if maySubmit
     <section>
       <h2>_{MsgSubmissionReplace}

templates/widgets/authorship-statement-accept.hamlet

@@ -0,0 +1,11 @@
+$newline never
+<div *{attrs} .authorship-statement-accept__container>
+  <div .authorship-statement-accept__statement>
+    ^{authorshipStatementWidget authorshipStatementDefinitionContent}
+
+  <label for=#{checkboxId} .authorship-statement-accept__accept>
+    <div .authorship-statement-accept__accept-checkbox>
+      ^{checkboxWdgt}
+
+    <div .authorship-statement-accept__accept-label>
+      _{MsgAuthorshipStatementAccept}

test/Database/Fill.hs

@@ -18,6 +18,7 @@ import Data.Time.Calendar.WeekDate
 import Control.Applicative (ZipList(..))
 
 import Handler.Utils.DateTime
+import Handler.Utils.AuthorshipStatement (insertAuthorshipStatement)
 
 import Control.Monad.Random.Class (weighted)
 import System.Random.Shuffle (shuffleM)
@@ -411,7 +412,31 @@ fillDb = do
         , termLectureEnd
         }
       void . insert_ $ TermActive (TermKey term) (toMidnight $ addDays (-60) termStart) (Just . beforeMidnight $ addDays 60 termEnd) Nothing
-  ifiAuthorshipStatement <- insert $ AuthorshipStatementDefinition "<strong>Erklärung über die eigenständige Bearbeitung</strong><p>Hiermit erkläre ich, dass ich die vorliegende Abgabe vollständig selbstständig angefertigt habe, bzw. dass bei einer Gruppen-Abgabe nur die bei der Abgabe benannten Personen mitgewirkt haben. Quellen und Hilfsmittel über den Rahmen der Lehrveranstaltung hinaus sind als solche markiert und angegeben. Direkte Zitate sind als solche kenntlich gemacht. Ich bin mir darüber im Klaren, dass Verstöße durch Plagiate oder Zusammenarbeit mit Dritten zum Ausschluss von der Veranstaltung führen.</p><strong>Statement of Authorship</strong><p>TODO English version</p>"
+  ifiAuthorshipStatement <- insertAuthorshipStatement I18n
+    { i18nFallback = htmlToStoredMarkup
+        [shamlet|
+          $newline text
+          <strong>
+            Erklärung über die eigenständige Bearbeitung
+          <p>
+            Hiermit erkläre ich, dass ich die vorliegende Abgabe vollständig selbstständig angefertigt habe, bzw. dass bei einer Gruppen-Abgabe nur die bei der Abgabe benannten Personen mitgewirkt haben.
+            Quellen und Hilfsmittel über den Rahmen der Lehrveranstaltung hinaus sind als solche markiert und angegeben.
+            Direkte Zitate sind als solche kenntlich gemacht.
+            Ich bin mir darüber im Klaren, dass Verstöße durch Plagiate oder Zusammenarbeit mit Dritten zum Ausschluss von der Veranstaltung führen.
+        |]
+    , i18nFallbackLang = Just "de-de-formal"
+    , i18nTranslations = Map.singleton "en-eu" $ htmlToStoredMarkup
+        [shamlet|
+          $newline text
+          <strong>
+            Statement of Authorship
+          <p>
+            I hereby declare that the submission is my own unaided work or that in the case of a group submission only the group members configured in Uni2work were involved in the creation of the work.
+            All direct and indirect sources and aids are acknowledged as sources within the work.
+            Direct citations are made apparent as such.
+            I am aware that violations in the form plagiarism or collaboration with third parties will lead to expulsion from the course.
+        |]
+    }
   ifi <- insert' $ School "Institut für Informatik" "IfI" (Just $ 14 * nominalDay) (Just $ 10 * nominalDay) True (ExamModeDNF predDNFFalse) (ExamCloseOnFinished True) SchoolAuthorshipStatementModeOptional (Just ifiAuthorshipStatement) True SchoolAuthorshipStatementModeRequired (Just ifiAuthorshipStatement) False
   mi  <- insert' $ School "Institut für Mathematik" "MI" Nothing Nothing False (ExamModeDNF predDNFFalse) (ExamCloseOnFinished False) SchoolAuthorshipStatementModeNone Nothing True SchoolAuthorshipStatementModeOptional Nothing True
   void . insert' $ UserFunction gkleen ifi SchoolAdmin
@@ -657,6 +682,8 @@ fillDb = do
     , sheetAnonymousCorrection = True
     , sheetRequireExamRegistration = Nothing
     , sheetAllowNonPersonalisedSubmission = True
+    , sheetAuthorshipStatementMode = SheetAuthorshipStatementModeExam
+    , sheetAuthorshipStatementExam = Nothing
     , sheetAuthorshipStatement = Nothing
     }
   insert_ $ SheetEdit gkleen now adhoc
@@ -677,6 +704,8 @@ fillDb = do
     , sheetAnonymousCorrection = True
     , sheetRequireExamRegistration = Nothing
     , sheetAllowNonPersonalisedSubmission = True
+    , sheetAuthorshipStatementMode = SheetAuthorshipStatementModeExam
+    , sheetAuthorshipStatementExam = Nothing
     , sheetAuthorshipStatement = Nothing
     }
   insert_ $ SheetEdit gkleen now feste
@@ -697,6 +726,8 @@ fillDb = do
     , sheetAnonymousCorrection = True
     , sheetRequireExamRegistration = Nothing
     , sheetAllowNonPersonalisedSubmission = True
+    , sheetAuthorshipStatementMode = SheetAuthorshipStatementModeExam
+    , sheetAuthorshipStatementExam = Nothing
     , sheetAuthorshipStatement = Nothing
     }
   insert_ $ SheetEdit gkleen now keine
@@ -943,6 +974,8 @@ fillDb = do
       , sheetAnonymousCorrection = True
       , sheetRequireExamRegistration = Nothing
       , sheetAllowNonPersonalisedSubmission = True
+      , sheetAuthorshipStatementMode = SheetAuthorshipStatementModeExam
+      , sheetAuthorshipStatementExam = Nothing
       , sheetAuthorshipStatement = Nothing
       }
     void . insert $ SheetEdit jost now shId
@@ -1187,6 +1220,8 @@ fillDb = do
       , sheetAnonymousCorrection = True
       , sheetRequireExamRegistration = Nothing
       , sheetAllowNonPersonalisedSubmission = True
+      , sheetAuthorshipStatementMode = SheetAuthorshipStatementModeExam
+      , sheetAuthorshipStatementExam = Nothing
       , sheetAuthorshipStatement = Nothing
       }
     manyUsers' <- shuffleM $ take 1024 manyUsers

test/Model/TypesSpec.hs

@@ -343,6 +343,9 @@ instance Arbitrary UploadNonce where
 instance Arbitrary SchoolAuthorshipStatementMode where
   arbitrary = genericArbitrary
   
+instance Arbitrary SheetAuthorshipStatementMode where
+  arbitrary = genericArbitrary
+
 
 spec :: Spec
 spec = do
@@ -452,7 +455,9 @@ spec = do
     lawsCheckHspec (Proxy @UploadNonce)
       [ eqLaws, ordLaws, showLaws, showReadLaws, pathPieceLaws, jsonLaws, jsonKeyLaws, persistFieldLaws ]
     lawsCheckHspec (Proxy @SchoolAuthorshipStatementMode)
-      [ eqLaws, ordLaws, showLaws, showReadLaws, boundedEnumLaws, finiteLaws, pathPieceLaws, jsonLaws, jsonKeyLaws, persistFieldLaws, binaryLaws ]
+      [ eqLaws, ordLaws, showLaws, showReadLaws, boundedEnumLaws, finiteLaws, pathPieceLaws, jsonLaws, jsonKeyLaws, persistFieldLaws, binaryLaws, httpApiDataLaws ]
+    lawsCheckHspec (Proxy @SheetAuthorshipStatementMode)
+      [ eqLaws, ordLaws, showLaws, showReadLaws, boundedEnumLaws, finiteLaws, pathPieceLaws, jsonLaws, jsonKeyLaws, persistFieldLaws, binaryLaws, httpApiDataLaws ]
 
   describe "TermIdentifier" $ do
     it "has compatible encoding/decoding to/from Text" . property $

test/ModelSpec.hs

@@ -70,8 +70,9 @@ instance Arbitrary Sheet where
     <*> arbitrary
     <*> pure Nothing
     <*> arbitrary
+    <*> arbitrary
+    <*> pure Nothing
     <*> pure Nothing
-  shrink = genericShrink
 
 instance Arbitrary Tutorial where
   arbitrary = Tutorial