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

Fixes #85

Browse Source
This commit is contained in:
Gregor Kleen 2018-10-31 13:20:35 +01:00
parent da5a496e56
commit 3adac1f25b
1 changed files with 17 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -282,26 +282,23 @@ multiFileField :: Handler (Set FileId) -> Field Handler (Source Handler (Either
multiFileField permittedFiles' = Field{..} multiFileField permittedFiles' = Field{..}
where where
fieldEnctype = Multipart fieldEnctype = Multipart
fieldParse vals files fieldParse vals files = return . Right . Just $ do
| null files pVals <- lift permittedFiles'
, null vals = return $ Right Nothing let
| otherwise = return . Right . Just $ do decrypt' :: CryptoUUIDFile -> Handler (Maybe FileId)
pVals <- lift permittedFiles' decrypt' = fmap (either (\(_ :: CryptoIDError) -> Nothing) Just) . try . decrypt
let yieldMany vals
decrypt' :: CryptoUUIDFile -> Handler (Maybe FileId) .| C.filter (/= unpackZips)
decrypt' = fmap (either (\(_ :: CryptoIDError) -> Nothing) Just) . try . decrypt .| C.map fromPathPiece .| C.catMaybes
yieldMany vals .| C.mapMaybeM decrypt'
.| C.filter (/= unpackZips) .| C.filter (`elem` pVals)
.| C.map fromPathPiece .| C.catMaybes .| C.map Left
.| C.mapMaybeM decrypt' let
.| C.filter (`elem` pVals) handleFile :: FileInfo -> Source Handler File
.| C.map Left handleFile
let | doUnpack = sourceFiles
handleFile :: FileInfo -> Source Handler File | otherwise = yieldM . acceptFile
handleFile mapM_ handleFile files .| C.map Right
| doUnpack = sourceFiles
| otherwise = yieldM . acceptFile
mapM_ handleFile files .| C.map Right
where where
doUnpack = unpackZips `elem` vals doUnpack = unpackZips `elem` vals
fieldView fieldId fieldName attrs val req = do fieldView fieldId fieldName attrs val req = do