fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(generic-file-field): prevent multiple session files of same name

Browse Source
This commit is contained in:
Gregor Kleen 2020-04-30 11:08:59 +02:00
parent 192b6279d3
commit 98e1141e60
1 changed files with 13 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
src/Handler/Utils/Form.hs
View File

@ -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'