feat(personalised-sheet-files): finish upload functionality

TODO: Interaction of course participants with personalised files
2020-08-06 09:57:53 +02:00 · 2020-08-06 09:57:53 +02:00 · ed5fb6e218
commit ed5fb6e218
parent c4c952ebc1
18 changed files with 613 additions and 66 deletions
--- a/frontend/src/utils/form/navigate-away-prompt.js
+++ b/frontend/src/utils/form/navigate-away-prompt.js
@ -48,6 +48,10 @@ export class NavigateAwayPrompt {
      return;
    }

+    if (this._element.attributes.target === '_blank') {
+      return;
+    }
+
    // mark initialized
    this._element.classList.add(NAVIGATE_AWAY_PROMPT_INITIALIZED_CLASS);
  }
--- a/messages/uniworx/de-de-formal.msg
+++ b/messages/uniworx/de-de-formal.msg
@ -2686,6 +2686,12 @@ PersonalisedSheetFilesDownloadSurnames: Mit Nachnamen
 PersonalisedSheetFilesDownloadMatriculations: Mit Matrikelnummern
 PersonalisedSheetFilesDownloadGroups: Mit festen Abgabegruppen
 CoursePersonalisedSheetFilesArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-personalisierte_dateien
+PersonalisedSheetFilesArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldedCase shn}-personalisierte_dateien
+PersonalisedSheetFilesMetaFilename uid@CryptoFileNameUser: meta-informationen_#{toPathPiece uid}.yaml
+PersonalisedSheetFilesDownloadAnonymousField: Anonymisierung
+PersonalisedSheetFilesDownloadAnonymousFieldTip: Soll das Archiv von personalisierten Dateien anonymisiert werden (es enthält dann keinerlei sofort persönlich identifizierende Informationen zu den Kursteilnehmern) oder sollen die Verzeichnisnamen mit einem Merkmal versehen werden und die Metainformations-Dateien zusätzlich persönliche Daten enthalten?
+PersonalisedSheetFilesIgnored count@Int64: Es #{pluralDE count "wurde" "wurden"} #{count} hochgeladene #{pluralDE count "Datei" "Dateien"} ignoriert, da sie keinem Übungsblattdatei-Typ oder keinem Kursteilnehmer zugeordnet werden #{pluralDE count "konnte" "konnten"}.
+PersonalisedSheetFilesIgnoredIntro: Es wurden die folgenden Dateien ignoriert:
 AdminCrontabNotGenerated: (Noch) keine Crontab generiert
 CronMatchAsap: ASAP
-CronMatchNone: Nie
+CronMatchNone: Nie
--- a/models/sheets.model
+++ b/models/sheets.model
@ -53,6 +53,7 @@ PersonalisedSheetFile
    content  FileContentReference Maybe
    modified UTCTime
    UniquePersonalisedSheetFile sheet user type title
+    deriving Eq Ord Read Show Generic Typeable

 FallbackPersonalisedSheetFilesKey
    course    CourseId
--- a/package.yaml
+++ b/package.yaml
@ -309,6 +309,7 @@ tests:
      - quickcheck-instances
      - generic-arbitrary
      - http-types
+      - yesod-persistent
    ghc-options:
      - -fno-warn-orphans
      - -threaded
--- a/src/Foundation/I18n.hs
+++ b/src/Foundation/I18n.hs
@ -16,6 +16,7 @@ module Foundation.I18n
  , ErrorResponseTitle(..)
  , UniWorXMessages(..)
  , uniworxMessages
+  , unRenderMessage, unRenderMessage', unRenderMessageLenient
  ) where

 import Foundation.Type
@ -38,6 +39,11 @@ import GHC.Exts (IsList(..))
 import Yesod.Form.I18n.German
 import Yesod.Form.I18n.English

+import qualified Data.Foldable as F
+import qualified Data.Char as Char
+import Text.Unidecode (unidecode)
+import Data.Text.Lens (packed)
+

 appLanguages :: NonEmpty Lang
 appLanguages = "de-de-formal" :| ["en-eu"]
@ -214,6 +220,8 @@ newtype SheetTypeHeader = SheetTypeHeader SheetType
 embedRenderMessageVariant ''UniWorX ''SheetTypeHeader ("SheetType" <>)

 newtype SheetArchiveFileTypeDirectory = SheetArchiveFileTypeDirectory SheetFileType
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving newtype (Enum, Bounded, Universe, Finite)
 embedRenderMessageVariant ''UniWorX ''SheetArchiveFileTypeDirectory $ ("SheetArchiveFileTypeDirectory" <>) . concat . drop 1 . splitCamel

 instance RenderMessage UniWorX SheetType where
@ -355,3 +363,19 @@ instance RenderMessage UniWorX (ValueRequired UniWorX) where
      label = mr label'
      mr :: forall msg. RenderMessage UniWorX msg => msg -> Text
      mr = renderMessage foundation ls
