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

moved elastcsearch stuff to Handler.Commons

Browse source
This commit is contained in:
nek0 2015-10-18 01:28:25 +02:00
parent ba8db39c75
commit bc5b5ac064
15 changed files with 124 additions and 111 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
Handler/Activate.hs
View file

@ -16,6 +16,7 @@
module Handler.Activate where module Handler.Activate where
import Import as I hiding (returnJson) import Import as I hiding (returnJson)
import Handler.Commons
import Data.Text import Data.Text
import Data.Text.Encoding import Data.Text.Encoding
import Data.Maybe import Data.Maybe
@ -74,7 +75,7 @@ postActivateR token = do
liftIO $ createDirectoryIfMissing True $ liftIO $ createDirectoryIfMissing True $
"static" </> "data" </> unpack (extractKey uId) "static" </> "data" </> unpack (extractKey uId)
-- input user to elasticsearch -- input user to elasticsearch
liftIO $ putIndexES (ESUser uId $ activatorUser activ) putIndexES (ESUser uId $ activatorUser activ)
-- cleanup -- cleanup
runDB $ delete aId runDB $ delete aId
runDB $ delete uTokenId runDB $ delete uTokenId

10
Handler/AdminAlbumSettings.hs
View file

@ -97,7 +97,7 @@ postAdminAlbumSettingsR albumId = do
, AlbumSamplePic =. albumSamplePic temp , AlbumSamplePic =. albumSamplePic temp
, AlbumSampleWidth =. width , AlbumSampleWidth =. width
] ]
liftIO $ putIndexES (ESAlbum albumId temp) putIndexES (ESAlbum albumId temp)
setMessage "Album settings changed successfully" setMessage "Album settings changed successfully"
redirect AdminR redirect AdminR
_ -> do _ -> do
@ -150,18 +150,18 @@ getAdminAlbumDeleteR albumId = do
children <- runDB $ selectList [CommentParent ==. (Just $ entityKey c)] [] children <- runDB $ selectList [CommentParent ==. (Just $ entityKey c)] []
_ <- mapM (\child -> do _ <- mapM (\child -> do
-- delete comment children from elasticsearch and db -- delete comment children from elasticsearch and db
liftIO $ deleteIndexES (ESComment (entityKey child) (entityVal child)) deleteIndexES (ESComment (entityKey child) (entityVal child))
runDB $ delete $ entityKey child runDB $ delete $ entityKey child
) children ) children
liftIO $ deleteIndexES (ESComment (entityKey c) (entityVal c)) deleteIndexES (ESComment (entityKey c) (entityVal c))
runDB $ delete $ entityKey c) commEnts runDB $ delete $ entityKey c) commEnts
-- delete album from elasticsearch -- delete album from elasticsearch
liftIO $ deleteIndexES (ESAlbum albumId album) deleteIndexES (ESAlbum albumId album)
-- delete album database entry -- delete album database entry
runDB $ delete a runDB $ delete a
) (albumContent album) ) (albumContent album)
-- delete from elasticsearch -- delete from elasticsearch
liftIO $ deleteIndexES (ESAlbum albumId album) deleteIndexES (ESAlbum albumId album)
-- delete album -- delete album
runDB $ delete albumId runDB $ delete albumId
-- delete files -- delete files

4
Handler/AdminComments.hs
View file

@ -47,10 +47,10 @@ getAdminCommentDeleteR commentId = do
-- delete comment children -- delete comment children
children <- runDB $ selectList [CommentParent ==. Just commentId] [] children <- runDB $ selectList [CommentParent ==. Just commentId] []
_ <- mapM (\child -> do _ <- mapM (\child -> do
liftIO $ deleteIndexES (ESComment (entityKey child) (entityVal child)) deleteIndexES (ESComment (entityKey child) (entityVal child))
runDB $ delete $ entityKey child) children runDB $ delete $ entityKey child) children
-- delete comment itself -- delete comment itself
liftIO $ deleteIndexES (ESComment commentId comment) deleteIndexES (ESComment commentId comment)
runDB $ delete commentId runDB $ delete commentId
setMessage "Comment deleted succesfully" setMessage "Comment deleted succesfully"
redirect AdminR redirect AdminR

