added direct upload to album page

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

config/routes

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

templates/album.hamlet

@@ -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

templates/dUpload.hamlet

@@ -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">