diff --git a/Handler/Upload.hs b/Handler/Upload.hs
index 0bb74a4..5e9acc2 100644
--- a/Handler/Upload.hs
+++ b/Handler/Upload.hs
@@ -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
diff --git a/config/routes b/config/routes
index a2373ad..74aa89a 100644
--- a/config/routes
+++ b/config/routes
@@ -14,3 +14,4 @@
/newalbum NewAlbumR GET POST
/album/#AlbumId AlbumR GET
/medium/#MediumId MediumR GET
+/album/#AlbumId/upload DirectUploadR GET POST
diff --git a/templates/album.hamlet b/templates/album.hamlet
index 110651b..eaaed3d 100644
--- a/templates/album.hamlet
+++ b/templates/album.hamlet
@@ -3,7 +3,7 @@ $newline never
by #{ownerName}
$if presence == True
- TODO: direct Upload to this album
+ Upload image to this album
$if null media
This album is empty
diff --git a/templates/dUpload.hamlet b/templates/dUpload.hamlet
new file mode 100644
index 0000000..964e111
--- /dev/null
+++ b/templates/dUpload.hamlet
@@ -0,0 +1,10 @@
+Image upload
+
+Here you can upload your image.
+
+
+
+