8
Handler/AdminMediumSettings.hs
View file

@ -71,7 +71,7 @@ postAdminMediumSettingsR mediumId = do
, MediumDescription =. mediumDescription temp , MediumDescription =. mediumDescription temp
, MediumTags =. mediumTags temp , MediumTags =. mediumTags temp
] ]
liftIO $ putIndexES $ ESMedium mediumId temp putIndexES $ ESMedium mediumId temp
setMessage "Medium settings changed successfully" setMessage "Medium settings changed successfully"
redirect AdminR redirect AdminR
_ -> do _ -> do
@ -120,13 +120,13 @@ getAdminMediumDeleteR mediumId = do
children <- runDB $ selectList [CommentParent ==. (Just $ entityKey ent)] [] children <- runDB $ selectList [CommentParent ==. (Just $ entityKey ent)] []
_ <- mapM (\child -> do _ <- mapM (\child -> do
-- delete comment children -- delete comment children
liftIO $ deleteIndexES $ ESComment (entityKey child) (entityVal child) deleteIndexES $ ESComment (entityKey child) (entityVal child)
runDB $ delete $ entityKey child runDB $ delete $ entityKey child
) children ) children
liftIO $ deleteIndexES $ ESComment (entityKey ent) (entityVal ent) deleteIndexES $ ESComment (entityKey ent) (entityVal ent)
runDB $ delete $ entityKey ent) commEnts runDB $ delete $ entityKey ent) commEnts
-- delete medium -- delete medium
liftIO $ deleteIndexES $ ESMedium mediumId medium deleteIndexES $ ESMedium mediumId medium
runDB $ delete mediumId runDB $ delete mediumId
-- delete files -- delete files
liftIO $ removeFile (normalise $ tail $ mediumPath medium) liftIO $ removeFile (normalise $ tail $ mediumPath medium)

10
Handler/AdminProfileSettings.hs
View file

@ -113,7 +113,7 @@ postAdminProfileSettingsR ownerId = do
, UserEmail =. userEmail temp , UserEmail =. userEmail temp
, UserAdmin =. userAdmin temp , UserAdmin =. userAdmin temp
] ]
liftIO $ putIndexES $ ESUser ownerId temp putIndexES $ ESUser ownerId temp
setMessage "User data updated successfully" setMessage "User data updated successfully"
redirect AdminR redirect AdminR
_ -> do _ -> do
@ -156,7 +156,7 @@ getAdminProfileDeleteR ownerId = do
children <- runDB $ selectList [CommentParent ==. (Just $ entityKey ent)] [] children <- runDB $ selectList [CommentParent ==. (Just $ entityKey ent)] []
_ <- mapM (\child -> do _ <- mapM (\child -> do
-- delete comment children -- delete comment children
liftIO $ deleteIndexES $ ESComment (entityKey child) (entityVal child) deleteIndexES $ ESComment (entityKey child) (entityVal child)
runDB $ delete $ entityKey child runDB $ delete $ entityKey child
) children ) children
runDB $ delete $ entityKey ent) commEnts runDB $ delete $ entityKey ent) commEnts
@ -166,13 +166,13 @@ getAdminProfileDeleteR ownerId = do
liftIO $ removeFile (normalise $ L.tail $ mediumThumb medium) liftIO $ removeFile (normalise $ L.tail $ mediumThumb medium)
-- delete medium database entry and search -- delete medium database entry and search
ium <- runDB $ getJust med ium <- runDB $ getJust med
liftIO $ deleteIndexES $ ESMedium med ium deleteIndexES $ ESMedium med ium
runDB $ delete med runDB $ delete med
) mediaList ) mediaList
liftIO $ deleteIndexES $ ESAlbum albumId album deleteIndexES $ ESAlbum albumId album
runDB $ delete albumId runDB $ delete albumId
) albumList ) albumList
liftIO $ deleteIndexES $ ESUser ownerId owner deleteIndexES $ ESUser ownerId owner
runDB $ delete ownerId runDB $ delete ownerId
liftIO $ removeDirectoryRecursive $ "static" </> "data" </> T.unpack (extractKey ownerId) liftIO $ removeDirectoryRecursive $ "static" </> "data" </> T.unpack (extractKey ownerId)
setMessage "User successfully deleted" setMessage "User successfully deleted"

