starting out with elasticsearch. not working for now

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

@ -22,6 +22,7 @@ import Model
import Data.Maybe import Data.Maybe
import Data.List as L import Data.List as L
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time import Data.Time
@ -35,6 +36,10 @@ import Network.Mail.Mime
import Text.Blaze.Html.Renderer.Utf8 import Text.Blaze.Html.Renderer.Utf8
import Graphics.ImageMagick.MagickWand import Graphics.ImageMagick.MagickWand
import Filesystem.Path.CurrentOS 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 :: T.Text -> UserId
getUserIdFromText tempUserId = getUserIdFromText tempUserId =
@ -195,3 +200,48 @@ multiFileField = Field
|] |]
, fieldEnctype = Multipart , 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

View file

@ -17,7 +17,7 @@
module Model where module Model where
import ClassyPrelude.Yesod import ClassyPrelude.Yesod
import Yesod.Markdown (Markdown) import Yesod.Markdown (Markdown, unMarkdown)
import Database.Persist.Quasi import Database.Persist.Quasi
import qualified System.FilePath as FP import qualified System.FilePath as FP
@ -27,3 +27,88 @@ import qualified System.FilePath as FP
-- http://www.yesodweb.com/book/persistent/ -- http://www.yesodweb.com/book/persistent/
share [mkPersist sqlSettings, mkMigrate "migrateAll"] share [mkPersist sqlSettings, mkMigrate "migrateAll"]
$(persistFileWith lowerCaseSettings "config/models") $(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

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

View file

@ -1,5 +1,5 @@
name: eidolon name: eidolon
version: 0.0.4 version: 0.0.5
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
@ -50,6 +50,7 @@ library
Handler.Tag Handler.Tag
Handler.RootFeed Handler.RootFeed
Handler.Commons Handler.Commons
Handler.Search
if flag(dev) || flag(library-only) if flag(dev) || flag(library-only)
cpp-options: -DDEVELOPMENT cpp-options: -DDEVELOPMENT
@ -114,6 +115,8 @@ library
, wai >= 3.0 , wai >= 3.0
, yesod-newsfeed >= 1.5 , yesod-newsfeed >= 1.5
, unix >= 2.7 , unix >= 2.7
, bloodhound >= 0.8
, http-types
-- for Migrations -- for Migrations
, HDBC , HDBC
, HDBC-postgresql , HDBC-postgresql
@ -122,6 +125,7 @@ library
, filepath , filepath
, system-filepath , system-filepath
, bytestring , bytestring
, http-client
executable eidolon executable eidolon
if flag(library-only) 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}