Merge branch 'master' into workflows

CHANGELOG.md

@@ -2,6 +2,13 @@
 
 All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines.
 
+## [21.1.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v21.0.3...v21.1.0) (2020-11-05)
+
+
+### Features
+
+* **sheets:** upload-empty-ok ([ab1940c](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/ab1940cb09e824fbba03264b5451fa8b17c5c804))
+
 ### [21.0.3](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v21.0.2...v21.0.3) (2020-11-05)
 
 

messages/uniworx/de-de-formal.msg

@@ -508,6 +508,7 @@ UnauthorizedSubmissionCorrector: Sie sind nicht der Korrektor für diese Abgabe.
 UnauthorizedUserSubmission: Nutzer dürfen für dieses Übungsblatt keine Abgaben erstellen.
 UnauthorizedCorrectorSubmission: Korrektoren dürfen für dieses Übungsblatt keine Abgaben erstellen.
 OnlyUploadOneFile: Bitte nur eine Datei hochladen.
+UploadAtLeastOneNonemptyFile: Bitte mindestens eine nichtleere Datei hochladen.
 DeprecatedRoute: Diese Ansicht ist obsolet und könnte in Zukunft entfallen.
 UnfreeMaterials: Die Materialien für diese Veranstaltung sind nicht allgemein freigegeben.
 MaterialFree: Kursmaterialien ohne Anmeldung zugänglich
@@ -893,6 +894,8 @@ UploadModeExtensionRestriction: Zulässige Dateiendungen
 UploadModeExtensionRestrictionTip: Komma-separiert. Wenn keine Dateiendungen angegeben werden erfolgt keine Einschränkung. Bei Upload mehrerer Dateien erfolgt die Einschränkung von Dateiendungen für alle hochegladenen Dateien, auch innerhalb von ZIP-Archiven.
 UploadModeExtensionRestrictionEmpty: Liste von zulässigen Dateiendungen darf nicht leer sein
 UploadModeExtensionRestrictionMultipleTip: Einschränkung von Dateiendungen erfolgt für alle hochgeladenen Dateien, auch innerhalb von ZIP-Archiven.
+UploadAnyEmptyOk: Leere Uploads erlauben?
+UploadAnyEmptyOkTip: Sollen, statt einen Fehler auszugeben, Uploads, die nur aus leeren Dateien und/oder Verzeichnissen bestehen, erlaubt werden?
 
 GenericFileFieldFileTooLarge file@FilePath: „#{file}“ ist zu groß
 GenericFileFieldInvalidExtension file@FilePath: „#{file}” hat keine zulässige Dateiendung
@@ -909,6 +912,7 @@ UploadSpecificFileName: Dateiname
 UploadSpecificFileRequired: Zur Abgabe erforderlich
 UploadSpecificFileMaxSize: Maximale Dateigröße (Bytes)
 UploadSpecificFileMaxSizeNegative: Maximale Dateigröße darf nicht negativ sein
+UploadSpecificFileEmptyOk: Leere Uploads erlauben
 
 NoSubmissions: Keine Abgabe
 CorrectorSubmissions: Abgabe extern mit Pseudonym

messages/uniworx/en-eu.msg

@@ -505,6 +505,7 @@ UnauthorizedSubmissionCorrector: You are no corrector for this submission.
 UnauthorizedUserSubmission: Users may not directly submit for this exercise sheet.
 UnauthorizedCorrectorSubmission: Correctors may not create submissions for this exercise sheet.
 OnlyUploadOneFile: Please only upload one file
+UploadAtLeastOneNonemptyFile: Please upload at least one nonempty file.
 DeprecatedRoute: This view is deprecated and will be removed.
 UnfreeMaterials: Course material are not publicly accessable.
 MaterialFree: Course material is publicly available.
@@ -879,6 +880,8 @@ UploadModeExtensionRestriction: Allowed file extensions
 UploadModeExtensionRestrictionTip: Comma-separated. If no file extensions are specified, uploads are not restricted.
 UploadModeExtensionRestrictionEmpty: List of permitted file extensions may not be empty
 UploadModeExtensionRestrictionMultipleTip: Checks for valid file extension are performed for all uploaded files, including those packed within zip-archives.
+UploadAnyEmptyOk: Allow empty uploads?
+UploadAnyEmptyOkTip: Should, instead of emitting an error, uploads be allowed, that consist solely of empty files and/or directories?
 
 GenericFileFieldFileTooLarge file: “#{file}” is too large
 GenericFileFieldInvalidExtension file: “#{file}” does not have an acceptable file extension
@@ -895,6 +898,7 @@ UploadSpecificFileName: Filename
 UploadSpecificFileRequired: Required for submission
 UploadSpecificFileMaxSize: Maximum filesize (bytes)
 UploadSpecificFileMaxSizeNegative: Maximum filesize may not be negative
+UploadSpecificFileEmptyOk: Allow empty uploads
 
 NoSubmissions: No submission
 CorrectorSubmissions: External submission via pseudonym

package-lock.json

@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "21.0.3",
+  "version": "21.1.0",
   "lockfileVersion": 1,
   "requires": true,
   "dependencies": {

package.json

@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "21.0.3",
+  "version": "21.1.0",
   "description": "",
   "keywords": [],
   "author": "",

package.yaml

@@ -1,5 +1,5 @@
 name:    uniworx
-version: 21.0.3
+version: 21.1.0
 
 dependencies:
   - base

src/Handler/Sheet/Form.hs

@@ -91,7 +91,7 @@ makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateS
       <*> aopt utcTimeField   (fslpI MsgSheetSolutionFrom (mr MsgSheetSolutionFromPlaceholder)
             & setTooltip MsgSheetSolutionFromTip)             (sfSolutionFrom <$> template)
       <* aformSection MsgSheetFormType
-      <*> submissionModeForm ((sfSubmissionMode <$> template) <|> pure (SubmissionMode False . Just $ UploadAny True defaultExtensionRestriction))
+      <*> submissionModeForm ((sfSubmissionMode <$> template) <|> pure (SubmissionMode False . Just $ UploadAny True defaultExtensionRestriction False))
       <*> sheetGroupAFormReq  (fslI MsgSheetGroup)        ((sfGrouping <$> template) <|> pure NoGroups)
       <*> sheetTypeAFormReq   (fslI MsgSheetType)         (sfType        <$> template)
       <*> apopt checkBoxField (fslI MsgAutoAssignCorrs) (sfAutoDistribute <$> template)
@@ -135,7 +135,7 @@ makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateS
           |]
       return $ SheetPersonalisedFilesForm
         <$  maybe (pure ()) aformMessage templateDownloadMessage