11
Handler/AlbumSettings.hs
View file

@ -17,6 +17,7 @@
module Handler.AlbumSettings where module Handler.AlbumSettings where
import Import import Import
import Handler.Commons
import qualified Data.Text as T import qualified Data.Text as T
import Data.Maybe import Data.Maybe
import System.Directory import System.Directory
@ -110,7 +111,7 @@ postAlbumSettingsR albumId = do
, AlbumSamplePic =. albumSamplePic temp , AlbumSamplePic =. albumSamplePic temp
, AlbumSampleWidth =. width , AlbumSampleWidth =. width
] ]
liftIO $ putIndexES (ESAlbum albumId temp) putIndexES (ESAlbum albumId temp)
setMessage "Album settings changed succesfully" setMessage "Album settings changed succesfully"
redirect $ AlbumR albumId redirect $ AlbumR albumId
_ -> do _ -> do
@ -196,18 +197,18 @@ postAlbumDeleteR albumId = do
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)
-- delete medium from elasticsearch -- delete medium from elasticsearch
liftIO $ deleteIndexES (ESMedium a medium) deleteIndexES (ESMedium a medium)
-- delete comments -- delete comments
commEnts <- runDB $ selectList [CommentOrigin ==. a] [] commEnts <- runDB $ selectList [CommentOrigin ==. a] []
_ <- mapM (\c -> do _ <- mapM (\c -> do
children <- runDB $ selectList [CommentParent ==. (Just $ entityKey c)] [] children <- runDB $ selectList [CommentParent ==. (Just $ entityKey c)] []
_ <- mapM (\child -> do _ <- mapM (\child -> do
-- delete comment children from elasticsearch and db -- delete comment children from elasticsearch and db
liftIO $ deleteIndexES (ESComment (entityKey child) (entityVal child)) deleteIndexES (ESComment (entityKey child) (entityVal child))
runDB $ delete $ entityKey child runDB $ delete $ entityKey child
) children ) children
-- delete comment from elasticsearch -- delete comment from elasticsearch
liftIO $ deleteIndexES (ESComment (entityKey c) (entityVal c)) deleteIndexES (ESComment (entityKey c) (entityVal c))
runDB $ delete $ entityKey c) commEnts runDB $ delete $ entityKey c) commEnts
runDB $ delete a runDB $ delete a
) (albumContent album) ) (albumContent album)
@ -216,7 +217,7 @@ postAlbumDeleteR albumId = do
-- 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 -- delete from elasticsearch
liftIO $ deleteIndexES (ESAlbum albumId album) deleteIndexES (ESAlbum albumId album)
-- outro -- outro
setMessage "Album deleted succesfully" setMessage "Album deleted succesfully"
redirect HomeR redirect HomeR

77
Handler/Commons.hs
View file

