removing remnants

This commit is contained in:
nek0 2016-09-06 17:30:41 +02:00
parent d25152b8ab
commit ee65575a0f
12 changed files with 13 additions and 126 deletions

View file

@ -97,7 +97,7 @@ postActivateR token = do
_ ->
returnJsonError "Invalid activation token!"
returnJson :: (Monad m, ToJSON a, a ~ Value) =>
returnJson :: (Monad m, a ~ Value) =>
[(Text, a)] -> m RepJson
returnJson = return . repJson . object

View file

@ -94,12 +94,10 @@ postAdminAlbumSettingsR albumId = do
adminAlbumSettingsForm album albumId users
case res of
FormSuccess temp -> do
width <- getThumbWidth $ albumSamplePic temp
_ <- runDB $ update albumId
[ AlbumTitle =. albumTitle temp
, AlbumShares =. albumShares temp
, AlbumSamplePic =. albumSamplePic temp
, AlbumSampleWidth =. width
]
setMessage "Album settings changed successfully"
redirect AdminR
@ -120,7 +118,6 @@ adminAlbumSettingsForm album albumId users = Album
<*> areq (userField users) (bfs ("This album shared with" :: T.Text)) (Just $ albumShares album)
<*> pure (albumContent album)
<*> aopt (selectField media) (bfs ("Sample picture" :: T.Text)) (Just $ albumSamplePic album)
<*> pure 230
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit Text)
where
media = do

View file

@ -43,7 +43,7 @@ getAdminCommentDeleteR commentId = do
Right _ -> do
tempComment <- runDB $ get commentId
case tempComment of
Just comment -> do
Just _ -> do
-- delete comment children
children <- runDB $ selectList [CommentParent ==. Just commentId] []
_ <- mapM (\child -> do

View file

@ -97,11 +97,8 @@ adminMediumSetForm medium = Medium
<*> pure (mediumOwner medium)
<*> aopt textareaField (bfs ("Description" :: T.Text)) (Just $ mediumDescription medium)
<*> areq tagField (bfs ("Tags" :: T.Text)) (Just $ mediumTags medium)
<*> pure (mediumWidth medium)
<*> pure (mediumThumbWidth medium)
<*> pure (mediumAlbum medium)
<*> pure (mediumPreview medium)
<*> pure (mediumPreviewWidth medium)
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit Text)
getAdminMediumDeleteR :: MediumId -> Handler Html

View file

@ -17,9 +17,7 @@
module Handler.AlbumSettings where
import Import
import Handler.Commons
import qualified Data.Text as T
import Data.Maybe
import System.Directory
import System.FilePath
import qualified Data.List as L
@ -108,14 +106,10 @@ postAlbumSettingsR albumId = do
else do
return [()]
-- nothing to do here
sample <- runDB $ selectFirst
[MediumThumb ==. (fromMaybe "" $ albumSamplePic temp)] []
let width = if isNothing sample then 230 else mediumThumbWidth $ entityVal $ fromJust sample
_ <- runDB $ update albumId
[ AlbumTitle =. albumTitle temp
, AlbumShares =. newShares
, AlbumSamplePic =. albumSamplePic temp
, AlbumSampleWidth =. width
]
setMessage "Album settings changed succesfully"
redirect $ AlbumR albumId
@ -139,7 +133,6 @@ albumSettingsForm album albumId users = Album
<*> areq (userField users) (bfs ("Share this album with" :: T.Text)) (Just $ albumShares album)
<*> pure (albumContent album)
<*> aopt (selectField media) (bfs ("Sample picture" :: T.Text)) (Just $ albumSamplePic album)
<*> pure 230
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit Text)
where
media = do

View file

