added direct upload to album page

This commit is contained in:
nek0 2014-08-26 04:39:13 +02:00
parent 7754e321b2
commit 339a8e5b0e
4 changed files with 96 additions and 1 deletions

View file

@ -60,6 +60,80 @@ postUploadR = do
setMessage "You need to be logged in"
redirect $ LoginR
getDirectUploadR :: AlbumId -> Handler Html
getDirectUploadR albumId = do
tempAlbum <- runDB $ get albumId
case tempAlbum of -- does the requested album exist
Just album -> do
ownerId <- return $ albumOwner album
owner <- runDB $ getJust ownerId
ownerName <- return $ userName owner
msu <- lookupSession "userId"
case msu of -- is anybody logged in
Just tempUserId -> do
userId <- return $ getUserIdFromText tempUserId
presence <- return (userId == ownerId)
case presence of -- is the owner present
True -> do
(dUploadWidget, enctype) <- generateFormPost $ dUploadForm userId albumId
defaultLayout $ do
$(widgetFile "dUpload")
False -> do
setMessage "You must own this album to upload"
redirect $ AlbumR albumId
Nothing -> do
setMessage "You must be logged in to upload"
redirect $ LoginR
Nothing -> do
setMessage "This album does not exist"
redirect $ HomeR
postDirectUploadR :: AlbumId -> Handler Html
postDirectUploadR albumId = do
tempAlbum <- runDB $ get albumId
case tempAlbum of -- does the album exist
Just album -> do
ownerId <- return $ albumOwner album
owner <- runDB $ getJust ownerId
ownerName <- return $ userName owner
msu <- lookupSession "userId"
case msu of -- is anybody logged in
Just tempUserId -> do
userId <- return $ getUserIdFromText tempUserId
presence <- return (userId == ownerId)
case presence of -- is the logged in user the owner
True -> do
((result, dUploadWidget), enctype) <- runFormPost (dUploadForm userId albumId)
case result of
FormSuccess temp -> do
path <- writeOnDrive (tempMediumFile temp) userId albumId
medium <- return $ Medium
(tempMediumTitle temp)
('/' : path)
(tempMediumTime temp)
(tempMediumOwner temp)
(tempMediumDesc temp)
(tempMediumTags temp)
albumId
mId <- runDB $ insert medium
inAlbum <- runDB $ getJust albumId
newMediaList <- return $ mId : (albumContent inAlbum)
runDB $ update albumId [AlbumContent =. newMediaList]
setMessage "Image successfully uploaded"
redirect $ AlbumR albumId
_ -> do
setMessage "There was an error uploading the file"
redirect $ DirectUploadR albumId
False -> 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
Nothing -> do
setMessage "This Album does not exist"
redirect $ AlbumR albumId
writeOnDrive :: FileInfo -> UserId -> AlbumId -> Handler FilePath
writeOnDrive file userId albumId = do
filename <- return $ fileName file
@ -85,6 +159,16 @@ uploadForm userId = renderDivs $ TempMedium
entities <- runDB $ selectList [AlbumOwner ==. userId] [Desc AlbumTitle]
optionsPairs $ I.map (\alb -> (albumTitle $ entityVal alb, entityKey alb)) entities
dUploadForm :: UserId -> AlbumId -> Form TempMedium
dUploadForm userId albumId = renderDivs $ TempMedium
<$> areq textField "Title" Nothing
<*> areq fileField "Select file" Nothing
<*> lift (liftIO getCurrentTime)
<*> pure userId
<*> areq textareaField "Description" Nothing
<*> areq tagField "Enter tags" Nothing
<*> pure albumId
tagField :: Field Handler [Text]
tagField = Field
{ fieldParse = \rawVals _ -> do

View file

@ -14,3 +14,4 @@
/newalbum NewAlbumR GET POST
/album/#AlbumId AlbumR GET
/medium/#MediumId MediumR GET
/album/#AlbumId/upload DirectUploadR GET POST

View file

@ -3,7 +3,7 @@ $newline never
by <a href=@{UserR ownerName}>#{ownerName}</a>
<br>
$if presence == True
TODO: direct Upload to this album
<a href=@{DirectUploadR albumId}>Upload image to this album
<br>
$if null media
This album is empty

10
templates/dUpload.hamlet Normal file
View file

@ -0,0 +1,10 @@
<h3>Image upload
Here you can upload your image.
<form method=post enctype=#{enctype}>
^{dUploadWidget}
<div>
<input type=submit value="Upload">