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
[PersistInt64 int] <- case spec of
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
medium <- runDB $ getJust mId
return $ (PersistInt64 (read $ takeBaseName $ mediumPath medium :: Int64)) : []
@ -321,7 +321,12 @@ writeOnDrive fil userId albumId spec = do
Replace _ -> 0
NewFile -> 1
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
if not dde
then

View File

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

View File

@ -76,43 +76,28 @@ postDirectUploadR albumId = do
Just username -> do
(Just (Entity userId user)) <- runDB $ getBy $ UniqueUser username
if userId == ownerId || userId `elem` albumShares album
-- is the logged in user the owner or is the album shared with him
then do
((result, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ dUploadForm userId user albumId
case result of
FormSuccess temp -> do
let fils = fileBulkFiles 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
L.null onlyErrNames
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
-- is the logged in user the owner or is the album shared with him
then do
((result, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ dUploadForm userId user albumId
case result of
FormSuccess temp -> do
onlyErrNames <- handleUploads temp
if L.null onlyErrNames
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
setMessage "You must be logged in to upload"
redirect $ AlbumR albumId
@ -201,21 +186,7 @@ postUploadR = do
((result, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ bulkUploadForm userId user
case result of
FormSuccess temp -> do
let fils = fileBulkFiles 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
onlyErrNames <- handleUploads temp
if
L.null onlyErrNames
then do
@ -233,3 +204,21 @@ postUploadR = do
Nothing -> do
setMessage "You need to be logged in"
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