@ -17,11 +17,9 @@
module Handler.Medium where
import Import
import Handler.Commons
import Data.Time
import Data.Maybe
import qualified Data.Text as T
-- import System.Locale
import System.FilePath
import Yesod.Markdown
import Yesod.RssFeed
@ -61,7 +59,6 @@ getMediumR mediumId = do
[ CommentOrigin ==. mediumId
, CommentParent !=. Nothing ]
[ Desc CommentTime ]
let dataWidth = if mediumWidth medium >= 850 then 850 else mediumWidth medium
let tr = StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumThumb medium) []
let pr = StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumPreview medium) []
let ir = StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumPath medium) []
@ -90,7 +87,7 @@ postMediumR mediumId = do
commentForm userId userSl mediumId Nothing
case res of
FormSuccess temp -> do
cId <- runDB $ insert temp
runDB $ insert_ temp
--send mail to medium owner
owner <- runDB $ getJust $ mediumOwner medium
link <- ($ MediumR (commentOrigin temp)) <$> getUrlRender
@ -168,7 +165,7 @@ postCommentReplyR commentId = do
commentForm userId userSl mediumId (Just commentId)
case res of
FormSuccess temp -> do
cId <- runDB $ insert temp
runDB $ insert_ temp
--send mail to parent author
parent <- runDB $ getJust $ fromJust $ commentParent temp
parAuth <- runDB $ getJust $ commentAuthor parent

View file

@ -72,11 +72,8 @@ mediumSettingsForm medium = Medium
<*> pure (mediumOwner medium)
<*> aopt textareaField (bfs ("Description" :: T.Text)) (Just $ mediumDescription medium)
<*> areq tagField (bfs ("tags" :: T.Text)) (Just $ mediumTags medium)
<*> pure (mediumWidth medium)
<*> pure (mediumThumbWidth medium)
<*> pure (mediumAlbum medium)
<*> pure (mediumPreview medium)
<*> pure (mediumPreviewWidth medium)
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit T.Text)
getMediumDeleteR :: MediumId -> Handler Html

View file

@ -17,7 +17,6 @@
module Handler.NewAlbum where
import Import
import Handler.Commons
import Data.Text as T
import System.Directory
import System.FilePath
@ -75,5 +74,4 @@ albumForm userId = Album
<*> pure []
<*> pure []
<*> pure Nothing
<*> pure 230
<* bootstrapSubmit ("Create album" :: BootstrapSubmit Text)

View file

@ -17,7 +17,6 @@
module Handler.Upload where
import Import as I
import Handler.Commons
import Data.Time
import Data.Maybe
import qualified Data.Text as T
@ -89,7 +88,7 @@ postDirectUploadR albumId = do
tempName <- if length indFils == 1
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)))
let medium = Medium tempName ('/' : path) ('/' : metaThumbPath meta) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) (metaImageWidth meta) (metaThumbWidth meta) albumId ('/' : metaPreviewPath meta) (metaPreviewWidth meta)
let medium = Medium tempName ('/' : path) ('/' : metaThumbPath meta) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) albumId ('/' : metaPreviewPath meta)
mId <- runDB $ I.insert medium
inALbum <- runDB $ getJust albumId
let newMediaList = mId : albumContent inALbum
@ -129,9 +128,6 @@ postDirectUploadR albumId = do
data ThumbsMeta = ThumbsMeta
{ metaThumbPath :: FP.FilePath -- ^ Filepath of the new thumbnail image
, metaPreviewPath :: FP.FilePath -- ^ Filepath of the new preview image
, metaImageWidth :: Int -- ^ Width of the original image
, metaThumbWidth :: Int -- ^ Width of the generated thumbnail image
, metaPreviewWidth :: Int -- ^ Width of the generated preview image
}
-- | generate thumbnail and preview images from uploaded image
@ -165,9 +161,6 @@ generateThumbs path uId aId = do
return $ ThumbsMeta
{ metaThumbPath = tPath
, metaPreviewPath = pPath
, metaImageWidth = oWidth
, metaThumbWidth = tWidth
, metaPreviewWidth = pWidth
}
checkCVE_2016_3714 :: FP.FilePath -> Text -> IO Bool
@ -300,7 +293,7 @@ postUploadR = do
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) (metaImageWidth meta) (metaThumbWidth meta) inAlbumId ('/' : metaPreviewPath meta) (metaPreviewWidth meta)
let medium = Medium tempName ('/' : path) ('/' : metaThumbPath meta) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) inAlbumId ('/' : metaPreviewPath meta)
mId <- runDB $ I.insert medium
inALbum <- runDB $ getJust inAlbumId
let newMediaList = mId : albumContent inALbum

