fix(generic-file-field): allow .zip when doUnpack

2020-05-10 22:59:38 +02:00 · 2020-05-10 22:59:38 +02:00 · 46e99081d9
commit 46e99081d9
parent d1f8dc81c3
1 changed files with 4 additions and 1 deletions
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@ -929,8 +929,11 @@ genericFileField mkOpts = Field{..}
        handleFile
          | doUnpack  = sourceFiles
          | otherwise = yieldM . acceptFile
+        invalidUploadExtension fName
+          = not (permittedExtension opts fName)
+         && (not doUnpack || ((/=) `on` simpleContentType) (mimeLookup fName) typeZip)

-      if | invExt : _ <- filter (not . permittedExtension opts) uploadedFilenames
+      if | invExt : _ <- filter invalidUploadExtension uploadedFilenames
           -> do
             liftHandler . runDB . runConduit $
                  mapM_ (transPipe lift . handleFile) files