From 6c40597ae819ffeb5ebb7bf53ee0323ce618f3d9 Mon Sep 17 00:00:00 2001 From: nek0 Date: Fri, 16 Oct 2015 15:32:47 +0200 Subject: [PATCH] starting out with elasticsearch. not working for now --- Application.hs | 1 + Handler/Activate.hs | 2 + Handler/AlbumSettings.hs | 3 ++ Handler/Medium.hs | 8 +++- Handler/MediumSettings.hs | 3 ++ Handler/NewAlbum.hs | 2 + Handler/ProfileDelete.hs | 2 + Handler/ProfileSettings.hs | 1 + Handler/Search.hs | 30 +++++++++++++ Handler/Upload.hs | 8 ++-- Helper.hs | 50 ++++++++++++++++++++++ Model.hs | 87 +++++++++++++++++++++++++++++++++++++- config/routes | 2 + eidolon.cabal | 6 ++- templates/search.hamlet | 13 ++++++ 15 files changed, 211 insertions(+), 7 deletions(-) create mode 100755 Handler/Search.hs create mode 100755 templates/search.hamlet diff --git a/Application.hs b/Application.hs index 1b9d815..fc43a51 100755 --- a/Application.hs +++ b/Application.hs @@ -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 diff --git a/Handler/Activate.hs b/Handler/Activate.hs index 13ac7ee..ed7d1fe 100755 --- a/Handler/Activate.hs +++ b/Handler/Activate.hs @@ -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 diff --git a/Handler/AlbumSettings.hs b/Handler/AlbumSettings.hs index e72d838..39d0232 100755 --- a/Handler/AlbumSettings.hs +++ b/Handler/AlbumSettings.hs @@ -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 diff --git a/Handler/Medium.hs b/Handler/Medium.hs index 65deee1..2b77b88 100755 --- a/Handler/Medium.hs +++ b/Handler/Medium.hs @@ -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 diff --git a/Handler/MediumSettings.hs b/Handler/MediumSettings.hs index f5991ff..9a71d91 100755 --- a/Handler/MediumSettings.hs +++ b/Handler/MediumSettings.hs @@ -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 diff --git a/Handler/NewAlbum.hs b/Handler/NewAlbum.hs index 8959e47..5ea5a78 100755 --- a/Handler/NewAlbum.hs +++ b/Handler/NewAlbum.hs @@ -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 diff --git a/Handler/ProfileDelete.hs b/Handler/ProfileDelete.hs index 339d71e..d9351f0 100755 --- a/Handler/ProfileDelete.hs +++ b/Handler/ProfileDelete.hs @@ -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 diff --git a/Handler/ProfileSettings.hs b/Handler/ProfileSettings.hs index 027285d..19f438f 100755 --- a/Handler/ProfileSettings.hs +++ b/Handler/ProfileSettings.hs @@ -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 diff --git a/Handler/Search.hs b/Handler/Search.hs new file mode 100755 index 0000000..39b25e4 --- /dev/null +++ b/Handler/Search.hs @@ -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 diff --git a/Handler/Upload.hs b/Handler/Upload.hs index 8a5257d..63ccdbe 100755 --- a/Handler/Upload.hs +++ b/Handler/Upload.hs @@ -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 diff --git a/Helper.hs b/Helper.hs index ea718cd..d9f055c 100755 --- a/Helper.hs +++ b/Helper.hs @@ -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 } + +-- 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 diff --git a/Model.hs b/Model.hs index 515796b..2b292ac 100755 --- a/Model.hs +++ b/Model.hs @@ -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) + ] diff --git a/config/routes b/config/routes index 4a15a38..5c1e0e8 100755 --- a/config/routes +++ b/config/routes @@ -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 diff --git a/eidolon.cabal b/eidolon.cabal index 2275b8b..63db7ea 100755 --- a/eidolon.cabal +++ b/eidolon.cabal @@ -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) diff --git a/templates/search.hamlet b/templates/search.hamlet new file mode 100755 index 0000000..7eff1b5 --- /dev/null +++ b/templates/search.hamlet @@ -0,0 +1,13 @@ +
+
+
+ ^{widget} + + +$if not $ C.null searchResults +
+
+

+ Results: +

+ #{C.unpack searchResults}