+
+
+unRenderMessage' :: (Eq a, Finite a, RenderMessage master a) => (Text -> Text -> Bool) -> master -> Text -> [a]
+unRenderMessage' cmp foundation inp = nub $ do
+  l <- appLanguages'
+  x <- universeF
+  guard $ renderMessage foundation (l : filter (/= l) appLanguages') x `cmp` inp
+  return x
+  where appLanguages' = F.toList appLanguages
+
+unRenderMessage :: (Eq a, Finite a, RenderMessage master a) => master -> Text -> [a]
+unRenderMessage = unRenderMessage' (==)
+
+unRenderMessageLenient :: (Eq a, Finite a, RenderMessage master a) => master -> Text -> [a]
+unRenderMessageLenient = unRenderMessage' cmp
+  where cmp = (==) `on` mk . under packed (filter Char.isAlphaNum . concatMap unidecode)
--- a/src/Handler/Sheet/Edit.hs
+++ b/src/Handler/Sheet/Edit.hs
@ -98,7 +98,7 @@ handleSheetEdit tid ssh csh msId template dbAction = do
            insertSheetFile' sid SheetMarking  $ fromMaybe (return ()) sfMarkingF
            runConduit $
                 maybe (return ()) (transPipe liftHandler) (spffFiles =<< sfPersonalF)
-              .| sinkPersonalisedSheetFiles cid (Just sid) (fromMaybe False $ spffFilesKeepExisting <$> sfPersonalF)
+              .| sinkPersonalisedSheetFiles cid sid (fromMaybe False $ spffFilesKeepExisting <$> sfPersonalF)
            insert_ $ SheetEdit aid actTime sid
            addMessageI Success $ MsgSheetEditOk tid ssh csh sfName
            -- Sanity checks generating warnings only, but not errors!
--- a/src/Handler/Sheet/Form.hs
+++ b/src/Handler/Sheet/Form.hs
@ -102,9 +102,11 @@ makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateS
    makeSheetPersonalisedFilesForm :: Maybe SheetPersonalisedFilesForm -> MForm Handler (AForm Handler SheetPersonalisedFilesForm)
    makeSheetPersonalisedFilesForm template' = do
      templateDownloadMessage <- runMaybeT . hoist (liftHandler . runDB) $ do
-        Sheet{..} <- MaybeT . fmap join $ traverse get msId
+        mbSheet <- maybe (return Nothing) (fmap Just . hoistMaybe) =<< traverse (lift . get) msId
        Course{..} <- MaybeT $ get cId
-        let downloadRoute = CSheetR courseTerm courseSchool courseShorthand sheetName SPersonalFilesR
+        let downloadRoute = case mbSheet of
+              Just Sheet{..} -> CSheetR courseTerm courseSchool courseShorthand sheetName SPersonalFilesR
+              Nothing -> CourseR courseTerm courseSchool courseShorthand CPersonalFilesR
        guardM $ hasReadAccessTo downloadRoute
        messageIconWidget Info IconFileZip
          [whamlet|
--- a/src/Handler/Sheet/PersonalisedFiles.hs
+++ b/src/Handler/Sheet/PersonalisedFiles.hs
@ -1,16 +1,23 @@
-{-# OPTIONS_GHC -Wno-error=redundant-constraints -Wno-error=unused-top-binds -Wno-error=deprecations #-}
+{-# OPTIONS_GHC -Wno-error=redundant-constraints -Wno-error=unused-top-binds #-}

 module Handler.Sheet.PersonalisedFiles
  ( sinkPersonalisedSheetFiles
  , getSPersonalFilesR, getCPersonalFilesR
  , PersonalisedSheetFilesKeyException(..)
+  , sourcePersonalisedSheetFiles, resolvePersonalisedSheetFiles
+  , PersonalisedSheetFileUnresolved(..)
+  , _PSFUnresolved, _PSFUnresolvedCollatable, _PSFUnresolvedDirectory
  ) where

-import Import
+import Import hiding (StateT(..))

 import Handler.Utils
+import Handler.Sheet.PersonalisedFiles.Meta
+import Handler.Sheet.PersonalisedFiles.Types

 import qualified Data.Conduit.Combinators as C
+import qualified Data.Conduit.List as C (mapMaybeM)
+import Data.Conduit.ResumableSink

 import qualified Crypto.MAC.KMAC as Crypto
 import qualified Data.ByteArray as BA
@ -31,50 +38,149 @@ import qualified Database.Esqueleto as E
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.Text as Text
+import Data.List (inits, tails)
 
 import Text.Unidecode (unidecode)
 import Data.Char (isAlphaNum)

-import GHC.Stack
+import qualified System.FilePath as FilePath (joinPath)
+
+import Control.Monad.Trans.State.Strict (StateT, runStateT)
+import qualified Control.Monad.State as State
+import Control.Monad.Memo (MemoStateT, MonadMemo(..), for2)
+import Utils.Memo
+
+  
+data PersonalisedSheetFileUnresolved a
+  = PSFUnresolvedDirectory a
+  | PSFUnresolvedCollatable Text a
+  | PSFUnresolved a
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+
+makePrisms ''PersonalisedSheetFileUnresolved
+
+
+personalisedSheetFileTypes :: [SheetFileType]
+personalisedSheetFileTypes = filter (/= SheetMarking) universeF

  
 resolvePersonalisedSheetFiles
-  :: forall a m.
+  :: forall m a.
     ( MonadHandler m
     , HandlerSite m ~ UniWorX
+     , MonadCatch m, MonadRandom m
     )
  => Lens' a FilePath
+  -> (a -> Bool) -- ^ @isDirectory@
  -> CourseId
-  -> Maybe SheetId
-  -> ConduitT a (Either a (a, FileReferenceResidual PersonalisedSheetFile)) m ()
-resolvePersonalisedSheetFiles fpL _cid _mbsid = do
-  C.mapM $ \fRef -> maybeT (return $ Left fRef) . fmap (Right . swap) . flip runStateT fRef . zoom fpL $ do
-    error "not implemented" :: StateT FilePath (MaybeT m) (FileReferenceResidual PersonalisedSheetFile)
+  -> SheetId
+  -> ConduitT a (Either (PersonalisedSheetFileUnresolved a) (a, FileReferenceResidual PersonalisedSheetFile)) (SqlPersistT m) ()
+resolvePersonalisedSheetFiles fpL isDir cid sid = do
+  app <- getYesod
+  C.mapM $ \fRef -> exceptT (return . Left . ($ fRef)) (return . Right . swap) . flip runStateT fRef $ do
+    let
+      genRefOptions :: ConduitT () (UserId, SheetFileType, FilePath) (StateT FilePath (ExceptT _ (SqlPersistT m))) ()
+      genRefOptions = evalMemoStateC Map.empty $
+             transPipe lift (yieldMany <=< State.gets $ resolvePersonalisedFilesDirectory app)
+          .| C.mapMaybeM (runMaybeT . filterRefOption)
+          where
+            filterRefOption :: _ -> MaybeT (MemoStateT _ _ _ (StateT FilePath (ExceptT _ (SqlPersistT m)))) (UserId, SheetFileType, FilePath)
+            filterRefOption (mbIdx, cID, sfType, fPath) = hoist (hoistStateCache $ lift . lift) $ do
+                  let
+                    getUid :: _ -> _ -> MemoStateT _ _ _ (SqlPersistT m) (Maybe UserId)
+                    getUid mbIdx' cID' = runMaybeT $ do
+                      cIDKey <- catchMPlus (Proxy @PersonalisedSheetFilesKeyException) . lift . lift $ getPersonalisedFilesKey cid (Just sid) mbIdx'
+                      uid <- either (const mzero) return . (runReaderT ?? cIDKey) $ I.decrypt cID'
+                      guardM . lift . lift $ exists [CourseParticipantUser ==. uid, CourseParticipantCourse ==. cid]
+                      return uid
+                        
+                  fmap (, sfType, fPath) . hoistMaybeM . lift $ for2 memo getUid mbIdx cID
+                  
+    mbRef <- zoom fpL . runConduit $ genRefOptions .| C.head
+    case mbRef of
+      Just (uid, sfType, fPath) -> PersonalisedSheetFileResidual sid uid sfType <$ (fpL .= fPath)
+      Nothing -> do
+        isDirectory <- State.gets isDir
+        if | isDirectory
+             -> lift $ throwE PSFUnresolvedDirectory
+           | otherwise
+             -> lift $ throwE PSFUnresolved
    

 sinkPersonalisedSheetFiles :: forall m.
                              ( MonadHandler m
                              , HandlerSite m ~ UniWorX
+                              , MonadCatch m, MonadRandom m
                              )
                           => CourseId
-                           -> Maybe SheetId
+                           -> SheetId
                           -> Bool -- ^ Keep existing?
                           -> ConduitT FileReference Void (SqlPersistT m) ()
-sinkPersonalisedSheetFiles cid mbsid _keep
-  = resolvePersonalisedSheetFiles _fileReferenceTitle cid mbsid
- .| error "not implemented"
+sinkPersonalisedSheetFiles cid sid keep
+  = resolvePersonalisedSheetFiles _fileReferenceTitle (hasn't $ _fileReferenceContent . _Just) cid sid
+ .| evalRWSC () Map.empty fanoutReferences >>= msgUnreferenced
+ where
+   fanoutReferences = do
+     C.mapM_ $ \case
+       Left unresolved -> tell $ Set.singleton unresolved
+       Right (fRef, residual) -> do
+         let PersonalisedSheetFileResidual{..} = residual
+             redResidual = (personalisedSheetFileResidualSheet, personalisedSheetFileResidualUser)
+         mSinks <- State.gets $ Map.lookup redResidual
+         let mkSinks
+               | Just sinks' <- mSinks
+               = Left sinks'
+               | keep
+               = Right $ \residual' -> newResumableSink $ sinkFileReferences residual'
+               | otherwise
+               = Right $ \residual' -> newResumableSink . void $ replaceFileReferences' mkFilter residual'
+             sinks = case mkSinks of
+               Left sinks' -> sinks'
+               Right mkSinks' -> Map.fromList
+                 [ (residual', mkSinks' residual')
+                 | sfType <- personalisedSheetFileTypes
+                 , let residual' = PersonalisedSheetFileResidual{ personalisedSheetFileResidualType = sfType, .. }
+                 ]
+             sink = Map.findWithDefault (error "No sink for SheetFileType") residual sinks
+         sink' <- lift $ yield fRef ++$$ sink
+         case sink' of
+           Left _ -> error "sinkFileReferences/replaceFileReferences returned prematurely"
+           Right nSink -> State.modify . Map.insert redResidual $ Map.insert residual nSink sinks
+     openSinks <- State.get
+     lift . lift . mapM_ closeResumableSink $ openSinks ^.. folded . folded
+     let (nub -> sinkSheets, nub -> sinkUsers) = unzip $ Map.keys openSinks
+     lift . lift $ deleteWhere [ PersonalisedSheetFileSheet  <-. sinkSheets
+                               , PersonalisedSheetFileUser  /<-. sinkUsers
+                               ]
+
+   msgUnreferenced ((), unreferenced) = unless (null collated && null uncollated) $
+     addMessageModal msgStatus msgTrigger $ Right msgWidget
+     where collated = Map.fromListWith (<>)
+             [ (ptn, Sum 1)
+             | PSFUnresolvedCollatable ptn _fRef <- Set.toList unreferenced
+             ]
+           collatedL = Map.toList collated
+           uncollated = [ fileReferenceTitle | PSFUnresolved FileReference{..} <- Set.toList unreferenced ]
+
+           Sum c = Sum (fromIntegral $ length uncollated) <> fold collated
+
+           msgStatus | null uncollated = Info
+                     | otherwise       = Warning
+
+           msgTrigger = i18n $ MsgPersonalisedSheetFilesIgnored c
+           msgWidget = $(widgetFile "messages/personalisedSheetFilesIgnored")
+
+   mkFilter :: FileReferenceResidual PersonalisedSheetFile -> [Filter PersonalisedSheetFile]
+   mkFilter PersonalisedSheetFileResidual{..} = [ PersonalisedSheetFileSheet ==. personalisedSheetFileResidualSheet
+                                                , PersonalisedSheetFileUser  ==. personalisedSheetFileResidualUser
+                                                , PersonalisedSheetFileType  ==. personalisedSheetFileResidualType
+                                                ]
+
+   sinkFileReferences :: FileReferenceResidual PersonalisedSheetFile -> ConduitT FileReference Void (SqlPersistT m) ()
+   sinkFileReferences residual' = C.mapM_ $ \fRef -> void . put $ _FileReference # (fRef, residual')
+           


-data PersonalisedSheetFilesDownloadAnonymous
-  = PersonalisedSheetFilesDownloadAnonymous
-  | PersonalisedSheetFilesDownloadSurnames
-  | PersonalisedSheetFilesDownloadMatriculations
-  | PersonalisedSheetFilesDownloadGroups
-  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
-  deriving anyclass (Universe, Finite)
-nullaryPathPiece ''PersonalisedSheetFilesDownloadAnonymous $ camelToPathPiece' 4
-embedRenderMessage ''UniWorX ''PersonalisedSheetFilesDownloadAnonymous id
- 
 sourcePersonalisedSheetFiles :: forall m.
                                ( MonadHandler m
                                , HandlerSite m ~ UniWorX
@ -114,9 +220,10 @@ sourcePersonalisedSheetFiles cId mbsid anonMode = do
      E.on $ E.just (courseParticipant E.^. CourseParticipantUser) E.==. personalisedSheetFile E.?. PersonalisedSheetFileUser
       E.&&. E.val mbsid E.==. personalisedSheetFile E.?. PersonalisedSheetFileSheet
      E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. E.val cId
+      E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
      return (courseParticipant, personalisedSheetFile)

-    toRefs = awaitForever $ \(Entity _ CourseParticipant{..}, mbPFile) -> do
+    toRefs = awaitForever $ \(Entity _ cPart@CourseParticipant{..}, mbPFile) -> do
      MsgRenderer mr <- getMsgRenderer
      suffix <- do
        sufCache <- uses _sufCache $ Map.lookup courseParticipantUser
@ -135,16 +242,20 @@ sourcePersonalisedSheetFiles cId mbsid anonMode = do
          , fileModified = courseParticipantRegistration
          }
        forM_ [SheetExercise, SheetHint, SheetSolution] $ \sfType ->
-           yield $ Right File
-            { fileTitle = dirName </> unpack (mr $ SheetArchiveFileTypeDirectory sfType)
+          yield $ Right File
+            { fileTitle = dirName <//> unpack (mr $ SheetArchiveFileTypeDirectory sfType)
            , fileContent = Nothing
            , fileModified = courseParticipantRegistration
            }
-        -- TODO: meta.yml
+        yieldM . fmap Right $ do
+          fileContent <- lift $ Just . toStrict <$> formatPersonalisedSheetFilesMeta anonMode cPart cID
+          let fileTitle = (dirName <//>) . ensureExtension "yaml" . unpack . mr $ MsgPersonalisedSheetFilesMetaFilename cID
+              fileModified = courseParticipantRegistration
+          return File{..}
        _dirCache %= Set.insert dirName
      whenIsJust mbPFile $ \(Entity _ pFile@PersonalisedSheetFile{..}) -> do
-        let dirName' = dirName </> unpack (mr $ SheetArchiveFileTypeDirectory personalisedSheetFileType)
-        yield . Left $ over (_FileReference . _1 . _fileReferenceTitle) (dirName' </>) pFile
+        let dirName' = dirName <//> unpack (mr $ SheetArchiveFileTypeDirectory personalisedSheetFileType)
+        yield . Left $ over (_FileReference . _1 . _fileReferenceTitle) (dirName' <//>) pFile
      where
        _sufCache :: Lens' _ _
        _sufCache = _1
@ -167,7 +278,6 @@ newPersonalisedFilesKey :: forall m.
                           ( MonadHandler m
                           , HandlerSite m ~ UniWorX
                           , MonadThrow m, MonadRandom m
-                           , HasCallStack
                           )
                        => Either CourseId SheetId -> SqlPersistT m (Maybe Word24, CryptoIDKey)
 newPersonalisedFilesKey (Right shId) = cryptoIDKey $ \cIDKey -> fmap (Nothing,) $
@ -178,11 +288,9 @@ newPersonalisedFilesKey (Left cId) = do
  secret <- CryptoID.genKey
  let secret' = toStrict $ Binary.encode secret
  firstN <- getRandom
-  traceM $ "newPersonalisedFilesKey: " <> prettyCallStack callStack

  let loop :: Word24 -> SqlPersistT m (Maybe Word24, CryptoIDKey)
      loop n = do
-        traceM "insertUnique"
        didInsert <- is _Just <$> insertUnique (FallbackPersonalisedSheetFilesKey cId n secret' now)
        if | didInsert
             -> return (Just n, secret)
@ -195,7 +303,12 @@ newPersonalisedFilesKey (Left cId) = do
             -> loop $ succ n
   in loop firstN

-getPersonalisedFilesKey :: CourseId -> Maybe SheetId -> Maybe Word24 -> DB CryptoIDKey
+getPersonalisedFilesKey :: forall m.
+                           ( MonadHandler m
+                           , HandlerSite m ~ UniWorX
+                           , MonadThrow m, MonadRandom m
+                           )
+                        => CourseId -> Maybe SheetId -> Maybe Word24 -> SqlPersistT m CryptoIDKey
 getPersonalisedFilesKey _    Nothing     Nothing   = throwM PersonalisedSheetFilesKeyInsufficientContext
 getPersonalisedFilesKey _   (Just shId)  Nothing   = view _2 <$> newPersonalisedFilesKey (Right shId)
 getPersonalisedFilesKey cId  _          (Just idx) = maybeT (throwM PersonalisedSheetFilesKeyNotFound) $ do
@ -206,15 +319,73 @@ mkPersonalisedFilesDirectory :: Maybe Word24 -> CryptoFileNameUser -> FilePath
 mkPersonalisedFilesDirectory  Nothing cID = unpack $ toPathPiece cID
 mkPersonalisedFilesDirectory (Just idx) cID = unpack $ toPathPiece cID <> "-" <> CI.foldCase (toStrict . encodeBase32Unpadded $ Binary.encode idx)

-resolvePersonalisedFilesDirectory :: FilePath -> [(Maybe Word24, CryptoFileNameUser)]
-resolvePersonalisedFilesDirectory = error "not implemented"
+resolvePersonalisedFilesDirectory :: forall master.
+                                     RenderMessage master SheetArchiveFileTypeDirectory
+                                  => master
+                                  -> FilePath
+                                  -> [(Maybe Word24, CryptoFileNameUser, SheetFileType, FilePath)]
+resolvePersonalisedFilesDirectory foundation (splitPath -> fPath) = do
+  (fPath', remFPath) <- inits fPath `zip` tails fPath
+  guard . not $ null remFPath
+  (SheetArchiveFileTypeDirectory sfType, fPath'') <- foldMap (\(seg, rest) -> (, rest) <$> unRenderMessageLenient foundation (pack seg)) $ foci fPath'
+  guard $ sfType `elem` personalisedSheetFileTypes
+  let cryptSegments = foldMap (filter (not . Text.null) . Text.split (flip Set.notMember cryptChars . CI.mk) . Text.pack) fPath''
+  (mIdx, cryptSegments') <- foldMap (\(inp, rest) -> (, rest) . Just <$> hoistMaybe (decodeIdx inp)) (foci cryptSegments) <|> pure (Nothing, cryptSegments)
+  cID <- foldMap (hoistMaybe . fromPathPiece) cryptSegments'
+  return (mIdx, cID, sfType, FilePath.joinPath remFPath)
+  where
+    foci :: forall a. [a] -> [(a, [a])]
+    foci [] = []
+    foci (x:xs) = (x, xs) : map (over _2 (x:)) (foci xs)
+
+    cryptoIdChars, base32Chars, cryptChars :: Set (CI Char)
+    cryptChars = base32Chars <> cryptoIdChars
+    cryptoIdChars = mappend base32Chars . Set.fromList $ map CI.mk "uwb"
+    base32Chars = Set.fromList $ map CI.mk "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"
+
+    decodeIdx :: Text -> Maybe Word24
+    decodeIdx inp
+      | Right inp' <- decodeBase32Unpadded . fromStrict $ encodeUtf8 inp
+      , Right (remInp, _, idx) <- Binary.decodeOrFail inp'
+      , null remInp
+      = Just idx
+      | otherwise = Nothing
+  


+getPersonalFilesR :: CourseId -> Maybe SheetId -> Handler TypedContent
+getPersonalFilesR cId mbsid = do
+  (Course{..}, mbSheet) <- runDB $ (,)
+    <$> get404 cId
+    <*> traverse get404 mbsid
+  
+  cRoute <- getCurrentRoute
+  ((anonRes, anonFormWdgt), anonEnctype) <- runFormGet . renderAForm FormStandard $
+    apopt (selectField optionsFinite) (fslI MsgPersonalisedSheetFilesDownloadAnonymousField & setTooltip MsgPersonalisedSheetFilesDownloadAnonymousFieldTip) (Just PersonalisedSheetFilesDownloadAnonymous)
+  
+  formResult anonRes $ \anonMode -> do
+    archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack) . ap getMessageRender . pure $ case mbSheet of
+      Nothing -> MsgCoursePersonalisedSheetFilesArchiveName courseTerm courseSchool courseShorthand
+      Just Sheet{..} -> MsgPersonalisedSheetFilesArchiveName courseTerm courseSchool courseShorthand sheetName
+    sendResponse <=< serveZipArchive' archiveName $ sourcePersonalisedSheetFiles cId mbsid anonMode
+  
+  isModal <- hasCustomHeader HeaderIsModal
+
+  fmap toTypedContent . siteLayoutMsg MsgMenuSheetPersonalisedFiles $ do
+    setTitleI MsgMenuSheetPersonalisedFiles
+    wrapForm anonFormWdgt def
+      { formMethod = GET
+      , formAction = SomeRoute <$> cRoute
+      , formEncoding = anonEnctype
+      , formAttrs = formAttrs def <> bool mempty [("uw-no-navigate-away-prompt", ""), ("target", "_blank")] isModal
+      }
+  
 getSPersonalFilesR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler TypedContent
-getSPersonalFilesR = error "not implemented"
+getSPersonalFilesR tid ssh csh shn = do
+  Entity shId Sheet{..} <- runDB $ fetchSheet tid ssh csh shn
+  getPersonalFilesR sheetCourse $ Just shId

 getCPersonalFilesR :: TermId -> SchoolId -> CourseShorthand -> Handler TypedContent
 getCPersonalFilesR tid ssh csh = do
  cId <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh
-  archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack) . ap getMessageRender . pure $ MsgCoursePersonalisedSheetFilesArchiveName tid ssh csh
-  serveZipArchive' archiveName $ sourcePersonalisedSheetFiles cId Nothing PersonalisedSheetFilesDownloadAnonymous -- TODO: get Form for anonymisiation
+  getPersonalFilesR cId Nothing
--- a/src/Handler/Sheet/PersonalisedFiles/Meta.hs
+++ b/src/Handler/Sheet/PersonalisedFiles/Meta.hs
@ -0,0 +1,131 @@
+{-# OPTIONS_GHC -Wno-error=redundant-constraints #-}
+
+module Handler.Sheet.PersonalisedFiles.Meta
+  ( formatPersonalisedSheetFilesMeta
+  ) where
+
+import Import
+
+import Handler.Sheet.PersonalisedFiles.Types
+
+import qualified Data.Char as Char
+import qualified Data.Text as Text
+import qualified Data.ByteString.Lazy as Lazy (ByteString)
+import qualified Data.ByteString.Lazy as Lazy.ByteString
+
+import qualified Data.YAML as YAML
+import qualified Data.YAML.Event as YAML (untagged)
+import qualified Data.YAML.Event as YAML.Event
+import qualified Data.YAML.Token as YAML (Encoding(..))
+
+import Control.Monad.Trans.State.Lazy (evalState)
+
+import qualified Database.Esqueleto as E
+
+import qualified Data.CaseInsensitive as CI
+
+  
+data PrettifyState
+  = PrettifyInitial
+  | PrettifyFlowSequence PrettifyState
+  | PrettifyBlockSequence PrettifyState
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+
+  
+formatPersonalisedSheetFilesMeta
+  :: ( MonadHandler m
+     , HandlerSite m ~ UniWorX
+     )
+  => PersonalisedSheetFilesDownloadAnonymous
+  -> CourseParticipant
+  -> CryptoFileNameUser
+  -> SqlPersistT m Lazy.ByteString
+formatPersonalisedSheetFilesMeta anonMode CourseParticipant{..} cID = do
+  User{..} <- getJust courseParticipantUser
+  exams <- E.select . E.from $ \(exam `E.InnerJoin` examRegistration) -> E.distinctOnOrderBy [E.asc $ exam E.^. ExamName] $ do
+    E.on $ exam E.^. ExamId E.==. examRegistration E.^. ExamRegistrationExam
+    E.where_ $ exam E.^. ExamCourse E.==. E.val courseParticipantCourse
+    E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val courseParticipantUser
+    return $ exam E.^. ExamName
+  
+  let uglyYAML = YAML.Event.writeEvents YAML.UTF8 $ concat
+        [ [ YAML.Event.StreamStart
+          , YAML.Event.DocumentStart $ YAML.Event.DirEndMarkerVersion 2
+          , YAML.Event.MappingStart Nothing YAML.untagged YAML.Event.Block
+          ]
+        , mapEvents (str' "user") (str $ toPathPiece cID)
+        , guardOnM (isn't _PersonalisedSheetFilesDownloadAnonymous anonMode) $ concat
+          [ mapEvents (str' "display_name") (str userDisplayName)
+          , mapEvents (str' "surname") (str userSurname)
+          , mapEvents (str' "first_names") (str userFirstName)
+          , case userMatrikelnummer of
+              Just matr -> mapEvents (str' "matriculation") (str matr)
+              Nothing -> mzero
+          , mapEvents (str' "email") (str $ CI.original userEmail)
+          ]
+        , map flowStyle $ mapEvents (str' "languages") . YAML.Sequence () YAML.untagged $ maybe [] (views _Wrapped $ map str) userLanguages
+        , mapEvents (str' "registered_exams") . YAML.Sequence () YAML.untagged $ map (str . CI.original . E.unValue) exams
+        , [ YAML.Event.MappingEnd
+          , YAML.Event.DocumentEnd False
+          , YAML.Event.StreamEnd
+          ]
+        ]
+        where
+          str :: forall t. Textual t => t -> YAML.Node ()
+          str = YAML.Scalar () . YAML.SStr . repack
+          str' :: Text -> YAML.Node ()
+          str' = str
+
+          mapEvents :: YAML.Node () -> YAML.Node () -> [YAML.Event.Event]
+          mapEvents k v = filterEvs . nodeEvents . YAML.Mapping () YAML.untagged $ singletonMap k v
+            where filterEvs ((YAML.Event.MappingStart{} : inner) :> YAML.Event.MappingEnd) = inner
+                  filterEvs _other = error "Could not strip Mapping"
+
+          nodeEvents :: YAML.Node () -> [YAML.Event.Event]
+          nodeEvents = filterEvs . mapMaybe (fmap YAML.Event.eEvent . preview _Right) . YAML.Event.parseEvents . YAML.encodeNode . pure . YAML.Doc
+            where filterEvs = filter $ \case
+                    YAML.Event.StreamStart -> False
+                    YAML.Event.StreamEnd -> False
+                    YAML.Event.DocumentStart _ -> False
+                    YAML.Event.DocumentEnd _ -> False
+                    _other -> True
+
+          flowStyle :: YAML.Event.Event -> YAML.Event.Event
+          flowStyle = \case
+            YAML.Event.SequenceStart a t _ -> YAML.Event.SequenceStart a t YAML.Event.Flow
+            YAML.Event.MappingStart a t _ -> YAML.Event.MappingStart a t YAML.Event.Flow
+            other -> other
+
+      prettyYAML = annotate . (evalState ?? PrettifyInitial) . transduce' $ YAML.Event.parseEvents uglyYAML
+        where
+          transduce' (Left _ : _) = error "Parse error on uglyYAML"
+          transduce' (Right YAML.Event.EvPos{ eEvent, ePos = pos1 } : es@(Right YAML.Event.EvPos{ ePos = pos2 }: _))
+            = (:) <$> ((YAML.Event.posByteOffset pos1, YAML.Event.posByteOffset pos2, ) <$> state (`transduce` eEvent)) <*> transduce' es
+          transduce' (Right YAML.Event.EvPos{..} : es)
+            = (:) <$> ((YAML.Event.posByteOffset ePos, fromIntegral $ Lazy.ByteString.length uglyYAML, ) <$> state (`transduce` eEvent)) <*> transduce' es
+          transduce' [] = return []
+
+          annotate = fst . foldl' annotate' (uglyYAML, Lazy.ByteString.length uglyYAML) . reverse
+            where annotate' (dat, mLength) (fromIntegral -> pos1, fromIntegral -> pos2, (fromStrict . encodeUtf8 -> ann1, ann3, ann2))
+                    = let (before', after) = Lazy.ByteString.splitAt pos2' dat
+                          (before, event) = Lazy.ByteString.splitAt pos1' before'
+                          event' = decodeUtf8 $ toStrict event
+                          ws = Text.takeWhileEnd Char.isSpace event'
+                          event'' = Text.dropWhileEnd Char.isSpace event'
+                          pos1' = min pos1 mLength
+                          pos2' = min pos2 mLength
+                       in (before <> ann1 <> fromStrict (encodeUtf8 $ ann3 event'') <> fromStrict (encodeUtf8 $ ann2 ws) <> after, pos1')
+
+          transduce :: PrettifyState -> YAML.Event.Event -> ((Text, Text -> Text, Text -> Text), PrettifyState)
+          transduce cState (YAML.Event.SequenceStart _ _ YAML.Event.Flow) = ((mempty, id, bool " " mempty . null), PrettifyFlowSequence cState)
+          transduce (PrettifyFlowSequence pState) YAML.Event.SequenceEnd = ((mempty, id, id), pState)
+          transduce cState@(PrettifyFlowSequence _) _ = ((mempty, f, bool " " mempty . null), cState)
+            where f str | ']' `elem` str = filter (/= '\n') str
+                        | otherwise = str
+          -- transduce PrettifyInitial _ = ((mempty, id), PrettifyInitial)
+          transduce cState (YAML.Event.SequenceStart _ _ YAML.Event.Block) = (("  ", id, id), PrettifyBlockSequence cState)
+          transduce (PrettifyBlockSequence pState) YAML.Event.SequenceEnd = ((mempty, id, id), pState)
+          transduce cState@(PrettifyBlockSequence _) _ = ((mempty, Text.replace "\n-" "\n  -", id), cState)
+          transduce cState _ = ((mempty, id, id), cState)
+          -- transduce cState _ = (("<", id, \ws -> "|" <> ws <> ">"), cState) -- TODO
+  return prettyYAML
--- a/src/Handler/Sheet/PersonalisedFiles/Types.hs
+++ b/src/Handler/Sheet/PersonalisedFiles/Types.hs
@ -0,0 +1,19 @@
+module Handler.Sheet.PersonalisedFiles.Types
+  ( PersonalisedSheetFilesDownloadAnonymous(..)
+  , _PersonalisedSheetFilesDownloadAnonymous, _PersonalisedSheetFilesDownloadSurnames, _PersonalisedSheetFilesDownloadMatriculations, _PersonalisedSheetFilesDownloadGroups
+  ) where
+
+import Import
+
+
+data PersonalisedSheetFilesDownloadAnonymous
+  = PersonalisedSheetFilesDownloadAnonymous
+  | PersonalisedSheetFilesDownloadSurnames
+  | PersonalisedSheetFilesDownloadMatriculations
+  | PersonalisedSheetFilesDownloadGroups
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+  deriving anyclass (Universe, Finite)
+nullaryPathPiece ''PersonalisedSheetFilesDownloadAnonymous $ camelToPathPiece' 4
+embedRenderMessage ''UniWorX ''PersonalisedSheetFilesDownloadAnonymous id
+
+makePrisms ''PersonalisedSheetFilesDownloadAnonymous
--- a/src/Handler/Utils/Rating.hs
+++ b/src/Handler/Utils/Rating.hs
@ -101,7 +101,6 @@ ratingFile cID rating@Rating{ ratingValues = Rating'{..}, .. } = do
    fileTitle = ensureExtension extensionRating . unpack . mr $ MsgRatingFileTitle cID
    fileContent = Just . Lazy.ByteString.toStrict $ formatRating mr' dtFmt cID rating
  return File{..}
-  where ensureExtension ext fName = bool (`addExtension` ext) id (ext `isExtensionOf` fName) fName

 type SubmissionContent = Either FileReference (SubmissionId, Rating')

@ -162,4 +161,3 @@ isRatingFile (takeFileName -> fName) = liftHandler . runMaybeT $ do
      let canonExtension = Set.singleton $ CI.mk (pack extensionRating)
          validExtensions = foldMap (Set.map CI.mk . mimeExtensions) ["application/json", "text/vnd.yaml"]
      guard $ extension `Set.member` Set.union canonExtension validExtensions
-      where ensureExtension ext fName' = bool (`addExtension` ext) id (ext `isExtensionOf` fName') fName'
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@ -1094,7 +1094,6 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
      | Just DBTCsvEncode{..} <- dbtCsvEncode
      , Just exportData <- fromDynamic dbCsvExportData -> do
        hdr <- dbtCsvHeader $ Just exportData
-        let ensureExtension ext fName = bool (`addExtension` ext) id (ext `isExtensionOf` fName) fName
        dbtCsvName' <- timestampCsv <*> pure dbtCsvName
        setContentDisposition' . Just $ ensureExtension (unpack extensionCsv) dbtCsvName'
        sendResponse <=< liftHandler . respondCsvDB hdr $ C.sourceList (zip currentKeys rows) .| dbtCsvDoEncode exportData >> lift E.transactionSave
--- a/src/Model.hs
+++ b/src/Model.hs
@ -57,6 +57,7 @@ instance ToMessage (Key Term) where
 instance HasFileReference CourseApplicationFile where
  newtype FileReferenceResidual CourseApplicationFile
    = CourseApplicationFileResidual { courseApplicationFileResidualApplication :: CourseApplicationId }
+    deriving (Eq, Ord, Read, Show, Generic, Typeable)

  _FileReference
    = iso (\CourseApplicationFile{..} -> ( FileReference
@ -84,6 +85,7 @@ instance HasFileReference CourseApplicationFile where
 instance HasFileReference CourseAppInstructionFile where
  newtype FileReferenceResidual CourseAppInstructionFile
    = CourseAppInstructionFileResidual { courseAppInstructionFileResidualCourse :: CourseId }
+    deriving (Eq, Ord, Read, Show, Generic, Typeable)

  _FileReference
    = iso (\CourseAppInstructionFile{..} -> ( FileReference
@ -112,7 +114,7 @@ instance HasFileReference SheetFile where
  data FileReferenceResidual SheetFile = SheetFileResidual
    { sheetFileResidualSheet :: SheetId
    , sheetFileResidualType :: SheetFileType
-    }
+    } deriving (Eq, Ord, Read, Show, Generic, Typeable)

  _FileReference
    = iso (\SheetFile{..} -> ( FileReference
@ -146,7 +148,7 @@ instance HasFileReference PersonalisedSheetFile where
    { personalisedSheetFileResidualSheet :: SheetId
    , personalisedSheetFileResidualUser :: UserId
    , personalisedSheetFileResidualType :: SheetFileType
-    }
+    } deriving (Eq, Ord, Read, Show, Generic, Typeable)

  _FileReference
    = iso (\PersonalisedSheetFile{..} -> ( FileReference
@ -182,7 +184,7 @@ instance HasFileReference SubmissionFile where
    { submissionFileResidualSubmission :: SubmissionId
    , submissionFileResidualIsUpdate
    , submissionFileResidualIsDeletion :: Bool
-    }
+    } deriving (Eq, Ord, Read, Show, Generic, Typeable)

  _FileReference
    = iso (\SubmissionFile{..} -> ( FileReference
@ -216,6 +218,7 @@ instance HasFileReference SubmissionFile where
 instance HasFileReference CourseNewsFile where
  newtype FileReferenceResidual CourseNewsFile
    = CourseNewsFileResidual { courseNewsFileResidualNews :: CourseNewsId }
+    deriving (Eq, Ord, Read, Show, Generic, Typeable)

  _FileReference
    = iso (\CourseNewsFile{..} -> ( FileReference
@ -241,9 +244,9 @@ instance HasFileReference CourseNewsFile where
  fileReferenceModifiedField = CourseNewsFileModified

 instance HasFileReference MaterialFile where
-  data FileReferenceResidual MaterialFile = MaterialFileResidual
-    { materialFileResidualMaterial :: MaterialId
-    }
+  newtype FileReferenceResidual MaterialFile
+    = MaterialFileResidual { materialFileResidualMaterial :: MaterialId }
+    deriving (Eq, Ord, Read, Show, Generic, Typeable)

  _FileReference
    = iso (\MaterialFile{..} -> ( FileReference
--- a/src/Utils.hs
+++ b/src/Utils.hs
@ -109,6 +109,9 @@ import qualified Data.Text.Lazy.Builder as Builder

 import Unsafe.Coerce

+import System.FilePath as Utils (addExtension, isExtensionOf)
+import System.FilePath (dropDrive)
+
 {-# ANN module ("HLint: ignore Use asum" :: String) #-}


@ -440,6 +443,23 @@ dropWhileM p xs'
  = bool (return xs') (dropWhileM p xs) =<< p x
  | otherwise = return xs'

+
+isSubsequenceOfBy :: (a -> b -> Bool) -> [a] -> [b] -> Bool
+isSubsequenceOfBy _   []       _     = True
+isSubsequenceOfBy _   _        []    = False
+isSubsequenceOfBy cmp a@(x:a') (y:b)
+  | x `cmp` y = isSubsequenceOfBy cmp a' b
+  | otherwise = isSubsequenceOfBy cmp a  b
+
+withoutSubsequenceBy :: (a -> b -> Bool) -> [a] -> [b] -> Maybe [b]
+withoutSubsequenceBy cmp = go []
+  where go acc []       b     = Just $ reverse acc ++ b
+        go _   _        []    = Nothing
+        go acc a@(x:a') (y:b)
+          | x `cmp` y = go acc a' b
+          | otherwise = go (y:acc) a b
+        
+
 ----------
 -- Sets --
 ----------
@ -1192,3 +1212,15 @@ instance (Eq k, Hashable k, FromJSON v, FromJSONKey k, Semigroup v) => FromJSON

      parseJSONElemAtIndex :: (Value -> Aeson.Parser a) -> Int -> Vector Value -> Aeson.Parser a
      parseJSONElemAtIndex p idx ary = p (V.unsafeIndex ary idx) Aeson.<?> Aeson.Index idx
+
+--------------
+-- FilePath --
+--------------
+
+ensureExtension :: String -> FilePath -> FilePath
+ensureExtension ext fName = bool (`addExtension` ext) id (ext `isExtensionOf` fName) fName
+
+infixr 4 <//>
+
+(<//>) :: FilePath -> FilePath -> FilePath
+dir <//> file = dir </> dropDrive file
--- a/src/Utils/Files.hs
+++ b/src/Utils/Files.hs
@ -2,7 +2,7 @@ module Utils.Files
  ( sinkFile, sinkFiles
  , sinkFile', sinkFiles'
  , FileUploads
-  , replaceFileReferences
+  , replaceFileReferences, replaceFileReferences'
  ) where

 import Import.NoFoundation
@ -19,7 +19,6 @@ import qualified Data.ByteArray as ByteArray

 import qualified Data.Map.Lazy as Map
 import qualified Data.Set as Set
-import Control.Monad.Trans.State.Lazy (execStateT)
 import Control.Monad.State.Class (modify)

 import Database.Persist.Sql (deleteWhereCount)
@ -81,19 +80,17 @@ sinkFile' file residual = do

 type FileUploads = ConduitT () FileReference (HandlerFor UniWorX) ()

-replaceFileReferences :: ( MonadHandler m, MonadThrow m
-                         , HandlerSite m ~ UniWorX
-                         , HasFileReference record
-                         , PersistEntityBackend record ~ SqlBackend
-                         )
-                      => (FileReferenceResidual record -> [Filter record])
-                      -> FileReferenceResidual record
-                      -> FileUploads
-                      -> SqlPersistT m (Set (Key record), Set (Key record)) -- ^ @(oldFiles, changes)@
-replaceFileReferences mkFilter residual fs = do
+replaceFileReferences' :: ( MonadIO m, MonadThrow m
+                          , HasFileReference record
+                          , PersistEntityBackend record ~ SqlBackend
+                          )
+                       => (FileReferenceResidual record -> [Filter record])
+                       -> FileReferenceResidual record
+                       -> ConduitT FileReference Void (SqlPersistT m) (Set (Key record), Set (Key record)) -- ^ @(oldFiles, changes)@
+replaceFileReferences' mkFilter residual = do
  let resFilter = mkFilter residual

-  oldFiles <- Map.fromListWith Set.union . map (\(Entity k v) -> (v ^. _FileReference . _1, Set.singleton k)) <$> selectList resFilter []
+  oldFiles <- lift $ Map.fromListWith Set.union . map (\(Entity k v) -> (v ^. _FileReference . _1, Set.singleton k)) <$> selectList resFilter []
  let oldFiles' = setOf (folded . folded) oldFiles

  let
@ -111,8 +108,19 @@ replaceFileReferences mkFilter residual fs = do
          fId <- lift $ insert fRef'
          modify $ Map.alter (Just . maybe (Set.singleton fId) (Set.insert fId)) fRef

-  changes <- fmap (setOf $ folded . folded) . flip execStateT oldFiles . runConduit $ transPipe liftHandler fs .| C.mapM_ finsert
+  changes <- fmap (setOf $ folded . folded) . execStateC oldFiles $ C.mapM_ finsert

-  deleteWhere $ resFilter <> [ persistIdField <-. Set.toList (oldFiles' `Set.intersection` changes) ]
+  lift . deleteWhere $ resFilter <> [ persistIdField <-. Set.toList (oldFiles' `Set.intersection` changes) ]

  return (oldFiles', changes)
+
+replaceFileReferences :: ( MonadHandler m, MonadThrow m
+                         , HandlerSite m ~ UniWorX
+                         , HasFileReference record
+                         , PersistEntityBackend record ~ SqlBackend
+                         )
+                      => (FileReferenceResidual record -> [Filter record])
+                      -> FileReferenceResidual record
+                      -> FileUploads
+                      -> SqlPersistT m (Set (Key record), Set (Key record)) -- ^ @(oldFiles, changes)@
+replaceFileReferences mkFilter residual fs = runConduit $ transPipe liftHandler fs .| replaceFileReferences' mkFilter residual
--- a/src/Utils/Memo.hs
+++ b/src/Utils/Memo.hs
@ -0,0 +1,25 @@
+module Utils.Memo
+  ( evalMemoStateC
+  ) where
+
+import ClassyPrelude
+import Data.Conduit
+import Data.Conduit.Lift (evalStateC)
+
+import Control.Monad.Memo
+import Control.Monad.Trans.State.Strict (StateT)
+import qualified Control.Monad.State.Class as State
+
+
+evalMemoStateC :: forall m s k v i o r.
+                  Monad m
+               => s -> ConduitT i o (MemoStateT s k v m) r -> ConduitT i o m r
+evalMemoStateC initSt = evalStateC initSt . transPipe runMemoStateT'
+  where
+    runMemoStateT' :: forall a.
+                      MemoStateT s k v m a
+                   -> StateT s m a
+    runMemoStateT' act = do
+          cache <- State.get
+          (res, cache') <- lift $ runMemoStateT act cache
+          res <$ State.put cache'
--- a/templates/messages/personalisedSheetFilesIgnored.hamlet
+++ b/templates/messages/personalisedSheetFilesIgnored.hamlet
@ -0,0 +1,9 @@
+$newline never
+_{MsgPersonalisedSheetFilesIgnoredIntro}
+<ul>
+  $forall fPath <- uncollated
+    <li>
+      #{fPath}
+  $forall (ptn, Sum count) <- toList collatedL
+    <li>
+      #{count} × #{ptn}
--- a/test/Handler/Sheet/PersonalisedFilesSpec.hs
+++ b/test/Handler/Sheet/PersonalisedFilesSpec.hs
@ -0,0 +1,114 @@
+module Handler.Sheet.PersonalisedFilesSpec where
+
+import TestImport
+
+import Utils.Files
+import Handler.Sheet.PersonalisedFiles
+import Handler.Sheet.PersonalisedFiles.Types
+
+import qualified Yesod.Persist as Yesod
+
+import ModelSpec ()
+
+import Data.Universe.Class
+
+import Data.Conduit
+import qualified Data.Conduit.Combinators as C
+import Control.Lens.Extras
+import Control.Monad.Trans.Maybe
+  
+import qualified Crypto.Hash as Crypto (hash)
+
+import System.FilePath (dropDrive)
+
+import Data.Time.Clock (diffUTCTime)
+import Data.Char (chr)
+
+import Database.Persist.Sql (transactionUndo)
+
+
+instance Arbitrary (FileReferenceResidual PersonalisedSheetFile) where
+  arbitrary = PersonalisedSheetFileResidual
+    <$> arbitrary
+    <*> arbitrary
+    <*> elements [ sfType | sfType <- universeF, sfType /= SheetMarking ]
+
+instance Arbitrary PersonalisedSheetFilesDownloadAnonymous where
+  arbitrary = elements universeF
+
+
+spec :: Spec
+spec = withApp . focus . describe "Personalised sheet file zip encoding" $ do
+  it "roundtrips" . replicateM_ 10 . runHandler . Yesod.runDB $ do
+    term <- liftIO $ generate arbitrary
+    tid <- insert term
+    school <- liftIO $ generate arbitrary
+    ssh <- insert school
+    course <- liftIO $ generate arbitrary <&> \c -> c { courseTerm = tid, courseSchool = ssh }
+    cid <- insert course
+    sheet <- liftIO $ generate arbitrary <&> \s -> s { sheetCourse = cid }
+    shid <- insert sheet
+
+    sheetFiles' <- liftIO . generate . listOf $ scale (`div` 2) arbitrary
+    sheetFiles <- fmap catMaybes . forM sheetFiles' $ \(f', res') -> runMaybeT $ do
+      let f = f' { fileTitle = filter (/= chr 0) $ fileTitle f' } -- PostgreSQL doesn't like to store NUL-bytes in text
+      guard . not . null . dropDrive $ fileTitle f
+      
+      uid <-
+        let userLoop = do
+              user <- liftIO $ generate arbitrary
+              lift (insertUnique user) >>= maybe userLoop return
+         in userLoop
+      let res = res' { personalisedSheetFileResidualSheet = shid, personalisedSheetFileResidualUser = uid }
+      fRef <- lift (sinkFile f :: DB FileReference)
+      now <- liftIO getCurrentTime
+      void . lift . insert $ CourseParticipant cid (personalisedSheetFileResidualUser res) now Nothing Nothing CourseParticipantActive
+      void . lift . insert $ _FileReference # (fRef, res)
+      return (f, res)
+
+    anonMode <- liftIO $ generate arbitrary
+
+    let
+      fpL :: Lens' (Either PersonalisedSheetFile File) FilePath
+      fpL = lens (either personalisedSheetFileTitle fileTitle) $ \f' path -> case f' of
+        Left pf -> Left pf { personalisedSheetFileTitle = path }
+        Right f -> Right f { fileTitle = path }
+      isDirectory = either (is _Nothing . personalisedSheetFileContent) (is _Nothing . fileContent)
+
+    recoveredFiles <- runConduit $
+         sourcePersonalisedSheetFiles cid (Just shid) anonMode
+      .| resolvePersonalisedSheetFiles fpL isDirectory cid shid
+      .| C.foldMap pure
+
+    let
+      checkFile :: Either (PersonalisedSheetFileUnresolved (Either PersonalisedSheetFile File)) (Either PersonalisedSheetFile File, FileReferenceResidual PersonalisedSheetFile)
+                -> (File, FileReferenceResidual PersonalisedSheetFile)
+                -> Bool
+      checkFile (Left _) _
+        = False
+      checkFile (Right (recFile, recResidual)) (file, residual)
+        =    recResidual == residual
+          && case recFile of
+               Right f -> file == f
+               Left pf ->    dropDrive (fileTitle file) == dropDrive (personalisedSheetFileTitle pf)
+                          && abs (fileModified file `diffUTCTime` personalisedSheetFileModified pf) < 1e-6 -- Precision is a PostgreSQL limitation
+                          && fmap Crypto.hash (fileContent file) == personalisedSheetFileContent pf
+
+      errors = go [] sheetFiles recoveredFiles
+        where go acc xs [] = reverse acc ++ map Left xs
+              go acc [] ys = reverse acc ++ map Right ys
+              go acc xs (y:ys)
+                | (xs', _ : xs'') <- break (checkFile y) xs
+                = go acc (xs' ++ xs'') ys
+                | is (_Left . _PSFUnresolved) y
+                , fromMaybe False $ previews (_Left . _PSFUnresolved . _Right . _fileTitle) ("meta-informationen" `isInfixOf`) y -- DEBUG; remove once _PSFUnresolvedCollatable works
+                = go acc xs ys
+                | isn't (_Left . _PSFUnresolved) y
+                , isn't _Right y
+                = go acc xs ys
+                | otherwise       = go (Right y : acc) xs ys
+
+    unless (null errors) . liftIO $ 
+      expectationFailure $ show recoveredFiles ++ " does not match " ++ show sheetFiles ++ ": " ++ show errors
+
+    transactionUndo