Overhaul SubmissonMode extensively

2019-05-18 22:51:07 +02:00 · 2019-05-18 22:51:07 +02:00 · 9f101087ac
commit 9f101087ac
parent 97eb18c5aa
32 changed files with 422 additions and 109 deletions
--- a/config/archive-types
+++ b/config/archive-types
@ -0,0 +1,40 @@
+# Simple list of mime-types corresponding to archive-formats
+#
+# Comments are empty lines and any line for which the first non-whitespace symbol is ‘#’
+#
+# Format is a single mime-type per line (may not contain whitespace)
+#
+# Largely copied from https://en.wikipedia.org/wiki/List_of_archive_formats
+
+application/x-archive 
+application/x-cpio
+application/x-bcpio
+application/x-shar
+application/x-iso9660-image 
+application/x-sbx
+application/x-tar
+application/x-7z-compressed 
+application/x-ace-compressed
+application/x-astrotite-afa 
+application/x-alz-compressed
+application/vnd.android.package-archive 
+application/x-arj 
+application/x-b1 
+application/vnd.ms-cab-compressed 
+application/x-cfs-compressed 
+application/x-dar 
+application/x-dgc-compressed 
+application/x-apple-diskimage 
+application/x-gca-compressed 
+application/java-archive 
+application/x-lzh 
+application/x-lzx 
+application/x-rar-compressed 
+application/x-stuffit 
+application/x-stuffitx 
+application/x-gtar 
+application/x-ms-wim 
+application/x-xar 
+application/zip 
+application/x-zoo 
+application/x-par2 
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@ -445,6 +445,7 @@ SubmissionSinkExceptionDuplicateFileTitle file@FilePath: Dateiname #{show file}
 SubmissionSinkExceptionDuplicateRating: Mehr als eine Bewertung gefunden.
 SubmissionSinkExceptionRatingWithoutUpdate: Bewertung gefunden, es ist hier aber keine Bewertung der Abgabe möglich.
 SubmissionSinkExceptionForeignRating smid@CryptoFileNameSubmission: Fremde Bewertung für Abgabe #{toPathPiece smid} enthalten. Bewertungen müssen sich immer auf die gleiche Abgabe beziehen!
+SubmissionSinkExceptionInvalidFileTitleExtension file@FilePath: Dateiname #{show file} hat keine der für dieses Übungsblatt zulässigen Dateiendungen.

 MultiSinkException name@Text error@Text: In Abgabe #{name} ist ein Fehler aufgetreten: #{error}

@ -488,7 +489,7 @@ LastEdit: Letzte Änderung
 LastEditByUser: Ihre letzte Bearbeitung
 NoEditByUser: Nicht von Ihnen bearbeitet

-SubmissionFilesIgnored: Es wurden Dateien in der hochgeladenen Abgabe ignoriert:
+SubmissionFilesIgnored n@Int: Es #{pluralDE n "wurde" "wurden"} #{tshow n} #{pluralDE n "Datei" "Dateien"} in der hochgeladenen Abgabe ignoriert
 SubmissionDoesNotExist smid@CryptoFileNameSubmission: Es existiert keine Abgabe mit Nummer #{toPathPiece smid}.

 LDAPLoginTitle: Campus-Login
@ -507,8 +508,22 @@ DayIsOutOfLecture tid@TermId date@Text: #{date} ist außerhalb der Vorlesungszei
 DayIsOutOfTerm    tid@TermId date@Text: #{date} liegt nicht im #{display tid}

 UploadModeNone: Kein Upload
-UploadModeUnpack: Upload, einzelne Datei
-UploadModeNoUnpack: Upload, ZIP-Archive entpacken
+UploadModeAny: Upload, beliebige Datei(en)
+UploadModeSpecific: Upload, vorgegebene Dateinamen
+
+UploadModeUnpackZips: Abgabe mehrerer Dateien
+UploadModeUnpackZipsTip: Wenn die Abgabe mehrerer Dateien erlaubt ist, werden auch unterstützte Archiv-Formate zugelassen. Diese werden nach dann beim Hochladen automatisch entpackt.
+
+UploadModeExtensionRestriction: Zulässige Dateiendungen
+UploadModeExtensionRestrictionTip: Komma-separiert. Wenn keine Dateiendungen angegeben werden erfolgt keine Einschränkung.
+
+UploadSpecificFiles: Vorgegebene Dateinamen
+NoUploadSpecificFilesConfigured: Wenn der Abgabemodus vorgegebene Dateinamen vorsieht, muss mindestens ein vorgegebener Dateiname konfiguriert werden.
+UploadSpecificFilesDuplicateNames: Vorgegebene Dateinamen müssen eindeutig sein
+UploadSpecificFilesDuplicateLabels: Bezeichner für vorgegebene Dateinamen müssen eindeutig sein
+UploadSpecificFileLabel: Bezeichnung
+UploadSpecificFileName: Dateiname
+UploadSpecificFileRequired: Zur Abgabe erforderlich

 NoSubmissions: Keine Abgabe
 CorrectorSubmissions: Abgabe extern mit Pseudonym
--- a/6
+++ b/6
@ -104,11 +104,11 @@
    !/subs/new                  SubmissionNewR GET POST        !timeANDcourse-registeredANDuser-submissions
    !/subs/own                  SubmissionOwnR GET             !free -- just redirect
    /subs/#CryptoFileNameSubmission SubmissionR:
-      /                         SubShowR       GET POST        !ownerANDtime !ownerANDread !correctorANDread
-      /delete                   SubDelR        GET POST        !ownerANDtime
+      /                         SubShowR       GET POST        !ownerANDtimeANDuser-submissions !ownerANDread !correctorANDread
+      /delete                   SubDelR        GET POST        !ownerANDtimeANDuser-submissions
      /assign                   SAssignR       GET POST        !lecturerANDtime
      /correction               CorrectionR    GET POST        !corrector !ownerANDreadANDrated
