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

starting out with elasticsearch. not working for now

Browse source
This commit is contained in:
nek0 2015-10-16 15:32:47 +02:00
parent 1e41b779bd
commit 6c40597ae8
15 changed files with 211 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
Application.hs
View file

@ -68,6 +68,7 @@ import Handler.AdminMediumSettings
import Handler.AdminComments
import Handler.Tag
import Handler.RootFeed
import Handler.Search
-- This line actually creates our YesodDispatch instance. It is the second half
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the

2
Handler/Activate.hs
View file

@ -73,6 +73,8 @@ postActivateR token = do
-- create user directory
liftIO $ createDirectoryIfMissing True $
"static" </> "data" </> unpack (extractKey uId)
-- input user to elasticsearch
liftIO $ putIndexES (ESUser uId $ activatorUser activ)
-- cleanup
runDB $ delete aId
runDB $ delete uTokenId

3
Handler/AlbumSettings.hs
View file

@ -110,6 +110,7 @@ postAlbumSettingsR albumId = do
, AlbumSamplePic =. albumSamplePic temp
, AlbumSampleWidth =. width
]
liftIO $ putIndexES (ESAlbum albumId temp)
setMessage "Album settings changed succesfully"
redirect $ AlbumR albumId
_ -> do
@ -203,6 +204,8 @@ postAlbumDeleteR albumId = do
runDB $ delete albumId
-- delete files
liftIO $ removeDirectoryRecursive $ "static" </> "data" </> T.unpack (extractKey userId) </> T.unpack (extractKey albumId)
-- delete from elasticsearch
liftIO $ deleteIndexES (ESAlbum albumId album)
-- outro
setMessage "Album deleted succesfully"
redirect HomeR

8
Handler/Medium.hs
View file

@ -85,7 +85,8 @@ postMediumR mediumId = do
((res, _), _) <- runFormPost $ commentForm userId userSl mediumId Nothing
case res of
FormSuccess temp -> do
_ <- runDB $ insert temp
cId <- runDB $ insert temp
liftIO $ putIndexES (ESComment cId temp)
--send mail to medium owner
owner <- runDB $ getJust $ mediumOwner medium
link <- ($ MediumR (commentOrigin temp)) <$> getUrlRender
@ -158,7 +159,8 @@ postCommentReplyR commentId = do
((res, _), _) <- runFormPost $ commentForm userId userSl mediumId (Just commentId)
case res of
FormSuccess temp -> do
_ <- runDB $ insert temp
cId <- runDB $ insert temp
liftIO $ putIndexES (ESComment cId temp)
--send mail to parent author
parent <- runDB $ getJust $ fromJust $ commentParent temp
parAuth <- runDB $ getJust $ commentAuthor parent
@ -243,6 +245,8 @@ postCommentDeleteR commentId = do
_ <- mapM (\ent -> runDB $ delete $ entityKey ent) childEnts
-- delete comment itself
runDB $ delete commentId
-- delete from elasticsearch
liftIO $ deleteIndexES (ESComment commentId comment)
-- outro
setMessage "Your comment has been deleted"
redirect $ MediumR $ commentOrigin comment

3
Handler/MediumSettings.hs
View file

@ -49,6 +49,7 @@ postMediumSettingsR mediumId = do
, MediumDescription =. mediumDescription temp
, MediumTags =. mediumTags temp
]
liftIO $ putIndexES (ESMedium mediumId temp)
setMessage "Medium settings changed succesfully"
redirect $ MediumR mediumId
_ -> do
@ -107,6 +108,8 @@ postMediumDeleteR mediumId = do
liftIO $ removeFile (normalise $ tail $ mediumPath medium)
liftIO $ removeFile (normalise $ tail $ mediumThumb medium)
runDB $ delete mediumId
-- delete form elasticsearch
liftIO $ deleteIndexES (ESMedium mediumId medium)
setMessage "Medium succesfully deleted"
redirect HomeR
_ -> do

2
Handler/NewAlbum.hs
View file

@ -53,6 +53,8 @@ postNewAlbumR = do
runDB $ update userId [UserAlbums =. newAlbumList]
-- create folder
liftIO $ createDirectory $ "static" </> "data" </> unpack (extractKey userId) </> unpack (extractKey albumId)
-- update elasticsearch
liftIO $ putIndexES (ESAlbum albumId album)
-- outro
setMessage "Album successfully created"
redirect $ ProfileR userId

