From 98e1141e602b08d422ae0db1d25b24b35e6e3238 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gregor.kleen@ifi.lmu.de>
Date: Thu, 30 Apr 2020 11:08:59 +0200
Subject: [PATCH] feat(generic-file-field): prevent multiple session files of
 same name

---
 src/Handler/Utils/Form.hs | 21 +++++++++++++--------
 1 file changed, 13 insertions(+), 8 deletions(-)

diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index ec3735954..82fea28e1 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -897,9 +897,14 @@ genericFileField mkOpts = Field{..}
     handleUpload mIdent file = do
       for mIdent $ \ident -> do
         now <- liftIO getCurrentTime
+        oldSFIds <- fmap (Set.fromList . map E.unValue) . E.select . E.from $ \sessionFile -> do
+          E.where_ $ E.subSelectForeign sessionFile SessionFileFile (E.^. FileTitle) E.==. E.val (fileTitle file)
+               E.&&. sessionFile E.^. SessionFileTouched E.<=. E.val now
+          return $ sessionFile E.^. SessionFileId
         fId <- insert file
         sfId <- insert $ SessionFile fId now
-        tellSessionJson SessionFiles . MergeHashMap . HashMap.singleton ident $ Set.singleton sfId
+        modifySessionJson SessionFiles $ \(fromMaybe mempty -> MergeHashMap old) ->
+          Just . MergeHashMap $ HashMap.insert ident (Set.insert sfId . maybe Set.empty (`Set.difference` oldSFIds) $ HashMap.lookup ident old) old
         return fId
 
     fieldEnctype = Multipart
@@ -969,17 +974,17 @@ genericFileField mkOpts = Field{..}
       identSecret <- for mIdent $ encodedSecretBox SecretBoxShort
 
       fileInfos <- liftHandler . runDB $ do
+        (uploads, references) <- runWriterT . for val $ \src -> do
+          fmap Set.fromList . sourceToList
+            $ transPipe (lift . lift) src
+           .| C.mapMaybeM (either (\fId -> Nothing <$ tell (Set.singleton fId)) $ lift . handleUpload mIdent)
+
         permittedFiles <- getPermittedFiles mIdent opts
 
         let
-          handleReference fId
-            | fId `Map.member` permittedFiles = return $ Just fId
-            | otherwise = return Nothing
+          sentVals :: Either Text (Set FileId)
+          sentVals = uploads <&> Set.union (references `Set.intersection` Map.keysSet permittedFiles)
 
-        sentVals <- for val $ \src ->
-          fmap Set.fromList . sourceToList
-            $ transPipe lift src
-           .| C.mapMaybeM (either handleReference $ handleUpload mIdent)
         let
           toFUI (E.Value fuiId', E.Value fuiTitle) = do
             fuiId <- encrypt fuiId'