nek0/eidolon
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

albums can now be shared with other users

Browse source
This commit is contained in:
nek0 2014-12-06 04:39:24 +01:00
parent bc026a2530
commit a7589cd494
11 changed files with 107 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
Handler/AdminAlbumSettings.hs
View file

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

2
Handler/Album.hs
View file

@ -15,7 +15,7 @@ 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
-- media <- mapM (\a -> runDB $ getJust a) (albumContent album)

27
Handler/AlbumSettings.hs
View file

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

1
Handler/NewAlbum.hs
View file

@ -52,4 +52,5 @@ albumForm userId = renderDivs $ Album
<$> areq textField "Title" Nothing
<*> pure userId
<*> pure []
<*> pure []
<*> pure Nothing

7
Handler/Profile.hs
View file

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

26
Handler/Upload.hs
View file

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

29
Helper.hs
View file

@ -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|<input id=#{idAttr} type="text" name=#{nameAttr} value=#{either id (getUsersFromResult users) eResult}>|]
, 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"]

1
config/models
View file

@ -19,6 +19,7 @@ Token
Album
title Text
owner UserId
shares [UserId]
content [MediumId]
samplePic FilePath Maybe
deriving Eq Show

4
templates/albumSettings.hamlet
View file

@ -5,5 +5,5 @@ $newline always
^{albumSettingsWidget}
<div>
<input type=submit value="Change settings">
<a href=@{AlbumDeleteR albumId}>Delete this album
$if ownerPresence == True
<a href=@{AlbumDeleteR albumId}>Delete this album

2
templates/dUpload.hamlet
View file

@ -1,4 +1,4 @@
<h3>Image upload
<h3>Image upload to album #{albumTitle album}
Here you can upload your image.

18
templates/profile.hamlet
View file

@ -4,9 +4,7 @@ $if presence == True
<a href=@{ProfileSettingsR ownerId}>Change your profile settings
$if null userAlbs
<ul class="noalbum">
<li>
This user has no albums yet
<p>This user has no albums yet
$else
<p>Albums of this user:
<ul>
@ -20,6 +18,20 @@ $else
<img src=#{T.pack $ fromJust $ albumSamplePic album}>
<figcaption>#{albumTitle album}
$if null sharedAlbs
$else
<p>Albums shared with this user:
<ul>
$forall Just (Entity albumId album) <- sharedAlbs
<li>
<a href=@{AlbumR albumId}>
<figure class="thumbnail">
$if (albumSamplePic album) == Nothing
<img src="/static/img/album.jpg"><br>
$else
<img src=#{T.pack $ fromJust $ albumSamplePic album}>
<figcaption>#{albumTitle album}
$if null recentMedia
This user has not uploaded any images
$else