-      /invite                   SInviteR       GET POST        !ownerANDtime
+      /invite                   SInviteR       GET POST        !ownerANDtimeANDuser-submissions
      !/#SubmissionFileType     SubArchiveR    GET             !owner !corrector
      !/#SubmissionFileType/*FilePath SubDownloadR  GET        !owner !corrector
    /correctors                 SCorrR         GET POST
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@ -280,18 +280,12 @@ embedRenderMessage ''UniWorX ''SubmissionModeDescr
        verbMap [_, _, v] = v <> "Submissions"
        verbMap _ = error "Invalid number of verbs"
     in verbMap . splitCamel
+embedRenderMessage ''UniWorX ''UploadModeDescr id
+embedRenderMessage ''UniWorX ''SecretJSONFieldException id

 newtype SheetTypeHeader = SheetTypeHeader SheetType
 embedRenderMessageVariant ''UniWorX ''SheetTypeHeader ("SheetType" <>)

-instance RenderMessage UniWorX UploadMode where
-  renderMessage foundation ls uploadMode = case uploadMode of
-    NoUpload     -> mr MsgUploadModeNone
-    Upload False -> mr MsgUploadModeNoUnpack
-    Upload True  -> mr MsgUploadModeUnpack
-    where
-      mr = renderMessage foundation ls
-
 instance RenderMessage UniWorX SheetType where
  renderMessage foundation ls sheetType = case sheetType of
      NotGraded -> mr $ SheetTypeHeader NotGraded
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@ -2,7 +2,6 @@ module Handler.Admin where

 import Import
 import Handler.Utils
-import Handler.Utils.Form.MassInput
 import Jobs
 import Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder)