View file

@ -17,8 +17,8 @@
module Model where
import ClassyPrelude.Yesod
import Yesod.Markdown (Markdown, unMarkdown)
import Database.Persist.Quasi
import Yesod.Markdown
import qualified System.FilePath as FP
-- You can define all of your database entities in the entities file.
@ -27,88 +27,3 @@ import qualified System.FilePath as FP
-- http://www.yesodweb.com/book/persistent/
share [mkPersist sqlSettings, mkMigrate "migrateAll"]
$(persistFileWith lowerCaseSettings "config/models")
data ESInput = ESUser UserId User
| ESAlbum AlbumId Album
| ESMedium MediumId Medium
| ESComment CommentId Comment
data FullUser = FullUser
{userRep :: User}
instance ToJSON User where
toJSON (User name slug _ _ _ _ _) =
object
[ "name" .= name
, "slug" .= slug
]
instance ToJSON FullUser where
toJSON (FullUser user) =
object
[ "name" .= (userName user)
, "slug" .= (userSlug user)
, "albums" .= (userAlbums user)
]
data FullAlbum = FullAlbum
{albumRep :: Album}
instance ToJSON Album where
toJSON (Album title _ _ _ _ _) =
object
[ "name" .= title ]
instance ToJSON FullAlbum where
toJSON (FullAlbum album) =
object
[ "name" .= (albumTitle album)
, "owner" .= (albumOwner album)
, "shares" .= (albumShares album)
, "content" .= (albumContent album)
]
data FullMedium = FullMedium
{mediumRep :: Medium}
instance ToJSON Medium where
toJSON (Medium title _ _ _ time _ desc tags _ _ _ _ _) =
object
[ "name" .= title
, "time" .= time
, "description" .= desc
, "tags" .= tags
]
instance ToJSON FullMedium where
toJSON (FullMedium medium) =
object
[ "name" .= (mediumTitle medium)
, "time" .= (mediumTime medium)
, "owner" .= (mediumOwner medium)
, "description" .= (mediumDescription medium)
, "tage" .= (mediumTags medium)
, "album" .= (mediumAlbum medium)
]
data FullComment = FullComment
{commentRep :: Comment}
instance ToJSON Comment where
toJSON (Comment _ slug _ _ time cont) =
object
[ "author" .= slug
, "time" .= time
, "content" .= (unMarkdown cont)
]
instance ToJSON FullComment where
toJSON (FullComment comment) =
object
[ "author_id" .= (commentAuthor comment)
, "author" .= (commentAuthorSlug comment)
, "origin" .= (commentOrigin comment)
, "parent" .= (commentParent comment)
, "time" .= (commentTime comment)
, "content" .= (unMarkdown $ commentContent comment)
]

View file

@ -68,7 +68,7 @@ cabal sandbox init
build the source with
```bash
cabal install
cabal build
```
Everything should work automagically from there.
@ -76,7 +76,7 @@ Everything should work automagically from there.
##Deploying
After compiling you will find an executable called `eidolon` in
`dist/dist-sandbox-XXXXXXXX/build/eidolon/eidolon`. Copy or link it anywhere you
`dist/build/eidolon/eidolon`. Copy or link it anywhere you
want. The executable needs to be accompanied by the folders `config` and
`static` and their contents. It's best to copy them to your desired destination.

View file

@ -39,7 +39,7 @@ Album
shares [UserId]
content [MediumId]
samplePic FP.FilePath Maybe
sampleWidth Int
-- sampleWidth Int
deriving Eq Show
Medium
title Text
@ -50,11 +50,11 @@ Medium
owner UserId
description Textarea Maybe
tags Texts
width Int
thumbWidth Int
-- width Int
-- thumbWidth Int
album AlbumId
preview FP.FilePath
previewWidth Int
-- previewWidth Int
deriving Eq Show
Comment
author UserId