From 4eb7525050044ddb0d9e2e39b57fc215ad19ba95 Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 25 Jul 2017 22:50:09 +0200 Subject: [PATCH] fixing errors with multiple file upload --- Handler/Commons.hs | 9 ++++- Handler/NewAlbum.hs | 2 +- Handler/Upload.hs | 93 ++++++++++++++++++++------------------------- 3 files changed, 49 insertions(+), 55 deletions(-) diff --git a/Handler/Commons.hs b/Handler/Commons.hs index ef2d1ac..4552674 100755 --- a/Handler/Commons.hs +++ b/Handler/Commons.hs @@ -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 diff --git a/Handler/NewAlbum.hs b/Handler/NewAlbum.hs index e34b4db..a4594ce 100755 --- a/Handler/NewAlbum.hs +++ b/Handler/NewAlbum.hs @@ -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 diff --git a/Handler/Upload.hs b/Handler/Upload.hs index 0720467..5780154 100755 --- a/Handler/Upload.hs +++ b/Handler/Upload.hs @@ -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