diff --git a/Handler/AdminAlbumSettings.hs b/Handler/AdminAlbumSettings.hs index 4a7f0c2..65d3387 100644 --- a/Handler/AdminAlbumSettings.hs +++ b/Handler/AdminAlbumSettings.hs @@ -63,7 +63,9 @@ getAdminAlbumSettingsR albumId = do tempAlbum <- runDB $ get albumId case tempAlbum of Just album -> do - (adminAlbumSettingsWidget, enctype) <- generateFormPost $ adminAlbumSettingsForm album albumId + entities <- runDB $ selectList [UserId !=. (albumOwner album)] [Desc UserName] + users <- return $ map (\u -> (userName $ entityVal u, entityKey u)) entities + (adminAlbumSettingsWidget, enctype) <- generateFormPost $ adminAlbumSettingsForm album albumId users defaultLayout $ do setTitle "Administration: Album settings" $(widgetFile "adminAlbumSet") @@ -89,11 +91,14 @@ postAdminAlbumSettingsR albumId = do tempAlbum <- runDB $ get albumId case tempAlbum of Just album -> do - ((res, adminAlbumSettingsWidget), enctype) <- runFormPost $ adminAlbumSettingsForm album albumId + entities <- runDB $ selectList [UserId !=. (albumOwner album)] [Desc UserName] + users <- return $ map (\u -> (userName $ entityVal u, entityKey u)) entities + ((res, adminAlbumSettingsWidget), enctype) <- runFormPost $ adminAlbumSettingsForm album albumId users case res of FormSuccess temp -> do aId <- runDB $ update albumId [ AlbumTitle =. albumTitle temp + , AlbumShares =. albumShares temp , AlbumSamplePic =. albumSamplePic temp ] setMessage "Album settings changed successfully" @@ -111,16 +116,20 @@ postAdminAlbumSettingsR albumId = do setMessage "You must be logged in" redirect $ LoginR -adminAlbumSettingsForm :: Album -> AlbumId -> Form Album -adminAlbumSettingsForm album albumId = renderDivs $ Album +adminAlbumSettingsForm :: Album -> AlbumId -> [(Text, UserId)] -> Form Album +adminAlbumSettingsForm album albumId users = renderDivs $ Album <$> areq textField "Title" (Just $ albumTitle album) <*> pure (albumOwner album) + <*> areq (userField users) "This album shared with" (Just $ albumShares album) <*> pure (albumContent album) <*> aopt (selectField media) "Sample picture" (Just $ albumSamplePic album) where media = do entities <- runDB $ selectList [MediumAlbum ==. albumId] [Desc MediumTitle] optionsPairs $ map (\med -> (mediumTitle $ entityVal med, mediumPath (entityVal med))) entities +-- userNames = +-- let entities = runDB $ selectList [UserId !=. (albumOwner album)] [Desc UserName] +-- in map (\ent -> (userName $ entityVal ent, entityKey ent)) entities getAdminAlbumDeleteR :: AlbumId -> Handler Html getAdminAlbumDeleteR albumId = do diff --git a/Handler/Album.hs b/Handler/Album.hs index 44e9016..f295133 100644 --- a/Handler/Album.hs +++ b/Handler/Album.hs @@ -15,9 +15,9 @@ getAlbumR albumId = do presence <- case msu of Just tempUserId -> do userId <- return $ getUserIdFromText tempUserId - return (userId == ownerId) + return $ (userId == ownerId) || (userId `elem` (albumShares album)) Nothing -> - return False + return False -- media <- mapM (\a -> runDB $ getJust a) (albumContent album) media <- runDB $ selectList [MediumAlbum ==. albumId] [Desc MediumTime] defaultLayout $ do diff --git a/Handler/AlbumSettings.hs b/Handler/AlbumSettings.hs index d96f198..154304f 100644 --- a/Handler/AlbumSettings.hs +++ b/Handler/AlbumSettings.hs @@ -17,10 +17,13 @@ getAlbumSettingsR albumId = do case msu of Just tempUserId -> do userId <- return $ getUserIdFromText tempUserId - presence <- return (userId == ownerId) - case presence of + ownerPresence <- return (userId == ownerId) + presence <- return $ userId `elem` (albumShares album) + case ownerPresence || presence of True -> do - (albumSettingsWidget, enctype) <- generateFormPost $ albumSettingsForm album albumId + entities <- runDB $ selectList [UserId !=. (albumOwner album)] [Desc UserName] + users <- return $ map (\u -> (userName $ entityVal u, entityKey u)) entities + (albumSettingsWidget, enctype) <- generateFormPost $ albumSettingsForm album albumId users defaultLayout $ do setTitle "Eidolon :: Album Settings" $(widgetFile "albumSettings") @@ -46,14 +49,18 @@ postAlbumSettingsR albumId = do case msu of Just tempUserId -> do userId <- return $ getUserIdFromText tempUserId - presence <- return (userId == ownerId) - case presence of + ownerPresence <- return (userId == ownerId) + presence <- return $ userId `elem` (albumShares album) + case ownerPresence || presence of True -> do - ((result, albumSettingsWidget), enctype) <- runFormPost $ albumSettingsForm album albumId + entities <- runDB $ selectList [UserId !=. (albumOwner album)] [Desc UserName] + users <- return $ map (\u -> (userName $ entityVal u, entityKey u)) entities + ((result, albumSettingsWidget), enctype) <- runFormPost $ albumSettingsForm album albumId users case result of FormSuccess temp -> do aId <- runDB $ update albumId [ AlbumTitle =. albumTitle temp + , AlbumShares =. albumShares temp , AlbumSamplePic =. albumSamplePic temp ] setMessage "Album settings changed succesfully" @@ -71,16 +78,20 @@ postAlbumSettingsR albumId = do setMessage "This album does not exist" redirect $ HomeR -albumSettingsForm :: Album -> AlbumId -> Form Album -albumSettingsForm album albumId = renderDivs $ Album +albumSettingsForm :: Album -> AlbumId -> [(Text, UserId)]-> Form Album +albumSettingsForm album albumId users = renderDivs $ Album <$> areq textField "Title" (Just $ albumTitle album) <*> pure (albumOwner album) + <*> areq (userField users) "Share this album with" (Just $ albumShares album) <*> pure (albumContent album) <*> aopt (selectField media) "Sample picture" (Just $ albumSamplePic album) where media = do entities <- runDB $ selectList [MediumAlbum ==. albumId] [Desc MediumTitle] optionsPairs $ map (\med -> (mediumTitle $ entityVal med, mediumThumb (entityVal med))) entities +-- users = do +-- entities <- runDB $ selectList [UserId !=. (albumOwner album)] [Desc UserName] +-- return $ map (\u -> (userName $ entityVal u, entityKey u)) entities getAlbumDeleteR :: AlbumId -> Handler Html getAlbumDeleteR albumId = do diff --git a/Handler/NewAlbum.hs b/Handler/NewAlbum.hs index 22a446b..ac80338 100644 --- a/Handler/NewAlbum.hs +++ b/Handler/NewAlbum.hs @@ -52,4 +52,5 @@ albumForm userId = renderDivs $ Album <$> areq textField "Title" Nothing <*> pure userId <*> pure [] + <*> pure [] <*> pure Nothing diff --git a/Handler/Profile.hs b/Handler/Profile.hs index 66f7e1e..04934d4 100644 --- a/Handler/Profile.hs +++ b/Handler/Profile.hs @@ -11,6 +11,13 @@ getProfileR ownerId = do Just owner -> do ownerSlug <- lift $ pure $ userSlug owner userAlbs <- runDB $ selectList [AlbumOwner ==. ownerId] [Asc AlbumTitle] + allAlbs <- runDB $ selectList [] [Asc AlbumTitle] + almostAlbs <- mapM (\alb -> do + case ownerId `elem` (albumShares $ entityVal alb) of + True -> return $ Just alb + False -> return Nothing + ) allAlbs + sharedAlbs <- return $ removeItem Nothing almostAlbs recentMedia <- (runDB $ selectList [MediumOwner ==. ownerId] [Desc MediumTime]) msu <- lookupSession "userId" presence <- case msu of diff --git a/Handler/Upload.hs b/Handler/Upload.hs index bc1637a..a100ed4 100644 --- a/Handler/Upload.hs +++ b/Handler/Upload.hs @@ -2,6 +2,7 @@ module Handler.Upload where import Import as I import Data.Time +import Data.Maybe import qualified Data.Text as T import qualified System.FilePath as FP import qualified Filesystem.Path as FSP @@ -89,8 +90,8 @@ getDirectUploadR albumId = do 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 + presence <- return $ (userId == ownerId) || (userId `elem` (albumShares album)) + case presence of -- is the owner present or a user with whom the album is shared True -> do (dUploadWidget, enctype) <- generateFormPost $ dUploadForm userId albumId defaultLayout $ do @@ -118,8 +119,8 @@ postDirectUploadR albumId = do 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 + presence <- return $ (userId == ownerId) || (userId `elem` (albumShares album)) + case presence of -- is the logged in user the owner or is the album shared with him True -> do ((result, dUploadWidget), enctype) <- runFormPost (dUploadForm userId albumId) case result of @@ -193,18 +194,27 @@ writeOnDrive fil userId albumId = do return path uploadForm :: UserId -> Form TempMedium -uploadForm userId = renderDivs $ TempMedium - <$> areq textField "Title" Nothing +uploadForm userId = renderDivs $ (\a b c d e f g -> TempMedium b c d e f g a) + <$> areq (selectField albums) "Album" Nothing + <*> areq textField "Title" Nothing <*> areq fileField "Select file" Nothing <*> lift (liftIO getCurrentTime) <*> pure userId <*> areq textareaField "Description" Nothing <*> areq tagField "Enter tags" Nothing - <*> areq (selectField albums) "Album" Nothing where -- albums :: GHandler App App (OptionList AlbumId) albums = do - entities <- runDB $ selectList [AlbumOwner ==. userId] [Desc AlbumTitle] + allEnts <- runDB $ selectList [] [Desc AlbumTitle] + entities <- return $ + map fromJust $ + removeItem Nothing $ map + (\ent -> do + case (userId == (albumOwner $ entityVal ent)) || (userId `elem` (albumShares $ entityVal ent)) of + True -> Just ent + False -> Nothing + ) allEnts +-- entities <- runDB $ selectList [AlbumOwner ==. userId] [Desc AlbumTitle] optionsPairs $ I.map (\alb -> (albumTitle $ entityVal alb, entityKey alb)) entities dUploadForm :: UserId -> AlbumId -> Form TempMedium diff --git a/Helper.hs b/Helper.hs index 56a8c6a..ed15607 100644 --- a/Helper.hs +++ b/Helper.hs @@ -8,6 +8,7 @@ module Helper , makeRandomToken , generateSalt , tagField + , userField , sendMail , generateString , removeItem @@ -79,7 +80,7 @@ makeRandomToken = (T.pack . take 16 . randoms) `fmap` newStdGen generateSalt :: IO B.ByteString generateSalt = (B.pack . take 8 . randoms) <$> getStdGen --- tagField :: Field Handler [T.Text] +tagField :: Monad m => Field m [T.Text] tagField = Field { fieldParse = \rawVals _ -> do case rawVals of @@ -92,6 +93,26 @@ tagField = Field , fieldEnctype = UrlEncoded } +userField :: Monad m => [(T.Text, UserId)] -> Field m [UserId] +userField users = Field + { fieldParse = \rawVals _ -> do + case rawVals of + [x] -> case x == "" of + False -> + -- clean = removeItem "" $ T.splitOn " " x + let ids = map (\u -> lookup u users) (removeItem "" $ T.splitOn " " x) + in case Nothing `elem` ids of + False -> return $ Right $ Just $ map fromJust ids + True -> return $ Left $ error "Invalid username list" + True -> return $ Right $ Just $ [] + _ -> return $ Left $ error "unexpected username list" + , fieldView = \idAttr nameAttr val eResult isReq -> + [whamlet||] + , fieldEnctype = UrlEncoded + } + +getUsersFromResult users res = T.intercalate " " $ map (\x -> fromMaybe "" $ reverseLookup x users) res + sendMail :: MonadIO m => T.Text -> T.Text -> Html -> m () sendMail toEmail subject body = liftIO $ renderSendMail @@ -119,5 +140,11 @@ removeItem x (y:ys) | x == y = removeItem x ys | otherwise = y : removeItem x ys +reverseLookup :: Eq b => b -> [(a, b)] -> Maybe a +reverseLookup s ((x, y):zs) + | s == y = Just x + | s /= y = reverseLookup s zs + | otherwise = Nothing + acceptedTypes :: [T.Text] acceptedTypes = ["image/jpeg", "image/jpg", "image/png", "image/x-ms-bmp", "image/x-bmp", "image/bmp", "image/tiff", "image/tiff-fx"] diff --git a/config/models b/config/models index 15dcfe4..b1579d0 100644 --- a/config/models +++ b/config/models @@ -19,6 +19,7 @@ Token Album title Text owner UserId + shares [UserId] content [MediumId] samplePic FilePath Maybe deriving Eq Show diff --git a/templates/albumSettings.hamlet b/templates/albumSettings.hamlet index 93d6baf..e111f0d 100644 --- a/templates/albumSettings.hamlet +++ b/templates/albumSettings.hamlet @@ -5,5 +5,5 @@ $newline always ^{albumSettingsWidget}
- -Delete this album +$if ownerPresence == True + Delete this album diff --git a/templates/dUpload.hamlet b/templates/dUpload.hamlet index 964e111..4c3fa16 100644 --- a/templates/dUpload.hamlet +++ b/templates/dUpload.hamlet @@ -1,4 +1,4 @@ -

Image upload +

Image upload to album #{albumTitle album} Here you can upload your image. diff --git a/templates/profile.hamlet b/templates/profile.hamlet index 8de4a51..d9082bc 100644 --- a/templates/profile.hamlet +++ b/templates/profile.hamlet @@ -4,9 +4,7 @@ $if presence == True Change your profile settings $if null userAlbs -