diff --git a/Handler/Activate.hs b/Handler/Activate.hs index 13ac7ee..2df1092 100755 --- a/Handler/Activate.hs +++ b/Handler/Activate.hs @@ -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 diff --git a/Handler/AdminAlbumSettings.hs b/Handler/AdminAlbumSettings.hs index 1bf3a35..3724f88 100755 --- a/Handler/AdminAlbumSettings.hs +++ b/Handler/AdminAlbumSettings.hs @@ -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 diff --git a/Handler/AdminComments.hs b/Handler/AdminComments.hs index 2f3eaea..3da0fea 100755 --- a/Handler/AdminComments.hs +++ b/Handler/AdminComments.hs @@ -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 diff --git a/Handler/AdminMediumSettings.hs b/Handler/AdminMediumSettings.hs index 09c03a2..b976865 100755 --- a/Handler/AdminMediumSettings.hs +++ b/Handler/AdminMediumSettings.hs @@ -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 diff --git a/Handler/AlbumSettings.hs b/Handler/AlbumSettings.hs index e51a527..1886bd2 100755 --- a/Handler/AlbumSettings.hs +++ b/Handler/AlbumSettings.hs @@ -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 diff --git a/Handler/Medium.hs b/Handler/Medium.hs index 62e4eb2..b571ccf 100755 --- a/Handler/Medium.hs +++ b/Handler/Medium.hs @@ -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 diff --git a/Handler/MediumSettings.hs b/Handler/MediumSettings.hs index bcc4e5c..ea5f034 100755 --- a/Handler/MediumSettings.hs +++ b/Handler/MediumSettings.hs @@ -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 diff --git a/Handler/NewAlbum.hs b/Handler/NewAlbum.hs index dea4f48..3aecb05 100755 --- a/Handler/NewAlbum.hs +++ b/Handler/NewAlbum.hs @@ -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) diff --git a/Handler/Upload.hs b/Handler/Upload.hs index 6be0079..3d933bb 100755 --- a/Handler/Upload.hs +++ b/Handler/Upload.hs @@ -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 diff --git a/Model.hs b/Model.hs index 2b292ac..aaab070 100755 --- a/Model.hs +++ b/Model.hs @@ -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) - ] diff --git a/README.md b/README.md index fcf0bbd..c36e63b 100755 --- a/README.md +++ b/README.md @@ -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. diff --git a/config/models b/config/models index f1bd4b9..31a513b 100755 --- a/config/models +++ b/config/models @@ -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