@ -261,7 +260,11 @@ postAdminErrMsgR = do
    [whamlet|
      $maybe t <- plaintext
        <pre style="white-space:pre-wrap; font-family:monospace">
-          #{encodePrettyToTextBuilder t}
+          $case t
+            $of String t'
+              #{t'}
+            $of t'
+              #{encodePrettyToTextBuilder t'}

      ^{ctView'}
    |]
--- a/src/Handler/Corrections.hs
+++ b/src/Handler/Corrections.hs
@ -644,7 +644,7 @@ postCorrectionR tid ssh csh shn cid = do
            }

      ((uploadResult, uploadForm'), uploadEncoding) <- runFormPost . identifyForm FIDcorrectionUpload . renderAForm FormStandard $
-            areq (zipFileField True) (fslI MsgRatingFiles) Nothing
+            areq (zipFileField True Nothing) (fslI MsgRatingFiles) Nothing
      let uploadForm = wrapForm uploadForm' def
            { formAction = Just . SomeRoute $ CSubmissionR tid ssh csh shn cid CorrectionR
            , formEncoding = uploadEncoding
@ -720,7 +720,7 @@ getCorrectionsUploadR, postCorrectionsUploadR :: Handler Html
 getCorrectionsUploadR = postCorrectionsUploadR
 postCorrectionsUploadR = do
  ((uploadRes, upload), uploadEncoding) <- runFormPost . identifyForm FIDcorrectionsUpload . renderAForm FormStandard $
-       areq (zipFileField True) (fslI MsgCorrUploadField & addAttr "uw-file-input" "") Nothing
+       areq (zipFileField True Nothing) (fslI MsgCorrUploadField) Nothing

  case uploadRes of
    FormMissing -> return ()
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@ -11,7 +11,6 @@ import Handler.Utils
 import Handler.Utils.Course
 import Handler.Utils.Tutorial
 import Handler.Utils.Communication
-import Handler.Utils.Form.MassInput
 import Handler.Utils.Delete
 import Handler.Utils.Database
 import Handler.Utils.Table.Cells
--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@ -14,7 +14,6 @@ import Handler.Utils.Table.Cells
 -- import Handler.Utils.Table.Columns
 import Handler.Utils.SheetType
 import Handler.Utils.Delete
-import Handler.Utils.Form.MassInput
 import Handler.Utils.Invitations

 -- import Data.Time
@ -116,7 +115,7 @@ makeSheetForm msId template = identifyForm FIDsheet $ \html -> do
            & setTooltip MsgSheetActiveFromTip)
                                                              (sfActiveFrom   <$> template)
      <*> areq utcTimeField   (fslI MsgSheetActiveTo)         (sfActiveTo     <$> template)
-      <*> submissionModeForm ((sfSubmissionMode <$> template) <|> pure (SubmissionMode False . Just $ Upload True))
+      <*> submissionModeForm ((sfSubmissionMode <$> template) <|> pure (SubmissionMode False . Just $ UploadAny True defaultExtensionRestriction))
      <*> aopt (multiFileField $ oldFileIds SheetExercise) (fslI MsgSheetExercise) (sfSheetF <$> template)
      <*> aopt utcTimeField   (fslpI MsgSheetHintFrom "Datum, sonst nur für Korrektoren"
            & setTooltip MsgSheetHintFromTip)                 (sfHintFrom     <$> template)
--- a/src/Handler/Submission.hs
+++ b/src/Handler/Submission.hs
@ -14,7 +14,6 @@ import Handler.Utils
 import Handler.Utils.Delete
 import Handler.Utils.Submission
 import Handler.Utils.Table.Cells
-import Handler.Utils.Form.MassInput
 import Handler.Utils.Invitations

 -- import Control.Monad.Trans.Maybe
@ -130,8 +129,19 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident
    fileUploadForm = case uploadMode of
      NoUpload
        -> pure Nothing
-      (Upload unpackZips)
-        -> (bool (\f fs _ -> Just <$> areq f fs Nothing) aopt $ isJust msmid) (zipFileField unpackZips) (fsm $ bool MsgSubmissionFile MsgSubmissionArchive unpackZips) Nothing
+      UploadAny{..}
+        -> (bool (\f fs _ -> Just <$> areq f fs Nothing) aopt $ isJust msmid) (zipFileField unpackZips extensionRestriction) (fsm $ bool MsgSubmissionFile MsgSubmissionArchive unpackZips) Nothing
+      UploadSpecific{..}
+        -> mergeFileSources <$> sequenceA (map specificFileForm . Set.toList $ toNullable specificFiles)
+
+    specificFileForm :: UploadSpecificFile -> AForm Handler (Maybe (Source Handler File))
+    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
+
+    mergeFileSources :: [Maybe (Source Handler File)] -> Maybe (Source Handler File)
+    mergeFileSources (catMaybes -> sources) = case sources of
+      [] -> Nothing
+      fs -> Just $ sequence_ fs

    miCell' :: Markup -> Either UserEmail UserId -> Widget
    miCell' csrf (Left email) = $(widgetFile "widgets/massinput/submissionUsers/cellInvitation")
@ -352,7 +362,9 @@ submissionHelper tid ssh csh shn mcid = do
              return (userName, submissionEdit E.^. SubmissionEditTime)
            forM raw $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time
        return (csheet,buddies,lastEdits,maySubmit,isLecturer,isOwner)
-  ((res,formWidget'), formEnctype) <- runFormPost . makeSubmissionForm sheetCourse msmid (fromMaybe (Upload True) . submissionModeUser $ sheetSubmissionMode) sheetGrouping isLecturer $ bool id (Set.insert $ Right uid) isOwner buddies
+  -- @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) <- runFormPost . makeSubmissionForm sheetCourse msmid (fromMaybe (UploadAny True Nothing) . submissionModeUser $ sheetSubmissionMode) sheetGrouping isLecturer $ bool id (Set.insert $ Right uid) isOwner buddies 
  let formWidget = wrapForm' BtnHandIn formWidget' def
        { formAction = Just $ SomeRoute actionUrl
        , formEncoding = formEnctype
--- a/src/Handler/Term.hs
+++ b/src/Handler/Term.hs
@ -3,7 +3,6 @@ module Handler.Term where
 import Import
 import Handler.Utils
 import Handler.Utils.Table.Cells
-import Handler.Utils.Form.MassInput
 import qualified Data.Map as Map

 import Utils.Lens
--- a/src/Handler/Tutorial.hs
+++ b/src/Handler/Tutorial.hs
@ -8,7 +8,6 @@ import Handler.Utils.Tutorial
 import Handler.Utils.Table.Cells
 import Handler.Utils.Delete
 import Handler.Utils.Communication
-import Handler.Utils.Form.MassInput
 import Handler.Utils.Form.Occurences
 import Handler.Utils.Invitations
 import Jobs.Queue
--- a/src/Handler/Utils/Communication.hs
+++ b/src/Handler/Utils/Communication.hs
@ -9,7 +9,6 @@ module Handler.Utils.Communication

 import Import
 import Handler.Utils
-import Handler.Utils.Form.MassInput
 import Utils.Lens

 import Jobs.Queue
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@ -1,5 +1,6 @@
 module Handler.Utils.Form
  ( module Handler.Utils.Form
+  , module Handler.Utils.Form.MassInput
  , module Utils.Form
  , MonadWriter(..)
  ) where
@ -35,6 +36,7 @@ import qualified Data.Map as Map
 import Control.Monad.Trans.Writer (execWriterT, WriterT)
 import Control.Monad.Trans.Except (throwE, runExceptT)
 import Control.Monad.Writer.Class
+import Control.Monad.Error.Class (MonadError(..))

 import Data.Scientific (Scientific)
 import Text.Read (readMaybe)
@ -49,6 +51,13 @@ import Data.Proxy

 import qualified Text.Email.Validate as Email

+import Yesod.Core.Types (FileInfo(..))
+
+import System.FilePath (isExtensionOf)
+import Data.Text.Lens (unpacked)
+
+import Handler.Utils.Form.MassInput
+
 ----------------------------
 -- Buttons (new version ) --
 ----------------------------
@ -341,14 +350,88 @@ studyFeaturesPrimaryFieldFor isOptional oldFeatures mbuid = selectField $ do
          }


-uploadModeField :: Field Handler UploadMode
-uploadModeField = selectField optionsFinite
+uploadModeForm :: Maybe UploadMode -> AForm Handler UploadMode
+uploadModeForm prev = multiActionA actions (fslI MsgSheetUploadMode) (classifyUploadMode <$> prev)
+  where
+    actions :: Map UploadModeDescr (AForm Handler UploadMode)
+    actions = Map.fromList
+      [ ( UploadModeNone, pure NoUpload)
+      , ( UploadModeAny
+        , UploadAny
+          <$> apreq checkBoxField (fslI MsgUploadModeUnpackZips & setTooltip MsgUploadModeUnpackZipsTip) (prev ^? _Just . _unpackZips)
+          <*> apreq extensionRestrictionField (fslI MsgUploadModeExtensionRestriction & setTooltip MsgUploadModeExtensionRestrictionTip) ((prev ^? _Just . _extensionRestriction) <|> fmap Just defaultExtensionRestriction)
+        )
+      , ( UploadModeSpecific
+        , UploadSpecific <$> specificFileForm
+        )
+      ]
+  
+    extensionRestrictionField :: Field Handler (Maybe (NonNull (Set Extension)))
+    extensionRestrictionField = convertField (fromNullable . toSet) (maybe "" $ intercalate ", " . Set.toList . toNullable) textField
+      where
+        toSet = Set.fromList . filter (not . Text.null) . map (stripDot . Text.strip) . Text.splitOn ","
+        stripDot ext
+          | Just nExt <- Text.stripPrefix "." ext = nExt
+          | otherwise = ext
+    
+    specificFileForm :: AForm Handler (NonNull (Set UploadSpecificFile))
+    specificFileForm = wFormToAForm $ do
+      Just currentRoute <- getCurrentRoute
+      let miButtonAction :: forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)
+          miButtonAction frag = Just . SomeRoute $ currentRoute :#: frag
+      miIdent <- ("specific-files--" <>) <$> newIdent
+      postProcess =<< massInputW MassInput{..} (fslI MsgUploadSpecificFiles & setTooltip MsgMassInputTip) True (preProcess <$> prev ^? _Just . _specificFiles)
+      where
+        preProcess :: NonNull (Set UploadSpecificFile) -> Map ListPosition (UploadSpecificFile, UploadSpecificFile)
+        preProcess = Map.fromList . zip [0..] . map (\x -> (x, x)) . Set.toList . toNullable
+        
+        postProcess :: FormResult (Map ListPosition (UploadSpecificFile, UploadSpecificFile)) -> WForm Handler (FormResult (NonNull (Set UploadSpecificFile)))
+        postProcess mapResult = do
+          MsgRenderer mr <- getMsgRenderer
+          return $ do
+            mapResult' <- Set.fromList . map snd . Map.elems <$> mapResult
+            case fromNullable mapResult' of
+              Nothing -> throwError [mr MsgNoUploadSpecificFilesConfigured]
+              Just lResult -> do
+                let names = Set.map specificFileName mapResult'
+                    labels = Set.map specificFileLabel mapResult'
+                if
+                  | Set.size names /= Set.size mapResult'
+                    -> throwError [mr MsgUploadSpecificFilesDuplicateNames]
+                  | Set.size labels /= Set.size mapResult'
+                    -> throwError [mr MsgUploadSpecificFilesDuplicateLabels]
+                  | otherwise
+                    -> return lResult
+
+        sFileForm :: (Text -> Text) -> Maybe UploadSpecificFile -> Form UploadSpecificFile
+        sFileForm nudge mPrevUF csrf = do
+          (labelRes, labelView) <- mpreq textField ("" & addName (nudge "label")) $ specificFileLabel <$> mPrevUF
+          (nameRes, nameView) <- mpreq textField ("" & addName (nudge "name")) $ specificFileName <$> mPrevUF
+          (reqRes, reqView) <- mpreq checkBoxField ("" & addName (nudge "required")) $ specificFileRequired <$> mPrevUF
+
+          return ( UploadSpecificFile <$> labelRes <*> nameRes <*> reqRes
+                 , $(widgetFile "widgets/massinput/uploadSpecificFiles/form")
+                 )
+
+        miAdd _ _ nudge submitView = Just $ \csrf -> do
+          (formRes, formWidget) <- sFileForm nudge Nothing csrf
+          let formWidget' = $(widgetFile "widgets/massinput/uploadSpecificFiles/add")
+              addRes' = formRes <&> \fileRes oldRess ->
+                let iStart = maybe 0 (succ . fst) $ Map.lookupMax oldRess
+                 in pure $ Map.singleton iStart fileRes
+          return (addRes', formWidget')
+        miCell _ initFile initFile' nudge csrf =
+          sFileForm nudge (Just $ fromMaybe initFile initFile') csrf
+        miDelete = miDeleteList
+        miAllowAdd _ _ _ = True
+        miAddEmpty _ _ _ = Set.empty
+        miLayout :: MassInputLayout ListLength UploadSpecificFile UploadSpecificFile
+        miLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/massinput/uploadSpecificFiles/layout")
+                                               

 submissionModeForm :: Maybe SubmissionMode -> AForm Handler SubmissionMode
 submissionModeForm prev = multiActionA actions (fslI MsgSheetSubmissionMode) $ classifySubmissionMode <$> prev
  where
-    uploadModeForm = apreq uploadModeField (fslI MsgSheetUploadMode) (preview (_Just . _submissionModeUser . _Just) $ prev)
-
    actions :: Map SubmissionModeDescr (AForm Handler SubmissionMode)
    actions = Map.fromList
      [ ( SubmissionModeNone
@ -358,10 +441,10 @@ submissionModeForm prev = multiActionA actions (fslI MsgSheetSubmissionMode) $ c
        , pure $ SubmissionMode True  Nothing
        )
      , ( SubmissionModeUser
-        , SubmissionMode False . Just <$> uploadModeForm
+        , SubmissionMode False . Just <$> uploadModeForm (prev ^? _Just . _submissionModeUser . _Just)
        )
      , ( SubmissionModeBoth
-        , SubmissionMode True  . Just <$> uploadModeForm
+        , SubmissionMode True  . Just <$> uploadModeForm (prev ^? _Just . _submissionModeUser . _Just)
        )
      ]

@ -374,17 +457,41 @@ pseudonymWordField = checkMMap doCheck CI.original $ textField & addDatalist (re
      | otherwise
      = return . Left $ MsgUnknownPseudonymWord (CI.original w)

-zipFileField :: Bool -- ^ Unpack zips?
-             -> Field Handler (Source Handler File)
-zipFileField doUnpack = Field{..}
+specificFileField :: UploadSpecificFile -> Field Handler (Source Handler File)
+specificFileField UploadSpecificFile{..} = Field{..}
  where
    fieldEnctype = Multipart
    fieldParse _ files
-      | [f] <- files = return . Right . Just $ bool (yieldM . acceptFile) sourceFiles doUnpack f
+      | [f] <- files
+      = return . Right . Just $ yieldM (acceptFile f) .| modifyFileTitle (const $ unpack specificFileName)
+      | null files   = return $ Right Nothing
+      | otherwise    = return . Left $ SomeMessage MsgOnlyUploadOneFile
+    fieldView fieldId fieldName attrs _ req = $(widgetFile "widgets/specificFileField")
+
+    extensions = fileNameExtensions specificFileName
+    acceptRestricted = not $ null extensions
+    accept = Text.intercalate "," . map ("." <>) $ extensions
+
+
+zipFileField :: Bool -- ^ Unpack zips?
+             -> Maybe (NonNull (Set Extension)) -- ^ Restrictions on file extensions
+             -> Field Handler (Source Handler File)
+zipFileField doUnpack permittedExtensions = Field{..}
+  where
+    fieldEnctype = Multipart
+    fieldParse _ files
+      | [f@FileInfo{..}] <- files
+      , maybe True (anyOf (re _nullable . folded . unpacked) (`isExtensionOf` unpack fileName)) permittedExtensions || doUnpack
+      = return . Right . Just $ bool (yieldM . acceptFile) sourceFiles doUnpack f
      | null files   = return $ Right Nothing
      | otherwise    = return . Left $ SomeMessage MsgOnlyUploadOneFile
    fieldView fieldId fieldName attrs _ req = $(widgetFile "widgets/zipFileField")

+    zipExtensions = mimeExtensions "application/zip"
+
+    acceptRestricted = isJust permittedExtensions
+    accept = Text.intercalate "," . map ("." <>) $ bool [] (Set.toList zipExtensions) doUnpack ++ toListOf (_Just . re _nullable . folded) permittedExtensions
+
 multiFileField :: Handler (Set FileId) -> Field Handler (Source Handler (Either FileId File))
 multiFileField permittedFiles' = Field{..}
  where
@ -590,23 +697,6 @@ jsonField hide = Field{..}
    |]
    fieldEnctype = UrlEncoded

-secretJsonField :: ( ToJSON a, FromJSON a
-                   , MonadHandler m
-                   , HandlerSite m ~ UniWorX
-                   )
-                => Field m a
-secretJsonField = Field{..}
-  where
-    fieldParse [v] [] = bimap (\_ -> SomeMessage MsgSecretJSONFieldDecryptFailure) Just <$> runExceptT (encodedSecretBoxOpen v)
-    fieldParse [] [] = return $ Right Nothing
-    fieldParse _ _ = return . Left $ SomeMessage MsgValueRequired
-    fieldView theId name attrs val _isReq = do
-      val' <- traverse (encodedSecretBox SecretBoxShort) val
-      [whamlet|
-        <input id=#{theId} name=#{name} *{attrs} type=hidden value=#{either id id val'}>
-      |]
-    fieldEnctype = UrlEncoded
-
 boolField :: ( MonadHandler m
             , HandlerSite m ~ UniWorX
             )
--- a/src/Handler/Utils/Form/MassInput.hs
+++ b/src/Handler/Utils/Form/MassInput.hs
@ -17,7 +17,6 @@ module Handler.Utils.Form.MassInput
 import Import
 import Utils.Form
 import Utils.Lens
-import Handler.Utils.Form (secretJsonField)
 import Handler.Utils.Form.MassInput.Liveliness
 import Handler.Utils.Form.MassInput.TH

--- a/src/Handler/Utils/Form/Occurences.hs
+++ b/src/Handler/Utils/Form/Occurences.hs
@ -4,7 +4,6 @@ module Handler.Utils.Form.Occurences

 import Import
 import Handler.Utils.Form
-import Handler.Utils.Form.MassInput
 import Handler.Utils.DateTime

 import qualified Data.Set as Set
--- a/src/Handler/Utils/Submission.hs
+++ b/src/Handler/Utils/Submission.hs
@ -318,8 +318,10 @@ extractRatingsMsg = do
  let ignoredFiles :: Set (Either CryptoFileNameSubmission FilePath)
      ignoredFiles = Right `Set.map` ignored'
  unless (null ignoredFiles) $ do
-    mr <- (toHtml . ) <$> getMessageRender
-    addMessage Warning =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionFilesIgnored.hamlet") mr)
+    let ignoredModal = msgModal
+          [whamlet|_{MsgSubmissionFilesIgnored (Set.size ignoredFiles)}|]
+          (Right $(widgetFile "messages/submissionFilesIgnored"))
+    addMessageWidget Warning ignoredModal

 -- Nicht innerhalb von runDB aufrufen, damit das DB Rollback passieren kann!
 msgSubmissionErrors :: (MonadHandler m, MonadCatch m, HandlerSite m ~ UniWorX) => m a -> m (Maybe a)
@ -362,10 +364,28 @@ sinkSubmission userId mExists isUpdate = do
      return sId
    Right sId -> return sId

-  sId <$ sinkSubmission' sId
+  Sheet{..} <- lift $ case mExists of
+    Left sheetId -> getJust sheetId
+    Right subId  -> getJust . submissionSheet =<< getJust subId
+
+  sId <$ (guardFileTitles sheetSubmissionMode .| sinkSubmission' sId)
  where
    tellSt = modify . mappend

+    guardFileTitles :: MonadThrow m => SubmissionMode -> Conduit SubmissionContent m SubmissionContent
+    guardFileTitles SubmissionMode{..}
+      | Just UploadAny{..} <- submissionModeUser
+      , not isUpdate
+      , Just (map unpack . Set.toList . toNullable -> exts) <- extensionRestriction
+      = Conduit.mapM $ \x -> if
+          | Left File{..} <- x
+          , none (`isExtensionOf` fileTitle) exts
+          , isn't _Nothing fileContent -- File record is not a directory, we don't care about those
+            -> throwM $ InvalidFileTitleExtension fileTitle
+          | otherwise
+            -> return x
+      | otherwise = Conduit.map id
+
    sinkSubmission' :: SubmissionId
                    -> Sink SubmissionContent (YesodJobDB UniWorX) ()
    sinkSubmission' submissionId = lift . finalize <=< execStateLC mempty . Conduit.mapM_ $ \case
--- a/src/Import/NoFoundation.hs
+++ b/src/Import/NoFoundation.hs
@ -99,6 +99,8 @@ import Data.CaseInsensitive as Import (CI, FoldCase(..), foldedCase)

 import Data.Ratio as Import ((%))

+import Network.Mime as Import
+

 import Control.Monad.Trans.RWS (RWST)

--- a/src/Model/Migration.hs
+++ b/src/Model/Migration.hs
@ -279,8 +279,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 $ Upload True)
-                ( Legacy.UserSubmissions     , Legacy.Upload False ) -> SubmissionMode False (Just $ Upload False)
+                ( Legacy.UserSubmissions     , Legacy.Upload True  ) -> SubmissionMode False (Just $ UploadAny True defaultExtensionRestriction)
+                ( Legacy.UserSubmissions     , Legacy.Upload False ) -> SubmissionMode False (Just $ UploadAny False defaultExtensionRestriction)
          [executeQQ| UPDATE "sheet" SET "submission_mode" = #{submissionMode'} WHERE "id" = #{shid}; |]
    )
  , ( AppliedMigrationKey [migrationVersion|11.0.0|] [version|12.0.0|]
--- a/src/Model/Submission.hs
+++ b/src/Model/Submission.hs
@ -7,6 +7,7 @@ data SubmissionSinkException = DuplicateFileTitle FilePath
                             | DuplicateRating
                             | RatingWithoutUpdate
                             | ForeignRating CryptoFileNameSubmission
+                             | InvalidFileTitleExtension FilePath
  deriving (Typeable, Show)

 instance Exception SubmissionSinkException
--- a/src/Model/Types/Sheet.hs
+++ b/src/Model/Types/Sheet.hs
@ -16,7 +16,6 @@ import Generics.Deriving.Monoid (memptydefault, mappenddefault)
 import Data.Typeable (Typeable)
 import Data.Universe
 import Data.Universe.Helpers
-import Data.Universe.TH
 import Data.Universe.Instances.Reverse ()

 import Data.NonNull.Instances ()
@ -34,6 +33,8 @@ import Database.Persist.TH hiding (derivePersistFieldJSON)
 import Model.Types.JSON
 import Yesod.Core.Dispatch (PathPiece(..))

+import Network.Mime
+


 ----
@ -210,9 +211,11 @@ partitionFileType fs t = Map.findWithDefault Set.empty t . Map.fromListWith Set.
 data SubmissionFileType = SubmissionOriginal | SubmissionCorrected
  deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic)

-instance Universe SubmissionFileType where universe = universeDef
+instance Universe SubmissionFileType
 instance Finite SubmissionFileType

+nullaryPathPiece ''SubmissionFileType $ camelToPathPiece' 1
+
 submissionFileTypeIsUpdate :: SubmissionFileType -> Bool
 submissionFileTypeIsUpdate SubmissionOriginal  = False
 submissionFileTypeIsUpdate SubmissionCorrected = True
@ -221,41 +224,52 @@ isUpdateSubmissionFileType :: Bool -> SubmissionFileType
 isUpdateSubmissionFileType False = SubmissionOriginal
 isUpdateSubmissionFileType True  = SubmissionCorrected

-instance PathPiece SubmissionFileType where
-  toPathPiece SubmissionOriginal  = "original"
-  toPathPiece SubmissionCorrected = "corrected"
-  fromPathPiece = finiteFromPathPiece

-- instance DisplayAble SubmissionFileType where
--   display SubmissionOriginal  = "Abgabe"
--   display SubmissionCorrected = "Korrektur"
+data UploadSpecificFile = UploadSpecificFile
+  { specificFileLabel :: Text
+  , specificFileName :: FileName
+  , specificFileRequired :: Bool
+  } deriving (Show, Read, Eq, Ord, Generic)

-{-
-data DA = forall a . (DisplayAble a) => DA a
+deriveJSON defaultOptions
+  { fieldLabelModifier = camelToPathPiece' 2
+  } ''UploadSpecificFile
+derivePersistFieldJSON ''UploadSpecificFile

-instance DisplayAble DA where
-  display (DA x) = display x
-}
-
-
-data UploadMode = NoUpload | Upload { unpackZips :: Bool }
+data UploadMode = NoUpload
+                | UploadAny
+                  { unpackZips :: Bool
+                  , extensionRestriction :: Maybe (NonNull (Set Extension))
+                  }
+                | UploadSpecific
+                  { specificFiles :: NonNull (Set UploadSpecificFile)
+                  }
  deriving (Show, Read, Eq, Ord, Generic)

-deriveFinite ''UploadMode
+defaultExtensionRestriction :: Maybe (NonNull (Set Extension))
+defaultExtensionRestriction = fromNullable $ Set.fromList ["txt", "pdf"]

 deriveJSON defaultOptions
  { constructorTagModifier = camelToPathPiece
  , fieldLabelModifier = camelToPathPiece
  , sumEncoding = TaggedObject "mode" "settings"
+  , omitNothingFields = True
  }''UploadMode
 derivePersistFieldJSON ''UploadMode

-instance PathPiece UploadMode where
-  toPathPiece = \case
-    NoUpload     -> "no-upload"
-    Upload True  -> "unpack"
-    Upload False -> "no-unpack"
-  fromPathPiece = finiteFromPathPiece
+data UploadModeDescr = UploadModeNone
+                     | UploadModeAny
+                     | UploadModeSpecific
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+instance Universe UploadModeDescr
+instance Finite UploadModeDescr
+
+nullaryPathPiece ''UploadModeDescr $ camelToPathPiece' 2
+
+classifyUploadMode :: UploadMode -> UploadModeDescr
+classifyUploadMode NoUpload = UploadModeNone
+classifyUploadMode UploadAny{} = UploadModeAny
+classifyUploadMode UploadSpecific{} = UploadModeSpecific

 data SubmissionMode = SubmissionMode
  { submissionModeCorrector :: Bool
@ -263,24 +277,11 @@ data SubmissionMode = SubmissionMode
  }
  deriving (Show, Read, Eq, Ord, Generic)

-deriveFinite ''SubmissionMode
-
 deriveJSON defaultOptions
  { fieldLabelModifier = camelToPathPiece' 2
  } ''SubmissionMode
 derivePersistFieldJSON ''SubmissionMode

-finitePathPiece ''SubmissionMode
-  [ "no-submissions"
-  , "no-upload"
-  , "no-unpack"
-  , "unpack"
-  , "correctors"
-  , "correctors+no-upload"
-  , "correctors+no-unpack"
-  , "correctors+unpack"
-  ]
-
 data SubmissionModeDescr = SubmissionModeNone
                         | SubmissionModeCorrector
                         | SubmissionModeUser
@ -336,4 +337,4 @@ instance Monoid Load where
  isByTutorial :: Load -> Bool
  isByTutorial (ByTutorial {}) = True
  isByTutorial _               = False
-}
+-}
--- a/src/Network/Mime/TH.hs
+++ b/src/Network/Mime/TH.hs
@ -1,11 +1,12 @@
 module Network.Mime.TH
-  ( mimeMapFile
+  ( mimeMapFile, mimeSetFile
  ) where

 import ClassyPrelude.Yesod hiding (lift)
 import Language.Haskell.TH hiding (Extension)
 import Language.Haskell.TH.Syntax (qAddDependentFile, Lift(..))

+import qualified Data.Set as Set
 import qualified Data.Map as Map

 import Data.Text (Text)
@ -18,7 +19,7 @@ import Network.Mime
 import Instances.TH.Lift ()


-mimeMapFile :: FilePath -> ExpQ
+mimeMapFile, mimeSetFile :: FilePath -> ExpQ
 mimeMapFile file = do
  qAddDependentFile file
  
@ -36,6 +37,15 @@ mimeMapFile file = do


  lift mimeMap
+mimeSetFile file = do
+  qAddDependentFile file
+  
+  ls <- runIO $ filter (not . isComment) . Text.lines <$> Text.readFile file
+
+  let mimeSet :: Set MimeType
+      mimeSet = Set.fromList $ map (encodeUtf8 . Text.strip) ls
+
+  lift mimeSet

 isComment :: Text -> Bool
 isComment line = or
--- a/src/Settings.hs
+++ b/src/Settings.hs
@ -73,6 +73,9 @@ import Handler.Utils.Submission.TH
 import Network.Mime
 import Network.Mime.TH

+import qualified Data.Map as Map
+import qualified Data.Set as Set
+

 -- | Runtime settings to configure this application. These settings can be
 -- loaded from various sources: defaults, environment variables, config files,
@ -431,8 +434,17 @@ widgetFileSettings = def
 submissionBlacklist :: [Pattern]
 submissionBlacklist = $(patternFile compDefault "config/submission-blacklist")

+mimeMap :: MimeMap
+mimeMap = $(mimeMapFile "config/mimetypes")
+
 mimeLookup :: FileName -> MimeType
-mimeLookup = mimeByExt $(mimeMapFile "config/mimetypes") defaultMimeType
+mimeLookup = mimeByExt mimeMap defaultMimeType
+
+mimeExtensions :: MimeType -> Set Extension
+mimeExtensions needle = Set.fromList [ ext | (ext, typ) <- Map.toList mimeMap, typ == needle ]
+
+archiveTypes :: Set MimeType
+archiveTypes = $(mimeSetFile "config/archive-types")

 -- The rest of this file contains settings which rarely need changing by a
 -- user.
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@ -24,6 +24,7 @@ import Control.Monad.Trans.Maybe (MaybeT(..))
 import Control.Monad.Reader.Class (MonadReader(..))
 import Control.Monad.Writer.Class (MonadWriter(..))
 import Control.Monad.Trans.RWS (mapRWST)
+import Control.Monad.Trans.Except (ExceptT, runExceptT)

 import Data.List ((!!))

@ -445,6 +446,29 @@ optionsFinite = do
 rationalField :: (MonadHandler m, RenderMessage (HandlerSite m) FormMessage) => Field m Rational
 rationalField = convertField toRational fromRational doubleField

+data SecretJSONFieldException = SecretJSONFieldDecryptFailure
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+instance Exception SecretJSONFieldException
+
+secretJsonField :: ( ToJSON a, FromJSON a
+                   , MonadHandler m
+                   , MonadSecretBox (ExceptT EncodedSecretBoxException m)
+                   , MonadSecretBox (WidgetT (HandlerSite m) IO)
+                   , RenderMessage (HandlerSite m) FormMessage
+                   , RenderMessage (HandlerSite m) SecretJSONFieldException
+                   )
+                => Field m a
+secretJsonField = Field{..}
+  where
+    fieldParse [v] [] = bimap (\_ -> SomeMessage SecretJSONFieldDecryptFailure) Just <$> runExceptT (encodedSecretBoxOpen v)
+    fieldParse [] [] = return $ Right Nothing
+    fieldParse _ _ = return . Left $ SomeMessage MsgValueRequired
+    fieldView theId name attrs val _isReq = do
+      val' <- traverse (encodedSecretBox SecretBoxShort) val
+      [whamlet|
+        <input id=#{theId} name=#{name} *{attrs} type=hidden value=#{either id id val'}>
+      |]
+    fieldEnctype = UrlEncoded

 -----------
 -- Forms --
--- a/src/Utils/Lens.hs
+++ b/src/Utils/Lens.hs
@ -103,6 +103,8 @@ makePrisms ''HandlerContents

 makePrisms ''ErrorResponse

+makeLenses_ ''UploadMode
+
 makeLenses_ ''SubmissionMode

 makePrisms ''E.Value
--- a/stack.yaml
+++ b/stack.yaml
@ -51,4 +51,6 @@ extra-deps:

  - systemd-1.2.0

+  - filepath-1.4.2
+
 resolver: lts-10.5
--- a/templates/messages/submissionFilesIgnored.hamlet
+++ b/templates/messages/submissionFilesIgnored.hamlet
@ -1,4 +1,4 @@
-_{MsgSubmissionFilesIgnored}
+<h2>_{MsgSubmissionFilesIgnored (Set.size ignoredFiles)}
 <ul>
  $forall ident <- ignoredFiles
    $case ident
--- a/templates/widgets/massinput/uploadSpecificFiles/add.hamlet
+++ b/templates/widgets/massinput/uploadSpecificFiles/add.hamlet
@ -0,0 +1,4 @@
+$newline never
+^{formWidget}
+<td>
+  ^{fvInput submitView}
--- a/templates/widgets/massinput/uploadSpecificFiles/form.hamlet
+++ b/templates/widgets/massinput/uploadSpecificFiles/form.hamlet
@ -0,0 +1,4 @@
+$newline never
+<td>#{csrf}^{fvInput labelView}
+<td>^{fvInput nameView}
+<td>^{fvInput reqView}
--- a/templates/widgets/massinput/uploadSpecificFiles/layout.hamlet
+++ b/templates/widgets/massinput/uploadSpecificFiles/layout.hamlet
@ -0,0 +1,16 @@
+$newline never
+<table>
+  <thead>
+    <th>_{MsgUploadSpecificFileLabel}
+    <th>_{MsgUploadSpecificFileName}
+    <th>_{MsgUploadSpecificFileRequired}
+    <th>
+  <tbody>
+    $forall coord <- review liveCoords lLength
+      <tr .massinput__cell>
+        ^{cellWdgts ! coord}
+        <td>
+          ^{fvInput (delButtons ! coord)}
+  <tfoot>
+    <tr .massinput__cell.massinput__cell--add>
+      ^{addWdgts ! (0, 0)}
--- a/templates/widgets/specificFileField.hamlet
+++ b/templates/widgets/specificFileField.hamlet
@ -0,0 +1,8 @@
+$newline never
+<input type=file uw-file-input ##{fieldId} *{attrs} name=#{fieldName} :req:required :acceptRestricted:accept=#{accept}>
+$if acceptRestricted
+  <br>
+  _{MsgUploadModeExtensionRestriction}: 
+  <ul .list--inline .list--comma-separated .list--iconless>
+    $forall ext <- extensions
+      <li style="font-family: monospace">#{ext}
--- a/templates/widgets/zipFileField.hamlet
+++ b/templates/widgets/zipFileField.hamlet
@ -1,2 +1,8 @@
 $newline never
-<input type=file uw-file-input ##{fieldId} *{attrs} name=#{fieldName} :req:required>
+<input type=file uw-file-input ##{fieldId} *{attrs} name=#{fieldName} :req:required :acceptRestricted:accept=#{accept}>
+$maybe exts <- fmap toNullable permittedExtensions
+  <br>
+  _{MsgUploadModeExtensionRestriction}: 
+  <ul .list--inline .list--comma-separated .list--iconless>
+    $forall ext <- zipExtensions <> exts
+      <li style="font-family: monospace">#{ext}
--- a/test/Database.hs
+++ b/test/Database.hs
@ -393,11 +393,11 @@ fillDb = do
  void . insert $ DegreeCourse ffp sdMst sdInf
  void . insert $ Lecturer jost   ffp CourseLecturer
  void . insert $ Lecturer gkleen ffp CourseAssistant
-  adhoc <- insert $ Sheet ffp "AdHoc-Gruppen" Nothing NotGraded (Arbitrary 3) Nothing Nothing now now Nothing Nothing (SubmissionMode False . Just $ Upload True) False
+  adhoc <- insert $ Sheet ffp "AdHoc-Gruppen" Nothing NotGraded (Arbitrary 3) Nothing Nothing now now Nothing Nothing (SubmissionMode False . Just $ UploadAny True Nothing) False
  insert_ $ SheetEdit gkleen now adhoc
-  feste <- insert $ Sheet ffp "Feste Gruppen" Nothing NotGraded RegisteredGroups Nothing Nothing now now Nothing Nothing (SubmissionMode False . Just $ Upload True) False
+  feste <- insert $ Sheet ffp "Feste Gruppen" Nothing NotGraded RegisteredGroups Nothing Nothing now now Nothing Nothing (SubmissionMode False . Just $ UploadAny True Nothing) False
  insert_ $ SheetEdit gkleen now feste
-  keine <- insert $ Sheet ffp "Keine Gruppen" Nothing NotGraded NoGroups Nothing Nothing now now Nothing Nothing (SubmissionMode False . Just $ Upload True) False
+  keine <- insert $ Sheet ffp "Keine Gruppen" Nothing NotGraded NoGroups Nothing Nothing now now Nothing Nothing (SubmissionMode False . Just $ UploadAny True Nothing) False
  insert_ $ SheetEdit gkleen now keine
  void . insertMany $ map (\(u,sf) -> CourseParticipant ffp u now sf)
    [(fhamann   , Nothing)
@ -484,7 +484,7 @@ fillDb = do
    ]
  sh1 <- insert Sheet
    { sheetCourse = pmo
-    , sheetName = "Blatt 1"
+    , sheetName = "Papierabgabe"
    , sheetDescription = Nothing
    , sheetType = Normal $ Points 6
    , sheetGrouping = Arbitrary 3
@ -516,6 +516,60 @@ fillDb = do
  void . insert $ SubmissionUser maxMuster sub1
  sub1fid1 <- insertFile "AbgabeH10-1.hs"
  void . insert $ SubmissionFile sub1 sub1fid1 False False
+  sh2 <- insert Sheet
+    { sheetCourse = pmo
+    , sheetName = "Spezifische Abgabe"
+    , sheetDescription = Nothing
+    , sheetType = Normal $ Points 6
+    , sheetGrouping = Arbitrary 3
+    , sheetMarkingText = Nothing
+    , sheetVisibleFrom = Just now
+    , sheetActiveFrom = now
+    , sheetActiveTo = (14 * nominalDay) `addUTCTime` now
+    , sheetSubmissionMode = SubmissionMode False $ Just UploadSpecific
+      { specificFiles = impureNonNull $ Set.fromList
+        [ UploadSpecificFile "Aufgabe 1" "exercise_2.1.hs" False
+        , UploadSpecificFile "Aufgabe 2" "exercise_2.2.hs" False
+        , UploadSpecificFile "Erklärung der Eigenständigkeit" "erklärung.txt" True
+        ]
+      }
+    , sheetHintFrom = Nothing
+    , sheetSolutionFrom = Nothing
+    , sheetAutoDistribute = True
+    }
+  void . insert $ SheetEdit jost now sh2
+  sh3 <- insert Sheet
+    { sheetCourse = pmo
+    , sheetName = "Dateiendung-eingeschränkte Abgabe"
+    , sheetDescription = Nothing
+    , sheetType = Normal $ Points 6
+    , sheetGrouping = Arbitrary 3
+    , sheetMarkingText = Nothing
+    , sheetVisibleFrom = Just now
+    , sheetActiveFrom = now
+    , sheetActiveTo = (14 * nominalDay) `addUTCTime` now
+    , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny True defaultExtensionRestriction
+    , sheetHintFrom = Nothing
+    , sheetSolutionFrom = Nothing
+    , sheetAutoDistribute = True
+    }
+  void . insert $ SheetEdit jost now sh3
+  sh4 <- insert Sheet
+    { sheetCourse = pmo
+    , sheetName = "Uneingeschränkte Abgabe, einzelne Datei"
+    , sheetDescription = Nothing
+    , sheetType = Normal $ Points 6
+    , sheetGrouping = Arbitrary 3
+    , sheetMarkingText = Nothing
+    , sheetVisibleFrom = Just now
+    , sheetActiveFrom = now
+    , sheetActiveTo = (14 * nominalDay) `addUTCTime` now
+    , sheetSubmissionMode = SubmissionMode False . Just $ UploadAny False Nothing
+    , sheetHintFrom = Nothing
+    , sheetSolutionFrom = Nothing
+    , sheetAutoDistribute = True
+    }
+  void . insert $ SheetEdit jost now sh4
  tut1 <- insert Tutorial
    { tutorialName = "Di08"
    , tutorialCourse = pmo