2
Handler/ProfileDelete.hs
View file

@ -53,6 +53,7 @@ postProfileDeleteR userId = do
commEnts <- runDB $ selectList [CommentOrigin ==. med] []
_ <- mapM (runDB . delete . entityKey) commEnts
medium <- runDB $ getJust med
liftIO $ deleteIndexES (ESMedium med medium)
liftIO $ removeFile (normalise $ L.tail $ mediumPath medium)
liftIO $ removeFile (normalise $ L.tail $ mediumThumb medium)
runDB $ delete med
@ -61,6 +62,7 @@ postProfileDeleteR userId = do
) albumList
runDB $ delete userId
liftIO $ removeDirectoryRecursive $ "static" </> "data" </> T.unpack (extractKey userId)
liftIO $ deleteIndexES (ESUser userId user)
deleteSession "userId"
setMessage "User deleted successfully"
redirect HomeR

1
Handler/ProfileSettings.hs
View file

@ -45,6 +45,7 @@ postProfileSettingsR userId = do
, UserSlug =. userSlug temp
, UserEmail =. userEmail temp
]
liftIO $ putIndexES (ESUser userId temp)
setMessage "Profile settings changed successfully"
redirect $ UserR $ userName user
_ -> do

30
Handler/Search.hs Executable file
View file

@ -0,0 +1,30 @@
module Handler.Search where
import Import
import Helper
import Data.Aeson
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy.Char8 as L
import Database.Bloodhound
import Database.Bloodhound.Client
import Network.HTTP.Client (defaultManagerSettings, responseBody)
getSearchR :: Handler Html
getSearchR = do
((res, widget), _) <- runFormGet searchForm
searchResults <-
case res of
FormSuccess query -> do
res <- getResults query
return $ L.toStrict $ responseBody res
_ -> return $ C.empty
-- error $ C.unpack searchResults
defaultLayout $
$(widgetFile "search")
searchForm :: Form Text
searchForm = renderDivs $ areq (searchField True) "Search" Nothing
getResults query = do
let esQuery = QuerySimpleQueryStringQuery (SimpleQueryStringQuery (QueryString query) Nothing Nothing Nothing Nothing Nothing Nothing)
liftIO $ runBH' $ searchAll $ mkSearch (Just esQuery) Nothing

8
Handler/Upload.hs
View file

@ -90,6 +90,7 @@ postDirectUploadR albumId = do
inALbum <- runDB $ getJust albumId
let newMediaList = mId : albumContent inALbum
runDB $ update albumId [AlbumContent =. newMediaList]
liftIO $ putIndexES (ESMedium mId medium)
return Nothing
else
return $ Just $ fileName file
@ -189,13 +190,13 @@ getUploadR = do
if
I.null albums
then do
setMessage "Please create an album first"
redirect NewAlbumR
else do
(uploadWidget, enctype) <- generateFormPost (bulkUploadForm userId)
formLayout $ do
setTitle "Eidolon :: Upload Medium"
$(widgetFile "bulkUpload")
else do
setMessage "Please create an album first"
redirect NewAlbumR
Nothing -> do
setMessage "You need to be logged in"
redirect LoginR
@ -251,6 +252,7 @@ postUploadR = do
inALbum <- runDB $ getJust inAlbumId
let newMediaList = mId : albumContent inALbum
runDB $ update inAlbumId [AlbumContent =. newMediaList]
liftIO $ putIndexES (ESMedium mId medium)
return Nothing
else
return $ Just $ fileName file

50
Helper.hs
View file