@ -18,6 +18,14 @@ module Handler.Commons where
import Import import Import
import Data.String import Data.String
import Database.Bloodhound
import Control.Monad (when)
import Network.HTTP.Client
import Network.HTTP.Types.Status as S
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
loginIsAdmin :: IsString t => Handler (Either (t, Route App) ()) loginIsAdmin :: IsString t => Handler (Either (t, Route App) ())
loginIsAdmin = do loginIsAdmin = do
@ -78,3 +86,72 @@ mediumCheck mediumId = do
return $ Left ("You must be logged in to change settings", LoginR) return $ Left ("You must be logged in to change settings", LoginR)
Nothing -> Nothing ->
return $ Left ("This medium does not exist", HomeR) return $ Left ("This medium does not exist", HomeR)
putIndexES :: ESInput -> Handler ()
putIndexES input = do
master <- getYesod
let shards = appShards $ appSettings master
let replicas = appReplicas $ appSettings master
let is = IndexSettings (ShardCount shards) (ReplicaCount replicas)
resp <- case input of
ESUser uId user -> do
ex <- runBH' $ indexExists (IndexName "user")
when (not ex) ((\ _ -> do
runBH' $ createIndex is (IndexName "user")
return ()
) ex)
_ <- runBH' $ openIndex (IndexName "user")
runBH' $ indexDocument (IndexName "user") (MappingName "user") defaultIndexDocumentSettings user (DocId $ extractKey uId)
ESAlbum aId album -> do
ex <- runBH' $ indexExists (IndexName "album")
when (not ex) ((\ _ -> do
runBH' $ createIndex is (IndexName "album")
return ()
) ex)
_ <- runBH' $ openIndex (IndexName "album")
runBH' $ indexDocument (IndexName "album") (MappingName "album") defaultIndexDocumentSettings album (DocId $ extractKey aId)
ESMedium mId medium -> do
ex <- runBH' $ indexExists (IndexName "medium")
when (not ex) ((\ _ -> do
runBH' $ createIndex is (IndexName "medium")
return ()
) ex)
_ <- runBH' $ openIndex (IndexName "medium")
runBH' $ indexDocument (IndexName "medium") (MappingName "medium") defaultIndexDocumentSettings medium (DocId $ extractKey mId)
ESComment cId comment -> do
ex <- runBH' $ indexExists (IndexName "comment")
when (not ex) ((\ _ -> do
runBH' $ createIndex is (IndexName "comment")
return ()
) ex)
_ <- runBH' $ openIndex (IndexName "comment")
runBH' $ indexDocument (IndexName "comment") (MappingName "comment") 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 "user") (DocId $ extractKey uId)
ESAlbum aId album ->
runBH' $ deleteDocument (IndexName "album") (MappingName "album") (DocId $ extractKey aId)
ESMedium mId medium ->
runBH' $ deleteDocument (IndexName "medium") (MappingName "medium") (DocId $ extractKey mId)
ESComment cId comment ->
runBH' $ deleteDocument (IndexName "comment") (MappingName "comment") (DocId $ extractKey cId)
case statusCode (responseStatus resp) of
201 -> return ()
200 -> return ()
_ -> error $ C.unpack $ BL.toStrict $ responseBody resp
-- runBH' :: BH m a -> Handler resp
runBH' action = do
master <- getYesod
let s = appSearchHost $ appSettings master
let p = show $ appSearchPort $ appSettings master
let server = Server $ T.pack $ (T.unpack s) ++ ":" ++ show p
manager <- liftIO $ newManager defaultManagerSettings
runBH (BHEnv server manager) action

9
Handler/Medium.hs
View file

@ -17,6 +17,7 @@
module Handler.Medium where module Handler.Medium where
import Import import Import
import Handler.Commons
import Data.Time import Data.Time
import Data.Maybe import Data.Maybe
import qualified Data.Text as T import qualified Data.Text as T
@ -86,7 +87,7 @@ postMediumR mediumId = do
case res of case res of
FormSuccess temp -> do FormSuccess temp -> do
cId <- runDB $ insert temp cId <- runDB $ insert temp
liftIO $ putIndexES (ESComment cId temp) 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
@ -160,7 +161,7 @@ postCommentReplyR commentId = do
case res of case res of
FormSuccess temp -> do FormSuccess temp -> do
cId <- runDB $ insert temp cId <- runDB $ insert temp
liftIO $ putIndexES (ESComment cId temp) 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
@ -244,12 +245,12 @@ postCommentDeleteR commentId = do
childEnts <- runDB $ selectList [CommentParent ==. (Just commentId)] [] childEnts <- runDB $ selectList [CommentParent ==. (Just commentId)] []
_ <- mapM (\ent -> do _ <- mapM (\ent -> do
-- delete comment children from elasticsearch -- delete comment children from elasticsearch
liftIO $ deleteIndexES (ESComment (entityKey ent) (entityVal ent)) deleteIndexES (ESComment (entityKey ent) (entityVal ent))
runDB $ delete $ entityKey ent) childEnts runDB $ delete $ entityKey ent) childEnts
-- delete comment itself -- delete comment itself
runDB $ delete commentId runDB $ delete commentId
-- delete from elasticsearch -- delete from elasticsearch
liftIO $ deleteIndexES (ESComment commentId comment) 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

