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

backend stuff done

Browse source
This commit is contained in:
nek0 2016-12-19 00:57:39 +01:00
parent 14718c3c18
commit 52a35fd114
5 changed files with 23 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Handler/AdminProfileSettings.hs
View file

@ -139,7 +139,7 @@ adminProfileForm owner = User
<*> pure (userSalted owner) <*> pure (userSalted owner)
<*> pure (userAlbums owner) <*> pure (userAlbums owner)
<*> areq boolField (bfs ("Admin" :: T.Text)) (Just $ userAdmin owner) <*> areq boolField (bfs ("Admin" :: T.Text)) (Just $ userAdmin owner)
<*> areq (selectField optionsEnum) (bfs ("Default licence" :: T.Text) (Just $ userDefaultLicense owner) <*> areq (selectField optionsEnum) (bfs ("Default licence" :: T.Text)) (Just $ userDefaultLicence owner)
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit T.Text) <* bootstrapSubmit ("Change settings" :: BootstrapSubmit T.Text)
getAdminProfileDeleteR :: UserId -> Handler Html getAdminProfileDeleteR :: UserId -> Handler Html

5
Handler/MediumSettings.hs
View file

@ -70,10 +70,13 @@ mediumSettingsForm medium = Medium
<*> pure (mediumTime medium) <*> pure (mediumTime medium)
<*> pure (mediumOwner medium) <*> pure (mediumOwner medium)
<*> aopt textareaField (bfs ("Description" :: T.Text)) (Just $ mediumDescription medium) <*> aopt textareaField (bfs ("Description" :: T.Text)) (Just $ mediumDescription medium)
<*> areq tagField (bfs ("tags" :: T.Text)) (Just $ mediumTags medium) <*> areq tagField (bfs ("Tags" :: T.Text)) (Just $ mediumTags medium)
<*> pure (mediumAlbum medium) <*> pure (mediumAlbum medium)
<*> pure (mediumPreview medium) <*> pure (mediumPreview medium)
<*> areq (selectField licences) (bfs ("Licence" :: T.Text)) (Just $ mediumLicence medium)
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit T.Text) <* bootstrapSubmit ("Change settings" :: BootstrapSubmit T.Text)
where
licences = optionsPairs $ map (\a -> (T.pack (show (toEnum a :: Licence)), a)) [-2..6]
getMediumDeleteR :: MediumId -> Handler Html getMediumDeleteR :: MediumId -> Handler Html
getMediumDeleteR mediumId = do getMediumDeleteR mediumId = do

2
Handler/ProfileSettings.hs
View file

@ -71,4 +71,4 @@ profileSettingsForm user = User
(Just $ userDefaultLicence user) (Just $ userDefaultLicence user)
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit Text) <* bootstrapSubmit ("Change settings" :: BootstrapSubmit Text)
where where
licenses = optionsPairs $ map (\a -> (T.pack (show (toEnum a :: Licence)), a)) [-2..6] licences = optionsPairs $ map (\a -> (T.pack (show (toEnum a :: Licence)), a)) [-2..6]

33
Handler/Upload.hs
View file

