fixing errors with multiple file upload

This commit is contained in:
nek0 2017-07-25 22:50:09 +02:00
parent 0231e20266
commit 4eb7525050
3 changed files with 49 additions and 55 deletions

View file

@ -313,7 +313,7 @@ writeOnDrive fil userId albumId spec = do
let ac = albumContent album let ac = albumContent album
[PersistInt64 int] <- case spec of [PersistInt64 int] <- case spec of
NewFile -> NewFile ->
if L.null ac then return [PersistInt64 1] else return $ keyToValues $ maximum $ ac if L.null ac then return [PersistInt64 0] else return $ keyToValues $ maximum $ ac
Replace mId -> do Replace mId -> do
medium <- runDB $ getJust mId medium <- runDB $ getJust mId
return $ (PersistInt64 (read $ takeBaseName $ mediumPath medium :: Int64)) : [] return $ (PersistInt64 (read $ takeBaseName $ mediumPath medium :: Int64)) : []
@ -321,7 +321,12 @@ writeOnDrive fil userId albumId spec = do
Replace _ -> 0 Replace _ -> 0
NewFile -> 1 NewFile -> 1
ext = FP.takeExtension $ T.unpack $ fileName fil ext = FP.takeExtension $ T.unpack $ fileName fil
path = "static" FP.</> "data" FP.</> T.unpack (extractKey userId) FP.</> T.unpack (extractKey albumId) FP.</> filen ++ ext path =
"static" FP.</>
"data" FP.</>
T.unpack (extractKey userId) FP.</>
T.unpack (extractKey albumId) FP.</>
filen ++ ext
dde <- liftIO $ doesDirectoryExist $ FP.dropFileName path dde <- liftIO $ doesDirectoryExist $ FP.dropFileName path
if not dde if not dde
then then

View file

@ -61,7 +61,7 @@ postNewAlbumR = do
let newAlbumList = albumId : albumList let newAlbumList = albumId : albumList
runDB $ update userId [UserAlbums =. newAlbumList] runDB $ update userId [UserAlbums =. newAlbumList]
-- create folder -- create folder
liftIO $ createDirectory $ "static" </> "data" </> unpack (extractKey userId) </> unpack (extractKey albumId) liftIO $ createDirectoryIfMissing True $ "static" </> "data" </> unpack (extractKey userId) </> unpack (extractKey albumId)
-- outro -- outro
setMessage "Album successfully created" setMessage "Album successfully created"
redirect $ AlbumR albumId redirect $ AlbumR albumId

View file

@ -76,43 +76,28 @@ postDirectUploadR albumId = do
Just username -> do Just username -> do
(Just (Entity userId user)) <- runDB $ getBy $ UniqueUser username (Just (Entity userId user)) <- runDB $ getBy $ UniqueUser username
if userId == ownerId || userId `elem` albumShares album if userId == ownerId || userId `elem` albumShares album
-- is the logged in user the owner or is the album shared with him -- is the logged in user the owner or is the album shared with him
then do then do
((result, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ dUploadForm userId user albumId ((result, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ dUploadForm userId user albumId
case result of case result of
FormSuccess temp -> do FormSuccess temp -> do
let fils = fileBulkFiles temp onlyErrNames <- handleUploads temp
let indFils = zip [1..] fils if L.null onlyErrNames
errNames <- mapM then do
(handleUpload setMessage "All images succesfully uploaded"
(length indFils) redirect $ AlbumR albumId
(fileBulkAlbum temp) else do
(fileBulkPrefix temp) let msg = toMarkup $
(fileBulkTime temp) "File type not supported of: " `T.append`
(fileBulkOwner temp) (T.intercalate ", " onlyErrNames)
(fileBulkDesc temp) setMessage msg
(fileBulkTags temp) redirect HomeR
(fileBulkLicence temp) _ -> do
NewFile setMessage "There was an error uploading the file"
)indFils redirect $ DirectUploadR albumId
let onlyErrNames = catMaybes errNames else do -- owner is not present
if setMessage "You must own this album to upload"
L.null onlyErrNames redirect $ AlbumR albumId
then do
setMessage "All images succesfully uploaded"
redirect $ AlbumR albumId
else do
let msg = toMarkup $
"File type not supported of: " `T.append`
(T.intercalate ", " onlyErrNames)
setMessage msg
redirect HomeR
_ -> do
setMessage "There was an error uploading the file"
redirect $ DirectUploadR albumId
else do -- owner is not present
setMessage "You must own this album to upload"
redirect $ AlbumR albumId
Nothing -> do Nothing -> do
setMessage "You must be logged in to upload" setMessage "You must be logged in to upload"
redirect $ AlbumR albumId redirect $ AlbumR albumId
@ -201,21 +186,7 @@ postUploadR = do
((result, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ bulkUploadForm userId user ((result, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ bulkUploadForm userId user
case result of case result of
FormSuccess temp -> do FormSuccess temp -> do
let fils = fileBulkFiles temp onlyErrNames <- handleUploads temp
let indFils = zip [1..] fils
errNames <- mapM
(handleUpload
(length indFils)
(fileBulkAlbum temp)
(fileBulkPrefix temp)
(fileBulkTime temp)
(fileBulkOwner temp)
(fileBulkDesc temp)
(fileBulkTags temp)
(fileBulkLicence temp)
NewFile
)indFils
let onlyErrNames = catMaybes errNames
if if
L.null onlyErrNames L.null onlyErrNames
then do then do
@ -233,3 +204,21 @@ postUploadR = do
Nothing -> do Nothing -> do
setMessage "You need to be logged in" setMessage "You need to be logged in"
redirect $ AuthR LoginR redirect $ AuthR LoginR
handleUploads :: FileBulk -> Handler [Text]
handleUploads temp = do
let fils = fileBulkFiles temp
indFils = zip [1..] fils
errNames <- mapM
(handleUpload
(length indFils)
(fileBulkAlbum temp)
(fileBulkPrefix temp)
(fileBulkTime temp)
(fileBulkOwner temp)
(fileBulkDesc temp)
(fileBulkTags temp)
(fileBulkLicence temp)
NewFile
)indFils
return $ catMaybes errNames