4
Handler/MediumSettings.hs
View file

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

3
Handler/NewAlbum.hs
View file

@ -17,6 +17,7 @@
module Handler.NewAlbum where module Handler.NewAlbum where
import Import import Import
import Handler.Commons
import Data.Text import Data.Text
import System.Directory import System.Directory
import System.FilePath import System.FilePath
@ -54,7 +55,7 @@ postNewAlbumR = do
-- 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 -- update elasticsearch
liftIO $ putIndexES (ESAlbum albumId album) putIndexES (ESAlbum albumId album)
-- outro -- outro
setMessage "Album successfully created" setMessage "Album successfully created"
redirect $ ProfileR userId redirect $ ProfileR userId

12
Handler/ProfileDelete.hs
View file

@ -55,26 +55,24 @@ postProfileDeleteR userId = do
children <- runDB $ selectList [CommentParent ==. (Just $ entityKey ent)] [] children <- runDB $ selectList [CommentParent ==. (Just $ entityKey ent)] []
_ <- mapM (\child -> do _ <- mapM (\child -> do
-- delete comment children -- delete comment children
liftIO $ deleteIndexES $ ESComment (entityKey child) (entityVal child) deleteIndexES $ ESComment (entityKey child) (entityVal child)
runDB $ delete $ entityKey child runDB $ delete $ entityKey child
) children ) children
-- delete comment -- delete comment
liftIO $ deleteIndexES $ ESComment (entityKey ent) (entityVal ent) deleteIndexES $ ESComment (entityKey ent) (entityVal ent)
runDB $ delete $ entityKey ent) commEnts runDB $ delete $ entityKey ent) 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)
liftIO $ deleteIndexES $ ESMedium med medium deleteIndexES (ESMedium med medium)
runDB $ delete med runDB $ delete med
) mediaList ) mediaList
liftIO $ deleteIndexES $ ESAlbum albumId album deleteIndexES $ ESAlbum albumId album
runDB $ delete albumId runDB $ delete albumId
) albumList ) albumList
liftIO $ deleteIndexES $ ESUser userId user deleteIndexES $ ESUser userId user
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

2
Handler/ProfileSettings.hs
View file

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

9
Handler/Search.hs
View file

@ -1,6 +1,7 @@
module Handler.Search where module Handler.Search where
import Import import Import
import Handler.Commons
import Data.Time.Clock import Data.Time.Clock
import Data.Aeson import Data.Aeson
import Data.Maybe import Data.Maybe
@ -86,10 +87,10 @@ searchForm = renderDivs $ areq (searchField True) "Search" Nothing
getResults :: Text -> Handler (Reply, Reply, Reply, Reply) getResults :: Text -> Handler (Reply, Reply, Reply, Reply)
getResults query = do getResults query = do
let esQuery = QuerySimpleQueryStringQuery (SimpleQueryStringQuery (QueryString query) Nothing Nothing Nothing Nothing Nothing Nothing) let esQuery = QuerySimpleQueryStringQuery (SimpleQueryStringQuery (QueryString query) Nothing Nothing Nothing Nothing Nothing Nothing)
su <- liftIO $ runBH' $ searchByIndex (IndexName "user") $ mkSearch (Just esQuery) Nothing su <- runBH' $ searchByIndex (IndexName "user") $ mkSearch (Just esQuery) Nothing
sa <- liftIO $ runBH' $ searchByIndex (IndexName "album") $ mkSearch (Just esQuery) Nothing sa <- runBH' $ searchByIndex (IndexName "album") $ mkSearch (Just esQuery) Nothing
sm <- liftIO $ runBH' $ searchByIndex (IndexName "medium") $ mkSearch (Just esQuery) Nothing sm <- runBH' $ searchByIndex (IndexName "medium") $ mkSearch (Just esQuery) Nothing
sc <- liftIO $ runBH' $ searchByIndex (IndexName "comment") $ mkSearch (Just esQuery) Nothing sc <- runBH' $ searchByIndex (IndexName "comment") $ mkSearch (Just esQuery) Nothing
return (su, sa, sm, sc) return (su, sa, sm, sc)
data SearchUser = SearchUser data SearchUser = SearchUser