-        <*> aopt (zipFileField True Nothing) (fslI MsgSheetPersonalisedFilesUpload & setTooltip MsgSheetPersonalisedFilesUploadTip) Nothing
+        <*> aopt (zipFileField True Nothing True) (fslI MsgSheetPersonalisedFilesUpload & setTooltip MsgSheetPersonalisedFilesUploadTip) Nothing
         <*> apopt checkBoxField (fslI MsgSheetPersonalisedFilesKeepExisting & setTooltip MsgSheetPersonalisedFilesKeepExistingTip) (fmap spffFilesKeepExisting template' <|> Just True)
         <*> apopt checkBoxField (fslI MsgSheetPersonalisedFilesAllowNonPersonalisedSubmission & setTooltip MsgSheetPersonalisedFilesAllowNonPersonalisedSubmissionTip) (fmap spffAllowNonPersonalisedSubmission template' <|> Just True)
 

src/Handler/Submission/Correction.hs

@@ -98,7 +98,7 @@ postCorrectionR tid ssh csh shn cid = do
             }
 
       ((uploadResult, uploadForm'), uploadEncoding) <- runFormPost . identifyForm FIDcorrectionUpload . renderAForm FormStandard $
-            apopt (zipFileField True Nothing) (fslI MsgRatingFiles & setTooltip MsgRatingFilesTip) Nothing
+            apopt (zipFileField True Nothing True) (fslI MsgRatingFiles & setTooltip MsgRatingFilesTip) Nothing
       let uploadForm = wrapForm uploadForm' def
             { formAction = Just . SomeRoute $ CSubmissionR tid ssh csh shn cid CorrectionR
             , formEncoding = uploadEncoding

src/Handler/Submission/Helper.hs

@@ -312,7 +312,7 @@ submissionHelper tid ssh csh shn mcid = do
   -- Therefore we do not restrict upload behaviour in any way in that case
   ((res,formWidget'), formEnctype) <- do
     (Entity _ Sheet{..}, buddies, _, _, isLecturer, isOwner, _, _) <- runDB getSheetInfo
-    runFormPost . makeSubmissionForm sheetCourse msmid (fromMaybe (UploadAny True Nothing) . submissionModeUser $ sheetSubmissionMode) sheetGrouping isLecturer $ bool id (maybe id (Set.insert . Right) muid) isOwner buddies
+    runFormPost . makeSubmissionForm sheetCourse msmid (fromMaybe (UploadAny True Nothing True) . submissionModeUser $ sheetSubmissionMode) sheetGrouping isLecturer $ bool id (maybe id (Set.insert . Right) muid) isOwner buddies
   let formWidget = wrapForm' BtnHandIn formWidget' def
         { formAction = Just $ SomeRoute actionUrl
         , formEncoding = formEnctype
@@ -391,84 +391,82 @@ submissionHelper tid ssh csh shn mcid = do
         | otherwise -> return $ FormSuccess res'
 
 
-    case res' of
+    formResultMaybe res' $ \(mFiles, adhocMembers) -> do
-      (FormSuccess (mFiles, adhocMembers)) -> do
+      smid <- case (mFiles, msmid) of
-        smid <- do
+        (Nothing, Just smid)   -- no new files, existing submission partners updated
-          smid <- case (mFiles, msmid) of
+          -> return smid
-            (Nothing, Just smid)   -- no new files, existing submission partners updated
+        (Just files, _) -> -- new files
-              -> return smid
+          runConduit $ transPipe (lift . lift) files .| extractRatingsMsg .| sinkSubmission muid (maybe (Left shid) Right msmid) False
-            (Just files, _) -> -- new files
+        (Nothing, Nothing) -- new submission, no file upload requested
-              runConduit $ transPipe (lift . lift) files .| extractRatingsMsg .| sinkSubmission muid (maybe (Left shid) Right msmid) False
+          -> do
-            (Nothing, Nothing) -- new submission, no file upload requested
+            sid <- insert Submission
-              -> do
+              { submissionSheet = shid
-                sid <- insert Submission
+              , submissionRatingPoints   = Nothing
-                  { submissionSheet = shid
+              , submissionRatingComment  = Nothing
-                  , submissionRatingPoints   = Nothing
+              , submissionRatingBy       = Nothing
-                  , submissionRatingComment  = Nothing
+              , submissionRatingAssigned = Nothing
-                  , submissionRatingBy       = Nothing
+              , submissionRatingTime     = Nothing
-                  , submissionRatingAssigned = Nothing
+              }
-                  , submissionRatingTime     = Nothing
+            audit $ TransactionSubmissionEdit sid shid
-                  }
-                audit $ TransactionSubmissionEdit sid shid
-                return sid
 
-          -- Determine new submission users
+            now <- liftIO getCurrentTime
-          subUsers <- if
+            insert_ $ SubmissionEdit muid now sid
-            | isLecturer -> return adhocMembers
-            | RegisteredGroups <- sheetGrouping -> do
-                -- Determine members of pre-registered group
-                groupUids <- fmap (setFromList . map (Right . E.unValue)) . E.select . E.from $ \(submissionGroupUser `E.InnerJoin` submissionGroup `E.InnerJoin` submissionGroupUser') -> do
-                  E.on $ submissionGroup E.^. SubmissionGroupId  E.==. submissionGroupUser' E.^. SubmissionGroupUserSubmissionGroup
-                  E.on $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
-                  E.where_ $ E.just (submissionGroupUser E.^. SubmissionGroupUserUser) E.==. E.val muid
-                      E.&&.  submissionGroup     E.^. SubmissionGroupCourse   E.==. E.val sheetCourse
 
-                  E.where_ . E.not_ . E.exists . E.from $ \(submissionUser `E.InnerJoin` submission) -> do
+            return sid
-                    E.on $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
-                    E.where_ $ submission E.^. SubmissionSheet E.==. E.val shid
-                         E.&&. submissionUser E.^. SubmissionUserUser E.==. submissionGroupUser' E.^. SubmissionGroupUserUser
-                    E.where_ $ submission E.^. SubmissionId E.!=. E.val smid
 
-                  return $ submissionGroupUser' E.^. SubmissionGroupUserUser
+      -- Determine new submission users
-                -- SubmissionUser for all group members (pre-registered & ad-hoc)
+      subUsers <- if
-                return $ maybe id (Set.insert . Right) muid groupUids
+        | isLecturer -> return adhocMembers
-            | otherwise -> return adhocMembers
+        | RegisteredGroups <- sheetGrouping -> do
+            -- Determine members of pre-registered group
+            groupUids <- fmap (setFromList . map (Right . E.unValue)) . E.select . E.from $ \(submissionGroupUser `E.InnerJoin` submissionGroup `E.InnerJoin` submissionGroupUser') -> do
+              E.on $ submissionGroup E.^. SubmissionGroupId  E.==. submissionGroupUser' E.^. SubmissionGroupUserSubmissionGroup
+              E.on $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
+              E.where_ $ E.just (submissionGroupUser E.^. SubmissionGroupUserUser) E.==. E.val muid
+                  E.&&.  submissionGroup     E.^. SubmissionGroupCourse   E.==. E.val sheetCourse
 
-          -- Since invitations carry no data we only need to consider changes to
+              E.where_ . E.not_ . E.exists . E.from $ \(submissionUser `E.InnerJoin` submission) -> do
-          -- the set of users/invited emails
+                E.on $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
-          -- Otherwise we would have to update old invitations (via
+                E.where_ $ submission E.^. SubmissionSheet E.==. E.val shid
-          -- `sinkInvitationsF`) because their associated @DBData@ might have
+                     E.&&. submissionUser E.^. SubmissionUserUser E.==. submissionGroupUser' E.^. SubmissionGroupUserUser
-          -- changed
+                E.where_ $ submission E.^. SubmissionId E.!=. E.val smid
 
-          forM_ (subUsers `setSymmDiff` subUsersOld) $ \change -> if
+              return $ submissionGroupUser' E.^. SubmissionGroupUserUser
-            -- change is a new user being added to the submission users => send invitation / insert
+            -- SubmissionUser for all group members (pre-registered & ad-hoc)
-            | change `Set.member` subUsers -> case change of
+            return $ maybe id (Set.insert . Right) muid groupUids
-              Left subEmail -> do
+        | otherwise -> return adhocMembers
-                -- user does not exist yet => send invitation
-                sinkInvitationsF submissionUserInvitationConfig [(subEmail, smid, (InvDBDataSubmissionUser, InvTokenDataSubmissionUser))]
-                return ()
-              Right subUid -> do
-                -- user exists and has an id => insert as SubmissionUser and audit
-                insert_ $ SubmissionUser subUid smid
-                audit $ TransactionSubmissionUserEdit smid subUid
-                unless (Just subUid == muid) $
-                  queueDBJob . JobQueueNotification $ NotificationSubmissionUserCreated subUid smid
-            -- change is an old user that is not a submission user anymore => delete invitation / delete
-            | otherwise -> case change of
-              Left subEmail -> deleteInvitation @SubmissionUser smid subEmail
-              Right subUid  -> do
-                deleteBy $ UniqueSubmissionUser subUid smid
-                audit $ TransactionSubmissionUserDelete smid subUid
-                unless (Just subUid == muid) $
-                  queueDBJob . JobQueueNotification $ NotificationSubmissionUserDeleted subUid shid smid
 
-          addMessageI Success $ if | Nothing <- msmid -> MsgSubmissionCreated
+      -- Since invitations carry no data we only need to consider changes to
-                                   | otherwise        -> MsgSubmissionUpdated
+      -- the set of users/invited emails
-          return smid
+      -- Otherwise we would have to update old invitations (via
-        cID <- encrypt smid
+      -- `sinkInvitationsF`) because their associated @DBData@ might have
-        return $ Just cID
+      -- changed
-      (FormFailure msgs) -> Nothing <$ forM_ msgs (addMessage Warning . toHtml)
+
-      _other -> return Nothing
+      forM_ (subUsers `setSymmDiff` subUsersOld) $ \change -> if
+        -- change is a new user being added to the submission users => send invitation / insert
+        | change `Set.member` subUsers -> case change of
+          Left subEmail -> do
+            -- user does not exist yet => send invitation
+            sinkInvitationsF submissionUserInvitationConfig [(subEmail, smid, (InvDBDataSubmissionUser, InvTokenDataSubmissionUser))]
+            return ()
+          Right subUid -> do
+            -- user exists and has an id => insert as SubmissionUser and audit
+            insert_ $ SubmissionUser subUid smid
+            audit $ TransactionSubmissionUserEdit smid subUid
+            unless (Just subUid == muid) $
+              queueDBJob . JobQueueNotification $ NotificationSubmissionUserCreated subUid smid
+        -- change is an old user that is not a submission user anymore => delete invitation / delete
+        | otherwise -> case change of
+          Left subEmail -> deleteInvitation @SubmissionUser smid subEmail
+          Right subUid  -> do
+            deleteBy $ UniqueSubmissionUser subUid smid
+            audit $ TransactionSubmissionUserDelete smid subUid
+            unless (Just subUid == muid) $
+              queueDBJob . JobQueueNotification $ NotificationSubmissionUserDeleted subUid shid smid
+
+      addMessageI Success $ if | Nothing <- msmid -> MsgSubmissionCreated
+                               | otherwise        -> MsgSubmissionUpdated
+      Just <$> encrypt smid
 
   case mCID of
     Just cID -> do

src/Handler/Submission/Upload.hs

@@ -36,7 +36,7 @@ getCorrectionsUploadR, postCorrectionsUploadR :: Handler Html
 getCorrectionsUploadR = postCorrectionsUploadR
 postCorrectionsUploadR = do
   ((uploadRes, upload), uploadEncoding) <- runFormPost . identifyForm FIDcorrectionsUpload . renderAForm FormStandard $ (,)
-    <$> areq (zipFileField True Nothing) (fslI MsgCorrUploadField) Nothing
+    <$> areq (zipFileField True Nothing True) (fslI MsgCorrUploadField) Nothing
     <*> apopt (explainedSelectionField Nothing $ explainOptionList optionsFinite explainSubmissionDoneMode) (fslI MsgCorrUploadSubmissionDoneMode & setTooltip MsgCorrUploadSubmissionDoneModeTip) (Just SubmissionDoneByFile)
 
   formResult uploadRes $ \(files, doneMode) -> do

src/Handler/Utils/Form.hs

@@ -593,8 +593,9 @@ uploadModeForm fs prev = multiActionA actions fs (classifyUploadMode <$> prev)
       [ ( UploadModeNone, pure NoUpload)
       , ( UploadModeAny
         , UploadAny
-          <$> (fromMaybe False <$> aopt checkBoxField (fslI MsgUploadModeUnpackZips & setTooltip MsgUploadModeUnpackZipsTip) (Just $ prev ^? _Just . _unpackZips))
+          <$> (fromMaybe False <$> aopt checkBoxField (fslI MsgUploadModeUnpackZips & setTooltip MsgUploadModeUnpackZipsTip) (Just $ prev ^? _Just . _uploadUnpackZips))
-          <*> aopt extensionRestrictionField (fslI MsgUploadModeExtensionRestriction & setTooltip MsgUploadModeExtensionRestrictionTip) ((prev ^? _Just . _extensionRestriction) <|> fmap Just defaultExtensionRestriction)
+          <*> aopt extensionRestrictionField (fslI MsgUploadModeExtensionRestriction & setTooltip MsgUploadModeExtensionRestrictionTip) ((prev ^? _Just . _uploadExtensionRestriction) <|> fmap Just defaultExtensionRestriction)
+          <*> apopt checkBoxField (fslI MsgUploadAnyEmptyOk & setTooltip MsgUploadAnyEmptyOkTip) (preview (_Just . _uploadEmptyOk) prev <|> Just False)
         )
       , ( UploadModeSpecific
         , UploadSpecific <$> specificFileForm
@@ -617,7 +618,7 @@ uploadModeForm fs prev = multiActionA actions fs (classifyUploadMode <$> prev)
             currentRoute <- currentRoute'
             return . SomeRoute $ currentRoute :#: frag
       miIdent <- ("specific-files--" <>) <$> newIdent
-      postProcess =<< massInputW MassInput{..} (fslI MsgUploadSpecificFiles) True (preProcess <$> prev ^? _Just . _specificFiles)
+      postProcess =<< massInputW MassInput{..} (fslI MsgUploadSpecificFiles) True (preProcess <$> prev ^? _Just . _uploadSpecificFiles)
       where
         preProcess :: NonNull (Set UploadSpecificFile) -> Map ListPosition (UploadSpecificFile, UploadSpecificFile)
         preProcess = Map.fromList . zip [0..] . map (\x -> (x, x)) . Set.toList . toNullable
@@ -644,10 +645,11 @@ uploadModeForm fs prev = multiActionA actions fs (classifyUploadMode <$> prev)
         sFileForm nudge mPrevUF csrf = do
           (labelRes, labelView) <- mpreq textField (fslI MsgUploadSpecificFileLabel & addName (nudge "label")) $ specificFileLabel <$> mPrevUF
           (nameRes, nameView) <- mpreq textField (fslI MsgUploadSpecificFileName & addName (nudge "name")) $ specificFileName <$> mPrevUF
+          (emptyOkRes, emptyOkView) <- mpopt checkBoxField (fslI MsgUploadSpecificFileEmptyOk & addName (nudge "empty-ok")) $ fmap specificFileEmptyOk mPrevUF <|> Just False
           (maxSizeRes, maxSizeView) <- mopt (natFieldI MsgUploadSpecificFileMaxSizeNegative) (fslI MsgUploadSpecificFileMaxSize & addName (nudge "max-size")) $ specificFileMaxSize <$> mPrevUF
           (reqRes, reqView) <- mpreq checkBoxField (fslI MsgUploadSpecificFileRequired & addName (nudge "required")) $ specificFileRequired <$> mPrevUF
 
-          return ( UploadSpecificFile <$> labelRes <*> nameRes <*> reqRes <*> maxSizeRes
+          return ( UploadSpecificFile <$> labelRes <*> nameRes <*> reqRes <*> emptyOkRes <*> maxSizeRes
                  , $(widgetFile "widgets/massinput/uploadSpecificFiles/form")
                  )
 
@@ -977,10 +979,26 @@ genericFileField mkOpts = Field{..}
                                  )
                      .| C.map (\(fileReferenceTitle, (fileReferenceContent, fileReferenceModified, _)) -> FileReference{..})
                    mapM_ handleFile (bool (take 1) id fieldMultiple files) .| transPipe runDB (handleUpload opts mIdent)
-             (fSrc', length -> nFiles) <- liftHandler $ runPeekN 2 fSrc
+             (fSrc'', allEmpty) <- if
+               | fieldAllEmptyOk -> return (fSrc, False)
+               | otherwise
+                 -> let checkEmpty = do
+                          (peeked, failed) <- go []
+                          mapM_ leftover $ peeked ++ hoistMaybe failed
+                          return $ is _Nothing failed
+                        go acc = do
+                          next <- await
+                          case next of
+                            Nothing -> return (reverse acc, Nothing)
+                            Just x
+                              | isEmptyFileReference x -> go $ x : acc
+                              | otherwise              -> return (reverse acc, Just x)
+                     in liftHandler . over (mapped . _1) unsealConduitT $ fSrc $$+ checkEmpty
+             (fSrc', length -> nFiles) <- liftHandler $ runPeekN 2 fSrc''
              $logDebugS "genericFileField.fieldParse" $ tshow nFiles
              if
                | nFiles <= 0 -> return   Nothing
+               | allEmpty    -> throwE $ SomeMessage MsgUploadAtLeastOneNonemptyFile
                | nFiles <= 1 -> return $ Just fSrc'
                | not fieldMultiple -> do
                    liftHandler . runDB . runConduit $
@@ -1050,6 +1068,7 @@ fileFieldMultiple = genericFileField $ return FileField
   , fieldRestrictExtensions = Nothing
   , fieldAdditionalFiles = _FileReferenceFileReferenceTitleMap # Map.empty
   , fieldMaxFileSize = Nothing
+  , fieldAllEmptyOk = True
   }
 
 
@@ -1069,6 +1088,7 @@ singleFileField prev = genericFileField $ do
       | FileReference{..} <- Set.toList permitted
       ]
     , fieldMaxFileSize = Nothing
+    , fieldAllEmptyOk = True
     }
 
 specificFileField :: UploadSpecificFile -> Field Handler FileUploads
@@ -1079,20 +1099,23 @@ specificFileField UploadSpecificFile{..} = convertField (.| fixupFileTitles) id
   , fieldRestrictExtensions = fromNullable . maybe Set.empty (Set.singleton . view _2) . Map.lookupMin . Map.fromList . map (length &&& id) $ fileNameExtensions specificFileName
   , fieldAdditionalFiles = _FileReferenceFileReferenceTitleMap # Map.empty
   , fieldMaxFileSize = specificFileMaxSize
+  , fieldAllEmptyOk = specificFileEmptyOk
   }
   where
     fixupFileTitles = C.map $ set _fileReferenceTitle (unpack specificFileName)
 
 zipFileField :: Bool -- ^ Unpack zips?
              -> Maybe (NonNull (Set Extension)) -- ^ Restrictions on file extensions
+             -> Bool -- ^ Empty files ok?
              -> Field Handler FileUploads
-zipFileField doUnpack permittedExtensions = genericFileField $ return FileField
+zipFileField doUnpack permittedExtensions emptyOk = genericFileField $ return FileField
   { fieldIdent = Nothing
   , fieldUnpackZips = FileFieldUserOption True doUnpack
   , fieldMultiple = doUnpack
   , fieldRestrictExtensions = permittedExtensions
   , fieldAdditionalFiles = _FileReferenceFileReferenceTitleMap # Map.empty
   , fieldMaxFileSize = Nothing
+  , fieldAllEmptyOk = emptyOk
   }
 
 fileUploadForm :: Bool -- ^ Required?
@@ -1102,13 +1125,13 @@ fileUploadForm isReq mkFs = \case
   NoUpload
     -> pure Nothing
   UploadAny{..}
-    -> bool aopt (\f fs _ -> Just <$> areq f fs Nothing) isReq (zipFileField unpackZips extensionRestriction) (mkFs unpackZips) Nothing
+    -> bool aopt (\f fs _ -> Just <$> areq f fs Nothing) isReq (zipFileField uploadUnpackZips uploadExtensionRestriction uploadEmptyOk) (mkFs uploadUnpackZips) Nothing
   UploadSpecific{..}
-    -> mergeFileSources <$> traverse specificFileForm (Set.toList $ toNullable specificFiles)
+    -> mergeFileSources <$> traverse specificFileForm (Set.toList $ toNullable uploadSpecificFiles)
   where
     specificFileForm :: UploadSpecificFile -> AForm Handler (Maybe FileUploads)
     specificFileForm spec@UploadSpecificFile{..}
-      = bool (\f fs d -> aopt f fs $ fmap Just d) (\f fs d -> Just <$> areq f fs d) specificFileRequired (specificFileField spec) (fsl specificFileLabel) Nothing
+      = bool (\f fs d -> aopt f fs $ fmap Just d) (\f fs d -> Just <$> areq f fs d) (specificFileRequired && isReq) (specificFileField spec) (fsl specificFileLabel) Nothing
 
     mergeFileSources :: [Maybe FileUploads] -> Maybe FileUploads
     mergeFileSources (catMaybes -> sources) = case sources of
@@ -1132,6 +1155,7 @@ multiFileField mkPermitted = genericFileField $ mkField <$> mkPermitted
             | FileReference{..} <- Set.toList permitted
             ]
           , fieldMaxFileSize = Nothing
+          , fieldAllEmptyOk = True
           }
 
 data SheetGrading' = Points' | PassPoints' | PassBinary' | PassAlways'

src/Handler/Utils/Submission.hs

@@ -17,6 +17,7 @@ import Jobs.Queue
 import Yesod.Core.Types (HandlerContents(..))
 
 import Control.Monad.State.Class as State
+import Control.Monad.Trans.State (execStateT)
 import Control.Monad.RWS.Lazy (MonadRWS, RWST, execRWST)
 import qualified Control.Monad.Random as Rand
 
@@ -544,8 +545,6 @@ sinkSubmission userId mExists isUpdate = do
 
       sId <- insert Submission{..}
       audit $ TransactionSubmissionEdit sId sheetId
-      -- now <- liftIO getCurrentTime
-      -- insert $ SubmissionEdit userId now sId -- This is done automatically during 'sinkSubmission'' iff the given submission is nonempty
       return sId
     Right sId -> return sId
 
@@ -561,7 +560,7 @@ sinkSubmission userId mExists isUpdate = do
     guardFileTitles SubmissionMode{..}
       | Just UploadAny{..} <- submissionModeUser
       , not isUpdate
-      , Just (map unpack . Set.toList . toNullable -> exts) <- extensionRestriction
+      , Just (map unpack . Set.toList . toNullable -> exts) <- uploadExtensionRestriction
       = Conduit.mapM $ \x -> if
           | Left FileReference{..} <- x
           , none ((flip isExtensionOf `on` CI.foldCase) fileReferenceTitle) exts
@@ -717,7 +716,11 @@ sinkSubmission userId mExists isUpdate = do
             -> submissionSheet <$> getJust submissionId  -- there must have been a submission, otherwise mExists would have been Left shid
 
         finalize :: SubmissionSinkState -> YesodJobDB UniWorX ()
-        finalize SubmissionSinkState{..} = do
+        finalize sState = do
+          SubmissionSinkState{..} <- flip execStateT sState $
+            when (is _Left mExists)
+              touchSubmission
+          
           missingFiles <- E.select . E.from $ \sf -> E.distinctOnOrderBy [E.asc $ sf E.^. SubmissionFileTitle] $ do
             E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionId
             unless isUpdate $

src/Handler/Utils/Workflow/Form.hs

@@ -76,6 +76,7 @@ instance FromJSON (FileField FileIdent) where
     fieldMultiple <- o JSON..: "multiple"
     fieldRestrictExtensions <- o JSON..:? "restrict-extensions"
     fieldMaxFileSize <- o JSON..:? "max-file-size"
+    fieldAllEmptyOk <- o JSON..:? "all-empty-ok" JSON..!= True
     addFiles' <- o JSON..:? "additional-files" JSON..!= mempty
     fieldAdditionalFiles <- fmap FileIdentFileReferenceTitleMap . for addFiles' $ JSON.withObject "FileIdentFileReferenceTitleMapElem" $ \o' -> do
       fIdentTitleMapIdent <- o' JSON..: "Ident"

src/Model/Migration.hs

@@ -372,8 +372,8 @@ customMigrations = Map.fromListWith (>>)
                 ( Legacy.NoSubmissions       , _                   ) -> SubmissionMode False Nothing
                 ( Legacy.CorrectorSubmissions, _                   ) -> SubmissionMode True Nothing
                 ( Legacy.UserSubmissions     , Legacy.NoUpload     ) -> SubmissionMode False (Just NoUpload)
-                ( Legacy.UserSubmissions     , Legacy.Upload True  ) -> SubmissionMode False (Just $ UploadAny True defaultExtensionRestriction)
+                ( Legacy.UserSubmissions     , Legacy.Upload True  ) -> SubmissionMode False (Just $ UploadAny True defaultExtensionRestriction True)
-                ( Legacy.UserSubmissions     , Legacy.Upload False ) -> SubmissionMode False (Just $ UploadAny False defaultExtensionRestriction)
+                ( Legacy.UserSubmissions     , Legacy.Upload False ) -> SubmissionMode False (Just $ UploadAny False defaultExtensionRestriction True)
           [executeQQ| UPDATE "sheet" SET "submission_mode" = #{submissionMode'} WHERE "id" = #{shid}; |]
     )
   , ( AppliedMigrationKey [migrationVersion|11.0.0|] [version|12.0.0|]

src/Model/Types/File.hs

@@ -259,6 +259,7 @@ data FileField fileid = FileField
   , fieldRestrictExtensions :: Maybe (NonNull (Set Extension))
   , fieldMaxFileSize :: Maybe Natural
   , fieldAdditionalFiles :: FileReferenceTitleMap fileid (FileFieldUserOption Bool)
+  , fieldAllEmptyOk :: Bool
   } deriving (Generic, Typeable)
 deriving instance Eq (FileReferenceTitleMap fileid (FileFieldUserOption Bool)) => Eq (FileField fileid)
 deriving instance Ord (FileReferenceTitleMap fileid (FileFieldUserOption Bool)) => Ord (FileField fileid)
@@ -273,6 +274,7 @@ instance ToJSON (FileField FileReference) where
     , pure $ "restrict-extensions" JSON..= fieldRestrictExtensions
     , pure $ "max-file-size" JSON..= fieldMaxFileSize
     , pure $ "additional-files" JSON..= addFiles'
+    , pure $ "all-empty-ok" JSON..= fieldAllEmptyOk
     ]
     where addFiles' = unFileReferenceFileReferenceTitleMap fieldAdditionalFiles <&> \FileReferenceFileReferenceTitleMapElem{..} -> JSON.object
             [ "content" JSON..= fRefTitleMapContent
@@ -286,6 +288,7 @@ instance FromJSON (FileField FileReference) where
     fieldMultiple <- o JSON..: "multiple"
     fieldRestrictExtensions <- o JSON..:? "restrict-extensions"
     fieldMaxFileSize <- o JSON..:? "max-file-size"
+    fieldAllEmptyOk <- o JSON..:? "all-empty-ok" JSON..!= True
     addFiles' <- o JSON..:? "additional-files" JSON..!= mempty
     fieldAdditionalFiles <- fmap FileReferenceFileReferenceTitleMap . for addFiles' $ JSON.withObject "FileReferenceFileReferenceTitleMapElem" $ \o' -> do
       fRefTitleMapContent <- o' JSON..: "content"

src/Model/Types/Sheet.hs

@@ -22,6 +22,9 @@ import Data.Maybe (fromJust)
 
 import qualified Data.Csv as Csv
 
+import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.Types as Aeson
+
 
 data SheetGrading
   = Points     { maxPoints :: Points }
@@ -186,36 +189,68 @@ data UploadSpecificFile = UploadSpecificFile
   { specificFileLabel :: Text
   , specificFileName :: FileName
   , specificFileRequired :: Bool
+  , specificFileEmptyOk :: Bool
   , specificFileMaxSize :: Maybe Natural
   } deriving (Show, Read, Eq, Ord, Generic)
 
-deriveJSON defaultOptions
+instance ToJSON UploadSpecificFile where
-  { fieldLabelModifier = camelToPathPiece' 2
+  toJSON UploadSpecificFile{..} = Aeson.object
-  , omitNothingFields = True
+    [ "label"    Aeson..= specificFileLabel
-  } ''UploadSpecificFile
+    , "name"     Aeson..= specificFileName
+    , "required" Aeson..= specificFileRequired
+    , "empty-ok" Aeson..= specificFileEmptyOk
+    , "max-size" Aeson..= specificFileMaxSize
+    ]
+instance FromJSON UploadSpecificFile where
+  parseJSON = Aeson.withObject "UploadSpecificFile" $ \o -> do
+    specificFileLabel <- o Aeson..: "label"
+    specificFileName <- o Aeson..: "name"
+    specificFileRequired <- o Aeson..:? "required" Aeson..!= False
+    specificFileEmptyOk <- o Aeson..:? "empty-ok" Aeson..!= True
+    specificFileMaxSize <- o Aeson..:? "max-size"
+    return UploadSpecificFile{..}
 derivePersistFieldJSON ''UploadSpecificFile
 
 data UploadMode = NoUpload
                 | UploadAny
-                  { unpackZips :: Bool
+                  { uploadUnpackZips :: Bool
-                  , extensionRestriction :: Maybe (NonNull (Set Extension))
+                  , uploadExtensionRestriction :: Maybe (NonNull (Set Extension))
+                  , uploadEmptyOk :: Bool
                   }
                 | UploadSpecific
-                  { specificFiles :: NonNull (Set UploadSpecificFile)
+                  { uploadSpecificFiles :: NonNull (Set UploadSpecificFile)
                   }
   deriving (Show, Read, Eq, Ord, Generic)
 
 defaultExtensionRestriction :: Maybe (NonNull (Set Extension))
 defaultExtensionRestriction = fromNullable $ Set.fromList ["txt", "pdf"]
 
-deriveJSON defaultOptions
+instance ToJSON UploadMode where
-  { constructorTagModifier = \c -> if
+  toJSON NoUpload = Aeson.object [ "mode" Aeson..= ("no-upload" :: String) ]
-      | c == "UploadAny" -> "upload"
+  toJSON UploadAny{..} = Aeson.object $ catMaybes
-      | otherwise        -> camelToPathPiece c
+    [ pure $ "mode" Aeson..= ("upload" :: String)
-  , fieldLabelModifier = camelToPathPiece
+    , pure $ "unpack-zips" Aeson..= uploadUnpackZips
-  , sumEncoding = TaggedObject "mode" "settings"
+    , ("extension-restriction" Aeson..=) <$> assertM' (is _Just) uploadExtensionRestriction
-  , omitNothingFields = True
+    , pure $ "empty-ok" Aeson..= uploadEmptyOk
-  }''UploadMode
+    ]
+  toJSON UploadSpecific{..} = Aeson.object
+    [ "mode" Aeson..= ("upload-specific" :: String)
+    , "specific-files" Aeson..= uploadSpecificFiles
+    ]
+instance FromJSON UploadMode where
+  parseJSON = Aeson.withObject "UploadMode" $ \o -> do
+    mode <- o Aeson..: "mode" :: Aeson.Parser String
+    case mode of
+      "no-upload" -> return NoUpload
+      "upload" -> do
+        uploadUnpackZips <- o Aeson..:? "unpack-zips" Aeson..!= True
+        uploadExtensionRestriction <- o Aeson..:? "extension-restriction"
+        uploadEmptyOk <- o Aeson..:? "empty-ok" Aeson..!= True
+        return UploadAny{..}
+      "upload-specific" -> do
+        uploadSpecificFiles <- o Aeson..: "specific-files"
+        return UploadSpecific{..}
+      _ -> fail $ "Unrecognised mode for UploadMode, expecting one of (no-upload|upload|upload-specific): “" <> mode <> "”"
 derivePersistFieldJSON ''UploadMode
 
 data UploadModeDescr = UploadModeAny

src/Utils.hs

@@ -951,6 +951,9 @@ takeWhileTime maxT = do
 runPeekN :: forall o m n. (Integral n, Monad m) => n -> ConduitT () o m () -> m (ConduitT () o m (), [o])
 runPeekN n src = over (mapped . _1) unsealConduitT $ src $$+ peekN n
 
+runPeekWhile :: forall o m. Monad m => (o -> Bool) -> ConduitT () o m () -> m (ConduitT () o m (), [o])
+runPeekWhile f src = over (mapped . _1) unsealConduitT $ src $$+ peekWhile f
+
 -----------------
 -- Alternative --
 -----------------

src/Utils/DB.hs

@@ -139,3 +139,17 @@ put :: ( MonadIO m
 put v = do
   forM_ (persistUniqueKeys v) deleteBy
   insert v
+
+selectMaybe :: forall record backend m.
+               ( MonadIO m
+               , PersistQueryRead backend
+               , PersistRecordBackend record backend
+               )
+            => [Filter record] -> [SelectOpt record]
+            -> ReaderT backend m (Maybe (Entity record))
+selectMaybe fltrs opts = listToMaybe <$> selectList fltrs (LimitTo 1 : opts')
+  where opts' = filter (not . isLimit) opts
+        isLimit = \case
+          LimitTo _ -> True
+          _other    -> False
+  

src/Utils/Files.hs

@@ -6,6 +6,7 @@ module Utils.Files
   , FileUploads
   , replaceFileReferences, replaceFileReferences'
   , sinkFileDB, sinkFileMinio
+  , isEmptyFileReference
   ) where
 
 import Import.NoFoundation
@@ -233,3 +234,6 @@ replaceFileReferences :: ( MonadHandler m, MonadThrow m
                       -> FileUploads
                       -> SqlPersistT m (Set (Key record), Set (Key record)) -- ^ @(oldFiles, changes)@
 replaceFileReferences mkFilter residual fs = runConduit $ transPipe liftHandler fs .| replaceFileReferences' mkFilter residual
+
+isEmptyFileReference :: HasFileReference ref => ref -> Bool
+isEmptyFileReference = views (_FileReference . _1 . _fileReferenceContent) (maybe True (== $$(liftTyped $ FileContentReference $$(emptyHash))))

templates/i18n/changelog/upload-mode-empty-ok.de-de-formal.hamlet

@@ -0,0 +1,2 @@
+$newline never
+Kursverwalter können nun angeben ob Uploads, die nur aus leeren Dateien und/oder Verzeichnissen bestehen, pro Übungsblatt akzeptiert werden sollen

templates/i18n/changelog/upload-mode-empty-ok.en-eu.hamlet

@@ -0,0 +1,2 @@
+$newline never
+Course administrators can now specify whether uploads, which consist solely of empty files and/or directories, are to be accepted on a per-exercise-sheet basis

templates/widgets/massinput/uploadSpecificFiles/form.hamlet

@@ -1,5 +1,6 @@
 $newline never
 <td>#{csrf}^{fvWidget labelView}
 <td>^{fvWidget nameView}
+<td>^{fvWidget emptyOkView}
 <td>^{fvWidget maxSizeView}
 <td>^{fvWidget reqView}

templates/widgets/massinput/uploadSpecificFiles/layout.hamlet

@@ -3,6 +3,7 @@ $newline never
   <thead>
     <th>_{MsgUploadSpecificFileLabel}
     <th>_{MsgUploadSpecificFileName}
+    <th>_{MsgUploadSpecificFileEmptyOk}
     <th>_{MsgUploadSpecificFileMaxSize}
     <th>_{MsgUploadSpecificFileRequired}
     <td>

test/Database/Fill.hs

@@ -35,6 +35,9 @@ import qualified Data.Yaml as Yaml
 
 import Utils.Workflow.Lint
 
+import System.Directory (getModificationTime)
+import System.FilePath.Glob (glob)
+
 
 testdataDir :: FilePath
 testdataDir = "testdata"
@@ -603,7 +606,7 @@ fillDb = do
     , sheetVisibleFrom = Just $ termTime True Summer 0 False Monday toMidnight
     , sheetActiveFrom = Just $ termTime True Summer 1 False Monday toMidnight
     , sheetActiveTo = Just $ termTime True Summer 2 False Sunday beforeMidnight
-    , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing
+    , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing False
     , sheetHintFrom = Nothing
     , sheetSolutionFrom = Nothing
     , sheetAutoDistribute = False
@@ -622,7 +625,7 @@ fillDb = do
     , sheetVisibleFrom = Just $ termTime True Summer 1 False Monday toMidnight
     , sheetActiveFrom = Just $ termTime True Summer 2 False Monday toMidnight
     , sheetActiveTo = Just $ termTime True Summer 3 False Sunday beforeMidnight
-    , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing
+    , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing False
     , sheetHintFrom = Nothing
     , sheetSolutionFrom = Nothing
     , sheetAutoDistribute = False
@@ -641,7 +644,7 @@ fillDb = do
     , sheetVisibleFrom = Just $ termTime True Summer 2 False Monday toMidnight
     , sheetActiveFrom = Just $ termTime True Summer 3 False Monday toMidnight
     , sheetActiveTo = Just $ termTime True Summer 4 False Sunday beforeMidnight
-    , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing
+    , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing False
     , sheetHintFrom = Nothing
     , sheetSolutionFrom = Nothing
     , sheetAutoDistribute = False
@@ -807,15 +810,16 @@ fillDb = do
         [   SubmissionMode corrector Nothing
           , SubmissionMode corrector $ Just NoUpload
           , SubmissionMode corrector $ Just UploadSpecific
-            { specificFiles = impureNonNull $ Set.fromList
+            { uploadSpecificFiles = impureNonNull $ Set.fromList
-              [ UploadSpecificFile "Aufgabe 1" "exercise_2.1.hs" False Nothing
+              [ UploadSpecificFile "Aufgabe 1" "exercise_2.1.hs" False False Nothing
-              , UploadSpecificFile "Aufgabe 2" "exercise_2.2.hs" False Nothing
+              , UploadSpecificFile "Aufgabe 2" "exercise_2.2.hs" False False Nothing
-              , UploadSpecificFile "Erklärung der Eigenständigkeit" "erklärung.txt" True (Just 42)
+              , UploadSpecificFile "Erklärung der Eigenständigkeit" "erklärung.txt" True True (Just 42)
               ]
             }
           ] ++ [ SubmissionMode corrector $ Just UploadAny{..}
-               | unpackZips <- universeF
+               | uploadUnpackZips <- universeF
-               , extensionRestriction <- [ Nothing, Just . impureNonNull $ Set.fromList ["pdf", "txt", "jpeg", "hs"] ]
+               , uploadExtensionRestriction <- [ Nothing, Just . impureNonNull $ Set.fromList ["pdf", "txt", "jpeg", "hs"] ]
+               , let uploadEmptyOk = False
                ]
 
       sheetCombinations = ((,,) <$> shTypes <*> shGroupings <*> shSubModes)
@@ -827,8 +831,8 @@ fillDb = do
           | Just userMode <- sheetSubmissionMode ^? _submissionModeUser . _Just
           = let
               extra = catMaybes
-                [ guardOn (fromMaybe False $ userMode ^? _unpackZips) $ mr MsgAutoUnzip
+                [ guardOn (fromMaybe False $ userMode ^? _uploadUnpackZips) $ mr MsgAutoUnzip
-                , guardOn (maybe False (is _Just) $ userMode ^? _extensionRestriction) $ mr MsgUploadModeExtensionRestriction
+                , guardOn (maybe False (is _Just) $ userMode ^? _uploadExtensionRestriction) $ mr MsgUploadModeExtensionRestriction
                 ]
              in mr (classifySubmissionMode sheetSubmissionMode) <> " (" <> Text.intercalate ", " (mr (classifyUploadMode userMode) : extra) <> ")"
           | Just userMode <- sheetSubmissionMode ^? _submissionModeUser . _Just
@@ -1109,7 +1113,7 @@ fillDb = do
       , sheetVisibleFrom = Just $ termTime False Winter (fromInteger shNr) False Monday toMidnight
       , sheetActiveFrom = Just $ termTime False Winter (fromInteger $ succ shNr) False Monday toMidnight
       , sheetActiveTo = Just $ termTime False Winter (fromInteger $ succ shNr) False Sunday beforeMidnight
-      , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing
+      , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True Nothing False
       , sheetHintFrom = Nothing
       , sheetSolutionFrom = Nothing
       , sheetAutoDistribute = False
@@ -1322,3 +1326,19 @@ fillDb = do
       , workflowInstanceDescriptionTitle = "Abschlussarbeiten"
       , workflowInstanceDescriptionDescription = Just "Hier können Sie Abschlussarbeiten bei der Prüfungsverwaltung angemeldet werden, der relevante Student die Arbeit digital abgeben und im Anschluss auch die Benotung an die Prüfungsverwaltung übermittelt werden."
       }
+
+  forM_ universeF $ \changelogItem -> do
+    let ptn = "templates/i18n/changelog/" <> unpack (toPathPiece changelogItem) <> ".*"
+    files <- liftIO $ glob ptn
+    mTime <- fmap minimum . fromNullable <$> mapM (liftIO . getModificationTime) files
+    whenIsJust mTime $ \(utctDay -> firstSeen) -> do
+      oldFirstSeen <- selectMaybe [ ChangelogItemFirstSeenItem ==. changelogItem ] [ Asc ChangelogItemFirstSeenFirstSeen ]
+      case oldFirstSeen of
+        Just (Entity firstSeenId oldEntry)
+          | changelogItemFirstSeenFirstSeen oldEntry > firstSeen
+            -> update firstSeenId [ ChangelogItemFirstSeenFirstSeen =. firstSeen ]
+        Just _
+            -> return ()
+        Nothing
+            -> insert_ $ ChangelogItemFirstSeen changelogItem firstSeen
+        

test/Model/Types/WorkflowSpec.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE UndecidableInstances #-}
+
 module Model.Types.WorkflowSpec where
 
 import TestImport hiding (NonEmpty)
@@ -106,11 +108,11 @@ instance (Arbitrary fileid, Arbitrary userid, Ord fileid, Typeable userid, Typea
     , WorkflowFieldPayloadW <$> arbitrary @(WorkflowFieldPayload fileid userid Scientific)
     , WorkflowFieldPayloadW <$> arbitrary @(WorkflowFieldPayload fileid userid Bool)
     , WorkflowFieldPayloadW <$> arbitrary @(WorkflowFieldPayload fileid userid Day)
-    , WorkflowFieldPayloadW <$> arbitrary @(WorkflowFieldPayload fileid userid (Set fileid))
+    , WorkflowFieldPayloadW <$> arbitrary @(WorkflowFieldPayload fileid userid fileid)
     , WorkflowFieldPayloadW <$> arbitrary @(WorkflowFieldPayload fileid userid userid)
     ]
 
-instance (Arbitrary payload, IsWorkflowFieldPayload fileid userid payload) => Arbitrary (WorkflowFieldPayload fileid userid payload) where
+instance (Arbitrary payload, IsWorkflowFieldPayload' fileid userid payload) => Arbitrary (WorkflowFieldPayload fileid userid payload) where
   arbitrary = review _WorkflowFieldPayload <$> arbitrary
 
 instance Arbitrary WorkflowScope' where

test/Model/TypesSpec.hs

@@ -106,6 +106,7 @@ instance Arbitrary UploadSpecificFile where
     <*> (pack . getPrintableString <$> arbitrary)
     <*> arbitrary
     <*> arbitrary
+    <*> arbitrary
   shrink = genericShrink
 
 instance Arbitrary UploadMode where
@@ -114,6 +115,7 @@ instance Arbitrary UploadMode where
     , UploadAny
       <$> arbitrary
       <*> (fromNullable . Set.fromList . map (pack . getPrintableString) <$> arbitrary)
+      <*> arbitrary
     , UploadSpecific <$> arbitrary
     ]
   shrink = genericShrink
@@ -434,6 +436,14 @@ spec = do
       encEx 65536  [1, 0, 0]
       encEx 65537  [1, 0, 1]
       encEx 197121 [3, 2, 1]
+  describe "SubmissionMode" $ do
+    it "decodes some examples" . example $ do
+      let t str = Aeson.eitherDecode str `shouldSatisfy` (is _Right :: Either _ SubmissionMode -> Bool)
+      t "{\"user\": {\"mode\": \"upload\", \"unpack-zips\": true, \"extension-restriction\": [\"R\", \"pdf\", \"txt\"]}, \"corrector\": false}"
+      t "{\"user\": {\"mode\": \"upload\", \"unpack-zips\": false}, \"corrector\": false}"
+      t "{\"user\": {\"mode\": \"upload-specific\", \"specific-files\": [{\"name\": \"abgabe6.pdf\", \"label\": \"Abgabe 6\", \"required\": true}]}, \"corrector\": false}"
+      t "{\"user\": {\"mode\": \"upload-specific\", \"specific-files\": [{\"name\": \"abgabe10.pdf\", \"label\": \"Abgabe 10\", \"required\": true}, {\"name\": \"deckblatt10.pdf\", \"label\": \"Deckblatt 10\", \"required\": true}]}, \"corrector\": false}"
+      t "{\"user\": {\"mode\": \"no-upload\"}, \"corrector\": false}"
 
 termExample :: (TermIdentifier, Text) -> Expectation
 termExample (term, encoded) = example $ do