@ -22,6 +22,7 @@ import Model
import Data.Maybe
import Data.List as L
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import Data.Time
@ -35,6 +36,10 @@ import Network.Mail.Mime
import Text.Blaze.Html.Renderer.Utf8
import Graphics.ImageMagick.MagickWand
import Filesystem.Path.CurrentOS
import Database.Bloodhound
import Network.HTTP.Client
import Network.HTTP.Types.Status as S
import Control.Monad (when)
getUserIdFromText :: T.Text -> UserId
getUserIdFromText tempUserId =
@ -195,3 +200,48 @@ multiFileField = Field
|]
, fieldEnctype = Multipart
}
-- <putIndexES :: ESInput -> Handler ()
putIndexES input = do
resp <- case input of
ESUser uId user -> do
_ <- runBH' $ createIndex defaultIndexSettings (IndexName "user")
_ <- runBH' $ openIndex (IndexName "user")
runBH' $ indexDocument (IndexName "user") (MappingName "object") defaultIndexDocumentSettings user (DocId $ extractKey uId)
ESAlbum aId album -> do
_ <- runBH' $ createIndex defaultIndexSettings (IndexName "album")
_ <- runBH' $ openIndex (IndexName "album")
runBH' $ indexDocument (IndexName "album") (MappingName "object") defaultIndexDocumentSettings album (DocId $ extractKey aId)
ESMedium mId medium -> do
_ <- runBH' $ createIndex defaultIndexSettings (IndexName "medium")
_ <- runBH' $ openIndex (IndexName "medium")
runBH' $ indexDocument (IndexName "medium") (MappingName "object") defaultIndexDocumentSettings medium (DocId $ extractKey mId)
ESComment cId comment -> do
_ <- runBH' $ createIndex defaultIndexSettings (IndexName "comment")
_ <- runBH' $ openIndex (IndexName "comment")
runBH' $ indexDocument (IndexName "comment") (MappingName "object") defaultIndexDocumentSettings comment (DocId $ extractKey cId)
case statusCode (responseStatus resp) of
201 -> return ()
-- 200 -> return ()
_ -> error $ C.unpack $ BL.toStrict $ responseBody resp
-- deleteIndexES :: ESInput -> Handler ()
deleteIndexES input = do
resp <- case input of
ESUser uId user ->
runBH' $ deleteDocument (IndexName "user") (MappingName "") (DocId $ extractKey uId)
ESAlbum aId album ->
runBH' $ deleteDocument (IndexName "album") (MappingName "") (DocId $ extractKey aId)
ESMedium mId medium ->
runBH' $ deleteDocument (IndexName "medium") (MappingName "") (DocId $ extractKey mId)
ESComment cId comment ->
runBH' $ deleteDocument (IndexName "comment") (MappingName "") (DocId $ extractKey cId)
case statusCode (responseStatus resp) of
201 -> return ()
-- 200 -> return ()
_ -> error $ C.unpack $ BL.toStrict $ responseBody resp
runBH' action = do
let server = Server "http://localhost:9200"
manager <- newManager defaultManagerSettings
runBH (BHEnv server manager) action

87
Model.hs
View file

@ -17,7 +17,7 @@
module Model where
import ClassyPrelude.Yesod
import Yesod.Markdown (Markdown)
import Yesod.Markdown (Markdown, unMarkdown)
import Database.Persist.Quasi
import qualified System.FilePath as FP
@ -27,3 +27,88 @@ 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)
]

2
config/routes
View file

@ -70,3 +70,5 @@
/feed/user/#UserId/rss.xml UserFeedRssR GET
!/feed/user/#Text/atom.xml NameFeedAtomR GET
!/feed/user/#Text/rss.xml NameFeedRssR GET
/search SearchR GET

6
eidolon.cabal
View file

@ -1,5 +1,5 @@
name: eidolon
version: 0.0.4
version: 0.0.5
synopsis: Image gallery in Yesod
homepage: https://eidolon.nek0.eu
license: AGPL-3
@ -50,6 +50,7 @@ library
Handler.Tag
Handler.RootFeed
Handler.Commons
Handler.Search
if flag(dev) || flag(library-only)
cpp-options: -DDEVELOPMENT
@ -114,6 +115,8 @@ library
, wai >= 3.0
, yesod-newsfeed >= 1.5
, unix >= 2.7
, bloodhound >= 0.8
, http-types
-- for Migrations
, HDBC
, HDBC-postgresql
@ -122,6 +125,7 @@ library
, filepath
, system-filepath
, bytestring
, http-client
executable eidolon
if flag(library-only)

13
templates/search.hamlet Executable file
View file

@ -0,0 +1,13 @@
<div #header .item data-width="400">
<div .inner>
<form method=GET action=@{SearchR}>
^{widget}
<input type="submit" value="Search">
$if not $ C.null searchResults
<div #header .item data-width="400">
<div .inner>
<h1>
Results:
<p>
#{C.unpack searchResults}