5
Handler/Upload.hs
View file

@ -17,6 +17,7 @@
module Handler.Upload where module Handler.Upload where
import Import as I import Import as I
import Handler.Commons
import Data.Time import Data.Time
import Data.Maybe import Data.Maybe
import qualified Data.Text as T import qualified Data.Text as T
@ -90,7 +91,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) putIndexES (ESMedium mId medium)
return Nothing return Nothing
else else
return $ Just $ fileName file return $ Just $ fileName file
@ -252,7 +253,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) putIndexES (ESMedium mId medium)
return Nothing return Nothing
else else
return $ Just $ fileName file return $ Just $ fileName file

68
Helper.hs
View file

@ -208,71 +208,3 @@ multiFileField = Field
|] |]
, fieldEnctype = Multipart , fieldEnctype = Multipart
} }
putIndexES :: ESInput -> Handler ()
putIndexES input = do
master <- getYesod
shards <- appShards $ appSettings master
replicas <- appReplicas $ appSettings master
let is = return $ IndexSettings (ShardCount shards) (ReplicaCount replicas)
resp <- case input of
ESUser uId user -> do
ex <- runBH' $ indexExists (IndexName "user")
when (not ex) ((\ _ -> do
runBH' $ createIndex is (IndexName "user")
return ()
) ex)
_ <- runBH' $ openIndex (IndexName "user")
runBH' $ indexDocument (IndexName "user") (MappingName "user") defaultIndexDocumentSettings user (DocId $ extractKey uId)
ESAlbum aId album -> do
ex <- runBH' $ indexExists (IndexName "album")
when (not ex) ((\ _ -> do
runBH' $ createIndex is (IndexName "album")
return ()
) ex)
_ <- runBH' $ openIndex (IndexName "album")
runBH' $ indexDocument (IndexName "album") (MappingName "album") defaultIndexDocumentSettings album (DocId $ extractKey aId)
ESMedium mId medium -> do
ex <- runBH' $ indexExists (IndexName "medium")
when (not ex) ((\ _ -> do
runBH' $ createIndex is (IndexName "medium")
return ()
) ex)
_ <- runBH' $ openIndex (IndexName "medium")
runBH' $ indexDocument (IndexName "medium") (MappingName "medium") defaultIndexDocumentSettings medium (DocId $ extractKey mId)
ESComment cId comment -> do
ex <- runBH' $ indexExists (IndexName "comment")
when (not ex) ((\ _ -> do
runBH' $ createIndex is (IndexName "comment")
return ()
) ex)
_ <- runBH' $ openIndex (IndexName "comment")
runBH' $ indexDocument (IndexName "comment") (MappingName "comment") 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 "user") (DocId $ extractKey uId)
ESAlbum aId album ->
runBH' $ deleteDocument (IndexName "album") (MappingName "album") (DocId $ extractKey aId)
ESMedium mId medium ->
runBH' $ deleteDocument (IndexName "medium") (MappingName "medium") (DocId $ extractKey mId)
ESComment cId comment ->
runBH' $ deleteDocument (IndexName "comment") (MappingName "comment") (DocId $ extractKey cId)
case statusCode (responseStatus resp) of
201 -> return ()
200 -> return ()
_ -> error $ C.unpack $ BL.toStrict $ responseBody resp
runBH' action = do
master <- getYesod
server <- appSearchHost $ appSettings master
port <- return . show =<< (appSearchPort $ appSettings master)
let server = Server $ server ++ ":" ++ port
manager <- newManager defaultManagerSettings
runBH (BHEnv server manager) action