@ -47,7 +47,8 @@ getDirectUploadR albumId = do
userId == ownerId || userId `elem` albumShares album userId == ownerId || userId `elem` albumShares album
-- is the owner present or a user with whom the album is shared -- is the owner present or a user with whom the album is shared
then do then do
(dUploadWidget, enctype) <- generateFormPost $ renderBootstrap3 BootstrapBasicForm $ dUploadForm userId albumId user <- runDB $ getJust userId
(dUploadWidget, enctype) <- generateFormPost $ renderBootstrap3 BootstrapBasicForm $ dUploadForm userId user albumId
defaultLayout $ do defaultLayout $ do
setTitle $ toHtml ("Eidolon :: Upload medium to " `T.append` albumTitle album) setTitle $ toHtml ("Eidolon :: Upload medium to " `T.append` albumTitle album)
$(widgetFile "dUpload") $(widgetFile "dUpload")
@ -74,7 +75,8 @@ postDirectUploadR albumId = do
if userId == ownerId || userId `elem` albumShares album if userId == ownerId || userId `elem` albumShares album
-- is the logged in user the owner or is the album shared with him -- is the logged in user the owner or is the album shared with him
then do then do
((result, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ dUploadForm userId albumId user <- runDB $ getJust userId
((result, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ dUploadForm userId user albumId
case result of case result of
FormSuccess temp -> do FormSuccess temp -> do
let fils = fileBulkFiles temp let fils = fileBulkFiles temp
@ -92,7 +94,7 @@ postDirectUploadR albumId = do
tempName <- if length indFils == 1 tempName <- if length indFils == 1
then return $ fileBulkPrefix temp then return $ fileBulkPrefix temp
else return (fileBulkPrefix temp `T.append` " " `T.append` T.pack (show (index :: Int)) `T.append` " of " `T.append` T.pack (show (length indFils))) else return (fileBulkPrefix temp `T.append` " " `T.append` T.pack (show (index :: Int)) `T.append` " of " `T.append` T.pack (show (length indFils)))
let medium = Medium tempName ('/' : path) ('/' : metaThumbPath meta) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) albumId ('/' : metaPreviewPath meta) let medium = Medium tempName ('/' : path) ('/' : metaThumbPath meta) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) albumId ('/' : metaPreviewPath meta) (fileBulkLicence temp)
insertMedium medium albumId insertMedium medium albumId
return Nothing return Nothing
else do else do
@ -205,8 +207,8 @@ writeOnDrive fil userId albumId = do
liftIO $ fileMove fil path liftIO $ fileMove fil path
return path return path
dUploadForm :: UserId -> AlbumId -> AForm Handler FileBulk dUploadForm :: UserId -> User -> AlbumId -> AForm Handler FileBulk
dUploadForm userId albumId = FileBulk dUploadForm userId user albumId = FileBulk
<$> areq textField (bfs ("Title" :: T.Text)) Nothing <$> areq textField (bfs ("Title" :: T.Text)) Nothing
<*> areq multiFileField "Select file(s)" Nothing <*> areq multiFileField "Select file(s)" Nothing
<*> lift (liftIO getCurrentTime) <*> lift (liftIO getCurrentTime)
@ -217,10 +219,8 @@ dUploadForm userId albumId = FileBulk
<*> areq (selectField licences) (bfs ("Licence" :: T.Text)) (defLicence) <*> areq (selectField licences) (bfs ("Licence" :: T.Text)) (defLicence)
<* bootstrapSubmit ("Upload" :: BootstrapSubmit T.Text) <* bootstrapSubmit ("Upload" :: BootstrapSubmit T.Text)
where where
licenses = optionsPairs $ I.map (\a -> (T.pack (show (toEnum a :: Licence)), a)) [-2..6] licences = optionsPairs $ I.map (\a -> (T.pack (show (toEnum a :: Licence)), a)) [-2..6]
defLicence = do defLicence = Just $ userDefaultLicence user
user <- runDB $ selectJust userId
return $ Just $ userDefaultLicence user
data FileBulk = FileBulk data FileBulk = FileBulk
@ -248,7 +248,7 @@ getUploadR = do
setMessage "Please create an album first" setMessage "Please create an album first"
redirect NewAlbumR redirect NewAlbumR
else do else do
(uploadWidget, enctype) <- generateFormPost $ renderBootstrap3 BootstrapBasicForm $ bulkUploadForm userId (uploadWidget, enctype) <- generateFormPost $ renderBootstrap3 BootstrapBasicForm $ bulkUploadForm userId user
defaultLayout $ do defaultLayout $ do
setTitle "Eidolon :: Upload Medium" setTitle "Eidolon :: Upload Medium"
$(widgetFile "bulkUpload") $(widgetFile "bulkUpload")
@ -257,7 +257,7 @@ getUploadR = do
redirect LoginR redirect LoginR
bulkUploadForm :: UserId -> User -> AForm Handler FileBulk bulkUploadForm :: UserId -> User -> AForm Handler FileBulk
bulkUploadForm userId = (\a b c d e f g h -> FileBulk b c d e f g a h) bulkUploadForm userId user = (\a b c d e f g h -> FileBulk b c d e f g a h)
<$> areq (selectField albums) (bfs ("Album" :: T.Text)) Nothing <$> areq (selectField albums) (bfs ("Album" :: T.Text)) Nothing
<*> areq textField (bfs ("Title" :: T.Text)) Nothing <*> areq textField (bfs ("Title" :: T.Text)) Nothing
<*> areq multiFileField "Select file(s)" Nothing <*> areq multiFileField "Select file(s)" Nothing
@ -277,10 +277,8 @@ bulkUploadForm userId = (\a b c d e f g h -> FileBulk b c d e f g a h)
else Nothing else Nothing
) allEnts ) allEnts
optionsPairs $ I.map (\alb -> (albumTitle $ entityVal alb, entityKey alb)) entities optionsPairs $ I.map (\alb -> (albumTitle $ entityVal alb, entityKey alb)) entities
licenses = optionsPairs $ I.map (\a -> (T.pack (show (toEnum a :: Licence)), a)) [-2..6] licences = optionsPairs $ I.map (\a -> (T.pack (show (toEnum a :: Licence)), a)) [-2..6]
defLicence = do defLicence = Just $ userDefaultLicence user
user <- runDB $ selectJust userId
return $ Just $ userDefaultLicence user
postUploadR :: Handler Html postUploadR :: Handler Html
postUploadR = do postUploadR = do
@ -288,7 +286,8 @@ postUploadR = do
case msu of case msu of
Just tempUserId -> do Just tempUserId -> do
let userId = getUserIdFromText tempUserId let userId = getUserIdFromText tempUserId
((result, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ bulkUploadForm userId user <- runDB $ getJust userId
((result, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ bulkUploadForm userId user
case result of case result of
FormSuccess temp -> do FormSuccess temp -> do
let fils = fileBulkFiles temp let fils = fileBulkFiles temp
@ -316,7 +315,7 @@ postUploadR = do
T.pack (show (index :: Int)) `T.append` T.pack (show (index :: Int)) `T.append`
" of " `T.append` " of " `T.append`
T.pack (show (length indFils))) T.pack (show (length indFils)))
let medium = Medium tempName ('/' : path) ('/' : metaThumbPath meta) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) inAlbumId ('/' : metaPreviewPath meta) let medium = Medium tempName ('/' : path) ('/' : metaThumbPath meta) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) inAlbumId ('/' : metaPreviewPath meta) (fileBulkLicence temp)
-- mId <- runDB $ I.insert medium -- mId <- runDB $ I.insert medium
-- inALbum <- runDB $ getJust inAlbumId -- inALbum <- runDB $ getJust inAlbumId
-- let newMediaList = mId : albumContent inALbum -- let newMediaList = mId : albumContent inALbum

2
eidolon.cabal
View file

@ -1,5 +1,5 @@
name: eidolon name: eidolon
version: 0.1.5.6 version: 0.1.6.0
synopsis: Image gallery in Yesod synopsis: Image gallery in Yesod
homepage: https://eidolon.nek0.eu homepage: https://eidolon.nek0.eu
license: AGPL-3 license: AGPL-3