1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE RecordWildCards #-}
4-------------------------------------------------------------------------------
6-- Module : Database.Bloodhound.Client
7-- Copyright : (C) 2014 Chris Allen
8-- License : BSD-style (see the file LICENSE)
9-- Maintainer : Chris Allen <cma@bitemyapp.com
10-- Stability : provisional
11-- Portability : OverloadedStrings
13-- Client side functions for talking to Elasticsearch servers.
15-------------------------------------------------------------------------------
17module Database.Bloodhound.Client
18 ( -- * Bloodhound client functions
19 -- | The examples in this module assume the following code has been run.
20 -- The :{ and :} will only work in GHCi. You'll only need the data types
21 -- and typeclass instances for the functions that make use of them.
58 , encodeBulkOperations
60 -- * Reply-handling tools
68import qualified Blaze.ByteString.Builder as BB
69import Control.Applicative
71import Control.Monad.Catch
72import Control.Monad.IO.Class
74import Data.ByteString.Lazy.Builder
75import qualified Data.ByteString.Lazy.Char8 as L
76import Data.Foldable (toList)
77import qualified Data.HashMap.Strict as HM
79import qualified Data.List as LS (filter, foldl')
80import Data.List.NonEmpty (NonEmpty (..))
81import Data.Maybe (fromMaybe, isJust)
83import Data.Text (Text)
84import qualified Data.Text as T
85import qualified Data.Text.Encoding as T
87import qualified Data.Vector as V
88import Network.HTTP.Client
89import qualified Network.HTTP.Types.Method as NHTM
90import qualified Network.HTTP.Types.Status as NHTS
91import qualified Network.HTTP.Types.URI as NHTU
92import qualified Network.URI as URI
93import Prelude hiding (filter, head)
95import Database.Bloodhound.Types
98-- >>> :set -XOverloadedStrings
99-- >>> :set -XDeriveGeneric
100-- >>> import Database.Bloodhound
101-- >>> import Test.DocTest.Prop (assert)
102-- >>> let testServer = (Server "http://localhost:9200")
103-- >>> let runBH' = withBH defaultManagerSettings testServer
104-- >>> let testIndex = IndexName "twitter"
105-- >>> let testMapping = MappingName "tweet"
106-- >>> let defaultIndexSettings = IndexSettings (ShardCount 1) (ReplicaCount 0)
107-- >>> data TweetMapping = TweetMapping deriving (Eq, Show)
108-- >>> _ <- runBH' $ deleteIndex testIndex >> deleteMapping testIndex testMapping
109-- >>> import GHC.Generics
110-- >>> import Data.Time.Calendar (Day (..))
111-- >>> import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
113--instance ToJSON TweetMapping where
114-- toJSON TweetMapping =
116-- object ["properties" .=
117-- object ["location" .=
118-- object ["type" .= ("geo_point" :: Text)]]]]
119--data Location = Location { lat :: Double
120-- , lon :: Double } deriving (Eq, Generic, Show)
121--data Tweet = Tweet { user :: Text
122-- , postDate :: UTCTime
125-- , location :: Location } deriving (Eq, Generic, Show)
126--exampleTweet = Tweet { user = "bitemyapp"
127-- , postDate = UTCTime
128-- (ModifiedJulianDay 55000)
129-- (secondsToDiffTime 10)
130-- , message = "Use haskell!"
132-- , location = Location 40.12 (-71.34) }
133--instance ToJSON Tweet where
134-- toJSON = genericToJSON defaultOptions
135--instance FromJSON Tweet where
136-- parseJSON = genericParseJSON defaultOptions
137--instance ToJSON Location where
138-- toJSON = genericToJSON defaultOptions
139--instance FromJSON Location where
140-- parseJSON = genericParseJSON defaultOptions
141--data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
142--instance FromJSON BulkTest where
143-- parseJSON = genericParseJSON defaultOptions
144--instance ToJSON BulkTest where
145-- toJSON = genericToJSON defaultOptions
148-- | 'mkShardCount' is a straight-forward smart constructor for 'ShardCount'
149-- which rejects 'Int' values below 1 and above 1000.
151-- >>> mkShardCount 10
152-- Just (ShardCount 10)
153mkShardCount :: Int -> Maybe ShardCount
157 | otherwise = Just (ShardCount n)
159-- | 'mkReplicaCount' is a straight-forward smart constructor for 'ReplicaCount'
160-- which rejects 'Int' values below 1 and above 1000.
162-- >>> mkReplicaCount 10
163-- Just (ReplicaCount 10)
164mkReplicaCount :: Int -> Maybe ReplicaCount
167 | n > 1000 = Nothing -- ...
168 | otherwise = Just (ReplicaCount n)
170emptyBody :: L.ByteString
173dispatch :: MonadBH m => Method -> Text -> Maybe L.ByteString
175dispatch dMethod url body = do
176 initReq <- liftIO $ parseUrl' url
177 let reqBody = RequestBodyLBS $ fromMaybe emptyBody body
178 let req = initReq { method = dMethod
179 , requestBody = reqBody
180 , checkStatus = \_ _ _ -> Nothing}
181 mgr <- bhManager <$> getBHEnv
182 liftIO $ httpLbs req mgr
184joinPath' :: [Text] -> Text
185joinPath' = T.intercalate "/"
187joinPath :: MonadBH m => [Text] -> m Text
189 Server s <- bhServer <$> getBHEnv
190 return $ joinPath' (s:ps)
192appendSearchTypeParam :: Text -> SearchType -> Text
193appendSearchTypeParam originalUrl st = addQuery params originalUrl
194 where stText = "search_type"
196 | st == SearchTypeDfsQueryThenFetch = [(stText, Just "dfs_query_then_fetch")]
197 | st == SearchTypeCount = [(stText, Just "count")]
198 | st == SearchTypeScan = [(stText, Just "scan"), ("scroll", Just "1m")]
199 | st == SearchTypeQueryAndFetch = [(stText, Just "query_and_fetch")]
200 | st == SearchTypeDfsQueryAndFetch = [(stText, Just "dfs_query_and_fetch")]
201 -- used to catch 'SearchTypeQueryThenFetch', which is also the default
202 | otherwise = [(stText, Just "query_then_fetch")]
204-- | Severely dumbed down query renderer. Assumes your data doesn't
206addQuery :: [(Text, Maybe Text)] -> Text -> Text
207addQuery q u = u <> rendered
210 T.decodeUtf8 $ BB.toByteString $ NHTU.renderQueryText prependQuestionMark q
211 prependQuestionMark = True
213bindM2 :: (Applicative m, Monad m) => (a -> b -> m c) -> m a -> m b -> m c
214bindM2 f ma mb = join (f <$> ma <*> mb)
216-- | Convenience function that sets up a manager and BHEnv and runs
217-- the given set of bloodhound operations. Connections will be
218-- pipelined automatically in accordance with the given manager
219-- settings in IO. If you've got your own monad transformer stack, you
220-- should use 'runBH' directly.
221withBH :: ManagerSettings -> Server -> BH IO a -> IO a
224 let env = BHEnv { bhServer = s
228-- Shortcut functions for HTTP methods
229delete :: MonadBH m => Text -> m Reply
230delete = flip (dispatch NHTM.methodDelete) Nothing
231get :: MonadBH m => Text -> m Reply
232get = flip (dispatch NHTM.methodGet) Nothing
233head :: MonadBH m => Text -> m Reply
234head = flip (dispatch NHTM.methodHead) Nothing
235put :: MonadBH m => Text -> Maybe L.ByteString -> m Reply
236put = dispatch NHTM.methodPut
237post :: MonadBH m => Text -> Maybe L.ByteString -> m Reply
238post = dispatch NHTM.methodPost
240-- indexDocument s ix name doc = put (root </> s </> ix </> name </> doc) (Just encode doc)
241-- http://hackage.haskell.org/package/http-client-lens-0.1.0/docs/Network-HTTP-Client-Lens.html
242-- https://github.com/supki/libjenkins/blob/master/src/Jenkins/Rest/Internal.hs
244-- | 'getStatus' fetches the 'Status' of a 'Server'
246-- >>> serverStatus <- runBH' getStatus
247-- >>> fmap status (serverStatus)
249getStatus :: MonadBH m => m (Maybe Status)
252 request <- liftIO $ parseUrl' url
253 mgr <- bhManager <$> getBHEnv
254 response <- liftIO $ httpLbs request mgr
255 return $ decode (responseBody response)
257-- | 'createIndex' will create an index given a 'Server', 'IndexSettings', and an 'IndexName'.
259-- >>> response <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
260-- >>> respIsTwoHunna response
262-- >>> runBH' $ indexExists (IndexName "didimakeanindex")
264createIndex :: MonadBH m => IndexSettings -> IndexName -> m Reply
265createIndex indexSettings (IndexName indexName) =
266 bindM2 put url (return body)
267 where url = joinPath [indexName]
268 body = Just $ encode indexSettings
271-- | 'deleteIndex' will delete an index given a 'Server', and an 'IndexName'.
273-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
274-- >>> response <- runBH' $ deleteIndex (IndexName "didimakeanindex")
275-- >>> respIsTwoHunna response
277-- >>> runBH' $ indexExists testIndex
279deleteIndex :: MonadBH m => IndexName -> m Reply
280deleteIndex (IndexName indexName) =
281 delete =<< joinPath [indexName]
283-- | 'updateIndexSettings' will apply a non-empty list of setting updates to an index
285-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "unconfiguredindex")
286-- >>> response <- runBH' $ updateIndexSettings (BlocksWrite False :| []) (IndexName "unconfiguredindex")
287-- >>> respIsTwoHunna response
289updateIndexSettings :: MonadBH m => NonEmpty UpdatableIndexSetting -> IndexName -> m Reply
290updateIndexSettings updates (IndexName indexName) =
291 bindM2 put url (return body)
292 where url = joinPath [indexName, "_settings"]
293 body = Just (encode jsonBody)
294 jsonBody = Object (deepMerge [u | Object u <- toJSON <$> toList updates])
297getIndexSettings :: (MonadBH m, MonadThrow m) => IndexName
298 -> m (Either EsError IndexSettingsSummary)
299getIndexSettings (IndexName indexName) = do
300 parseEsResponse =<< get =<< url
301 where url = joinPath [indexName, "_settings"]
304deepMerge :: [Object] -> Object
305deepMerge = LS.foldl' go mempty
306 where go acc = LS.foldl' go' acc . HM.toList
307 go' acc (k, v) = HM.insertWith merge k v acc
308 merge (Object a) (Object b) = Object (deepMerge [a, b])
312statusCodeIs :: Int -> Reply -> Bool
313statusCodeIs n resp = NHTS.statusCode (responseStatus resp) == n
315respIsTwoHunna :: Reply -> Bool
316respIsTwoHunna = statusCodeIs 200
318existentialQuery :: MonadBH m => Text -> m (Reply, Bool)
319existentialQuery url = do
321 return (reply, respIsTwoHunna reply)
324-- | Tries to parse a response body as the expected type @a@ and
325-- failing that tries to parse it as an EsError. All well-formed, JSON
326-- responses from elasticsearch should fall into these two
327-- categories. If they don't, a 'EsProtocolException' will be
328-- thrown. If you encounter this, please report the full body it
329-- reports along with your ElasticSearch verison.
330parseEsResponse :: (MonadThrow m, FromJSON a) => Reply
331 -> m (Either EsError a)
333 | respIsTwoHunna reply = case eitherDecode body of
334 Right a -> return (Right a)
335 Left _ -> tryParseError
336 | otherwise = tryParseError
337 where body = responseBody reply
338 tryParseError = case eitherDecode body of
339 Right e -> return (Left e)
340 -- this case should not be possible
342 explode = throwM (EsProtocolException body)
344-- | 'indexExists' enables you to check if an index exists. Returns 'Bool'
347-- >>> exists <- runBH' $ indexExists testIndex
348indexExists :: MonadBH m => IndexName -> m Bool
349indexExists (IndexName indexName) = do
350 (_, exists) <- existentialQuery =<< joinPath [indexName]
353-- | 'refreshIndex' will force a refresh on an index. You must
354-- do this if you want to read what you wrote.
356-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
357-- >>> _ <- runBH' $ refreshIndex testIndex
358refreshIndex :: MonadBH m => IndexName -> m Reply
359refreshIndex (IndexName indexName) =
360 bindM2 post url (return Nothing)
361 where url = joinPath [indexName, "_refresh"]
363stringifyOCIndex :: OpenCloseIndex -> Text
364stringifyOCIndex oci = case oci of
366 CloseIndex -> "_close"
368openOrCloseIndexes :: MonadBH m => OpenCloseIndex -> IndexName -> m Reply
369openOrCloseIndexes oci (IndexName indexName) =
370 bindM2 post url (return Nothing)
371 where ociString = stringifyOCIndex oci
372 url = joinPath [indexName, ociString]
374-- | 'openIndex' opens an index given a 'Server' and an 'IndexName'. Explained in further detail at
375-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
377-- >>> reply <- runBH' $ openIndex testIndex
378openIndex :: MonadBH m => IndexName -> m Reply
379openIndex = openOrCloseIndexes OpenIndex
381-- | 'closeIndex' closes an index given a 'Server' and an 'IndexName'. Explained in further detail at
382-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
384-- >>> reply <- runBH' $ closeIndex testIndex
385closeIndex :: MonadBH m => IndexName -> m Reply
386closeIndex = openOrCloseIndexes CloseIndex
389-- | 'updateIndexAliases' updates the server's index alias
390-- table. Operations are atomic. Explained in further detail at
391-- <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-aliases.html>
393-- >>> let src = IndexName "a-real-index"
394-- >>> let aliasName = IndexName "an-alias"
395-- >>> let iAlias = IndexAlias src (IndexAliasName aliasName)
396-- >>> let aliasCreate = IndexAliasCreate Nothing Nothing
397-- >>> respIsTwoHunna <$> runBH' (createIndex defaultIndexSettings src)
399-- >>> runBH' $ indexExists src
401-- >>> respIsTwoHunna <$> runBH' (updateIndexAliases (AddAlias iAlias aliasCreate :| []))
403-- >>> runBH' $ indexExists aliasName
405updateIndexAliases :: MonadBH m => NonEmpty IndexAliasAction -> m Reply
406updateIndexAliases actions = bindM2 post url (return body)
407 where url = joinPath ["_aliases"]
408 body = Just (encode bodyJSON)
409 bodyJSON = object [ "actions" .= toList actions]
411-- | Get all aliases configured on the server.
412getIndexAliases :: (MonadBH m, MonadThrow m)
413 => m (Either EsError IndexAliasesSummary)
414getIndexAliases = parseEsResponse =<< get =<< url
415 where url = joinPath ["_aliases"]
417-- | 'putTemplate' creates a template given an 'IndexTemplate' and a 'TemplateName'.
418-- Explained in further detail at
419-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html>
421-- >>> let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
422-- >>> resp <- runBH' $ putTemplate idxTpl (TemplateName "tweet-tpl")
423putTemplate :: MonadBH m => IndexTemplate -> TemplateName -> m Reply
424putTemplate indexTemplate (TemplateName templateName) =
425 bindM2 put url (return body)
426 where url = joinPath ["_template", templateName]
427 body = Just $ encode indexTemplate
429-- | 'templateExists' checks to see if a template exists.
431-- >>> exists <- runBH' $ templateExists (TemplateName "tweet-tpl")
432templateExists :: MonadBH m => TemplateName -> m Bool
433templateExists (TemplateName templateName) = do
434 (_, exists) <- existentialQuery =<< joinPath ["_template", templateName]
437-- | 'deleteTemplate' is an HTTP DELETE and deletes a template.
439-- >>> let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
440-- >>> _ <- runBH' $ putTemplate idxTpl (TemplateName "tweet-tpl")
441-- >>> resp <- runBH' $ deleteTemplate (TemplateName "tweet-tpl")
442deleteTemplate :: MonadBH m => TemplateName -> m Reply
443deleteTemplate (TemplateName templateName) =
444 delete =<< joinPath ["_template", templateName]
446-- | 'putMapping' is an HTTP PUT and has upsert semantics. Mappings are schemas
447-- for documents in indexes.
449-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
450-- >>> resp <- runBH' $ putMapping testIndex testMapping TweetMapping
452-- Response {responseStatus = Status {statusCode = 200, statusMessage = "OK"}, responseVersion = HTTP/1.1, responseHeaders = [("Content-Type","application/json; charset=UTF-8"),("Content-Length","21")], responseBody = "{\"acknowledged\":true}", responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
453putMapping :: (MonadBH m, ToJSON a) => IndexName
454 -> MappingName -> a -> m Reply
455putMapping (IndexName indexName) (MappingName mappingName) mapping =
456 bindM2 put url (return body)
457 where url = joinPath [indexName, "_mapping", mappingName]
458 -- "_mapping" and mappingName above were originally transposed
459 -- erroneously. The correct API call is: "/INDEX/_mapping/MAPPING_NAME"
460 body = Just $ encode mapping
462-- | 'deleteMapping' is an HTTP DELETE and deletes a mapping for a given index.
463-- Mappings are schemas for documents in indexes.
465-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
466-- >>> _ <- runBH' $ putMapping testIndex testMapping TweetMapping
467-- >>> resp <- runBH' $ deleteMapping testIndex testMapping
469-- Response {responseStatus = Status {statusCode = 200, statusMessage = "OK"}, responseVersion = HTTP/1.1, responseHeaders = [("Content-Type","application/json; charset=UTF-8"),("Content-Length","21")], responseBody = "{\"acknowledged\":true}", responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
470deleteMapping :: MonadBH m => IndexName -> MappingName -> m Reply
471deleteMapping (IndexName indexName)
472 (MappingName mappingName) =
473 -- "_mapping" and mappingName below were originally transposed
474 -- erroneously. The correct API call is: "/INDEX/_mapping/MAPPING_NAME"
475 delete =<< joinPath [indexName, "_mapping", mappingName]
477-- | 'indexDocument' is the primary way to save a single document in
478-- Elasticsearch. The document itself is simply something we can
479-- convert into a JSON 'Value'. The 'DocId' will function as the
480-- primary key for the document.
482-- >>> resp <- runBH' $ indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "1")
484-- Response {responseStatus = Status {statusCode = 201, statusMessage = "Created"}, responseVersion = HTTP/1.1, responseHeaders = [("Content-Type","application/json; charset=UTF-8"),("Content-Length","74")], responseBody = "{\"_index\":\"twitter\",\"_type\":\"tweet\",\"_id\":\"1\",\"_version\":1,\"created\":true}", responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
485indexDocument :: (ToJSON doc, MonadBH m) => IndexName -> MappingName
486 -> IndexDocumentSettings -> doc -> DocId -> m Reply
487indexDocument (IndexName indexName)
488 (MappingName mappingName) cfg document (DocId docId) =
489 bindM2 put url (return body)
490 where url = addQuery params <$> joinPath [indexName, mappingName, docId]
491 versionCtlParams = case idsVersionControl cfg of
492 NoVersionControl -> []
493 InternalVersion v -> versionParams v "internal"
494 ExternalGT (ExternalDocVersion v) -> versionParams v "external_gt"
495 ExternalGTE (ExternalDocVersion v) -> versionParams v "external_gte"
496 ForceVersion (ExternalDocVersion v) -> versionParams v "force"
497 vt = T.pack . show . docVersionNumber
498 versionParams v t = [ ("version", Just $ vt v)
499 , ("version_type", Just t)
501 parentParams = case idsParent cfg of
503 Just (DocumentParent (DocId p)) -> [ ("parent", Just p) ]
504 params = versionCtlParams ++ parentParams
505 body = Just (encode document)
507-- | 'deleteDocument' is the primary way to delete a single document.
509-- >>> _ <- runBH' $ deleteDocument testIndex testMapping (DocId "1")
510deleteDocument :: MonadBH m => IndexName -> MappingName
512deleteDocument (IndexName indexName)
513 (MappingName mappingName) (DocId docId) =
514 delete =<< joinPath [indexName, mappingName, docId]
517-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html Elasticsearch's bulk API>
518-- to perform bulk operations. The 'BulkOperation' data type encodes the
519-- index/update/delete/create operations. You pass a 'V.Vector' of 'BulkOperation's
520-- and a 'Server' to 'bulk' in order to send those operations up to your Elasticsearch
521-- server to be performed. I changed from [BulkOperation] to a Vector due to memory overhead.
523-- >>> let stream = V.fromList [BulkIndex testIndex testMapping (DocId "2") (toJSON (BulkTest "blah"))]
524-- >>> _ <- runBH' $ bulk stream
525-- >>> _ <- runBH' $ refreshIndex testIndex
526bulk :: MonadBH m => V.Vector BulkOperation -> m Reply
527bulk bulkOps = bindM2 post url (return body)
528 where url = joinPath ["_bulk"]
529 body = Just $ encodeBulkOperations bulkOps
531-- | 'encodeBulkOperations' is a convenience function for dumping a vector of 'BulkOperation'
532-- into an 'L.ByteString'
534-- >>> let bulkOps = V.fromList [BulkIndex testIndex testMapping (DocId "2") (toJSON (BulkTest "blah"))]
535-- >>> encodeBulkOperations bulkOps
536-- "\n{\"index\":{\"_type\":\"tweet\",\"_id\":\"2\",\"_index\":\"twitter\"}}\n{\"name\":\"blah\"}\n"
537encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString
538encodeBulkOperations stream = collapsed where
539 blobs = fmap encodeBulkOperation stream
540 mashedTaters = mash (mempty :: Builder) blobs
541 collapsed = toLazyByteString $ mappend mashedTaters (byteString "\n")
543mash :: Builder -> V.Vector L.ByteString -> Builder
544mash = V.foldl' (\b x -> b `mappend` (byteString "\n") `mappend` (lazyByteString x))
546mkBulkStreamValue :: Text -> Text -> Text -> Text -> Value
547mkBulkStreamValue operation indexName mappingName docId =
549 object [ "_index" .= indexName
550 , "_type" .= mappingName
553-- | 'encodeBulkOperation' is a convenience function for dumping a single 'BulkOperation'
554-- into an 'L.ByteString'
556-- >>> let bulkOp = BulkIndex testIndex testMapping (DocId "2") (toJSON (BulkTest "blah"))
557-- >>> encodeBulkOperation bulkOp
558-- "{\"index\":{\"_type\":\"tweet\",\"_id\":\"2\",\"_index\":\"twitter\"}}\n{\"name\":\"blah\"}"
559encodeBulkOperation :: BulkOperation -> L.ByteString
560encodeBulkOperation (BulkIndex (IndexName indexName)
561 (MappingName mappingName)
562 (DocId docId) value) = blob
563 where metadata = mkBulkStreamValue "index" indexName mappingName docId
564 blob = encode metadata `mappend` "\n" `mappend` encode value
566encodeBulkOperation (BulkCreate (IndexName indexName)
567 (MappingName mappingName)
568 (DocId docId) value) = blob
569 where metadata = mkBulkStreamValue "create" indexName mappingName docId
570 blob = encode metadata `mappend` "\n" `mappend` encode value
572encodeBulkOperation (BulkDelete (IndexName indexName)
573 (MappingName mappingName)
574 (DocId docId)) = blob
575 where metadata = mkBulkStreamValue "delete" indexName mappingName docId
576 blob = encode metadata
578encodeBulkOperation (BulkUpdate (IndexName indexName)
579 (MappingName mappingName)
580 (DocId docId) value) = blob
581 where metadata = mkBulkStreamValue "update" indexName mappingName docId
582 doc = object ["doc" .= value]
583 blob = encode metadata `mappend` "\n" `mappend` encode doc
585-- | 'getDocument' is a straight-forward way to fetch a single document from
586-- Elasticsearch using a 'Server', 'IndexName', 'MappingName', and a 'DocId'.
587-- The 'DocId' is the primary key for your Elasticsearch document.
589-- >>> yourDoc <- runBH' $ getDocument testIndex testMapping (DocId "1")
590getDocument :: MonadBH m => IndexName -> MappingName
592getDocument (IndexName indexName)
593 (MappingName mappingName) (DocId docId) =
594 get =<< joinPath [indexName, mappingName, docId]
596-- | 'documentExists' enables you to check if a document exists. Returns 'Bool'
599-- >>> exists <- runBH' $ documentExists testIndex testMapping Nothing (DocId "1")
600documentExists :: MonadBH m => IndexName -> MappingName
601 -> Maybe DocumentParent -> DocId -> m Bool
602documentExists (IndexName indexName) (MappingName mappingName)
603 parent (DocId docId) = do
604 (_, exists) <- existentialQuery =<< url
606 where url = addQuery params <$> joinPath [indexName, mappingName, docId]
607 parentParam = fmap (\(DocumentParent (DocId p)) -> p) parent
608 params = LS.filter (\(_, v) -> isJust v) [("parent", parentParam)]
610dispatchSearch :: MonadBH m => Text -> Search -> m Reply
611dispatchSearch url search = post url' (Just (encode search))
612 where url' = appendSearchTypeParam url (searchType search)
614-- | 'searchAll', given a 'Search', will perform that search against all indexes
615-- on an Elasticsearch server. Try to avoid doing this if it can be helped.
617-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
618-- >>> let search = mkSearch (Just query) Nothing
619-- >>> reply <- runBH' $ searchAll search
620searchAll :: MonadBH m => Search -> m Reply
621searchAll = bindM2 dispatchSearch url . return
622 where url = joinPath ["_search"]
624-- | 'searchByIndex', given a 'Search' and an 'IndexName', will perform that search
625-- against all mappings within an index on an Elasticsearch server.
627-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
628-- >>> let search = mkSearch (Just query) Nothing
629-- >>> reply <- runBH' $ searchByIndex testIndex search
630searchByIndex :: MonadBH m => IndexName -> Search -> m Reply
631searchByIndex (IndexName indexName) = bindM2 dispatchSearch url . return
632 where url = joinPath [indexName, "_search"]
634-- | 'searchByType', given a 'Search', 'IndexName', and 'MappingName', will perform that
635-- search against a specific mapping within an index on an Elasticsearch server.
637-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
638-- >>> let search = mkSearch (Just query) Nothing
639-- >>> reply <- runBH' $ searchByType testIndex testMapping search
640searchByType :: MonadBH m => IndexName -> MappingName -> Search
642searchByType (IndexName indexName)
643 (MappingName mappingName) = bindM2 dispatchSearch url . return
644 where url = joinPath [indexName, mappingName, "_search"]
646-- | For a given scearch, request a scroll for efficient streaming of
647-- search results. Note that the search is put into 'SearchTypeScan'
648-- mode and thus results will not be sorted. Combine this with
649-- 'advanceScroll' to efficiently stream through the full result set
650getInitialScroll :: MonadBH m => IndexName -> MappingName -> Search -> m (Maybe ScrollId)
651getInitialScroll (IndexName indexName) (MappingName mappingName) search = do
652 let url = joinPath [indexName, mappingName, "_search"]
653 search' = search { searchType = SearchTypeScan }
654 resp' <- bindM2 dispatchSearch url (return search')
655 let msr = decode' $ responseBody resp' :: Maybe (SearchResult ())
656 msid = maybe Nothing scrollId msr
659scroll' :: (FromJSON a, MonadBH m, MonadThrow m) => Maybe ScrollId -> m ([Hit a], Maybe ScrollId)
660scroll' Nothing = return ([], Nothing)
661scroll' (Just sid) = do
662 res <- advanceScroll sid 60
664 Right SearchResult {..} -> return (hits searchHits, scrollId)
665 Left _ -> return ([], Nothing)
667-- | Use the given scroll to fetch the next page of documents. If
668-- there are still further pages, there will be a value in the
669-- 'scrollId' field of the 'SearchResult'
677 -- ^ How long should the snapshot of data be kept around? This timeout is updated every time 'advanceScroll' is used, so don't feel the need to set it to the entire duration of your search processing. Note that durations < 1s will be rounded up. Also note that 'NominalDiffTime' is an instance of Num so literals like 60 will be interpreted as seconds. 60s is a reasonable default.
678 -> m (Either EsError (SearchResult a))
679advanceScroll (ScrollId sid) scroll = do
680 url <- joinPath ["_search/scroll?scroll=" <> scrollTime]
681 parseEsResponse =<< post url (Just . L.fromStrict $ T.encodeUtf8 sid)
682 where scrollTime = showText secs <> "s"
686simpleAccumulator :: (FromJSON a, MonadBH m, MonadThrow m) => [Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
687simpleAccumulator oldHits (newHits, Nothing) = return (oldHits ++ newHits, Nothing)
688simpleAccumulator oldHits ([], _) = return (oldHits, Nothing)
689simpleAccumulator oldHits (newHits, msid) = do
690 (newHits', msid') <- scroll' msid
691 simpleAccumulator (oldHits ++ newHits) (newHits', msid')
693-- | 'scanSearch' uses the 'scan&scroll' API of elastic,
694-- for a given 'IndexName' and 'MappingName'. Note that this will
695-- consume the entire search result set and will be doing O(n) list
696-- appends so this may not be suitable for large result sets. In that
697-- case, 'getInitialScroll' and 'advanceScroll' are good low level
698-- tools. You should be able to hook them up trivially to conduit,
699-- pipes, or your favorite streaming IO abstraction of choice. Note
700-- that ordering on the search would destroy performance and thus is
702scanSearch :: (FromJSON a, MonadBH m, MonadThrow m) => IndexName -> MappingName -> Search -> m [Hit a]
703scanSearch indexName mappingName search = do
704 msid <- getInitialScroll indexName mappingName search
705 (hits, msid') <- scroll' msid
706 (totalHits, _) <- simpleAccumulator [] (hits, msid')
709-- | 'mkSearch' is a helper function for defaulting additional fields of a 'Search'
710-- to Nothing in case you only care about your 'Query' and 'Filter'. Use record update
711-- syntax if you want to add things like aggregations or highlights while still using
712-- this helper function.
714-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
715-- >>> mkSearch (Just query) Nothing
716-- Search {queryBody = Just (TermQuery (Term {termField = "user", termValue = "bitemyapp"}) Nothing), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 0, size = Size 10, searchType = SearchTypeQueryThenFetch, fields = Nothing, source = Nothing}
717mkSearch :: Maybe Query -> Maybe Filter -> Search
718mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
720-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for
721-- the 'Query' and the 'Aggregation'.
723-- >>> let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
725-- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing})
726-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms
727mkAggregateSearch :: Maybe Query -> Aggregations -> Search
728mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) SearchTypeQueryThenFetch Nothing Nothing
730-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for
731-- the 'Query' and the 'Aggregation'.
733-- >>> let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
734-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
735-- >>> let search = mkHighlightSearch (Just query) testHighlight
736mkHighlightSearch :: Maybe Query -> Highlights -> Search
737mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
739-- | 'pageSearch' is a helper function that takes a search and assigns the from
740-- and size fields for the search. The from parameter defines the offset
741-- from the first result you want to fetch. The size parameter allows you to
742-- configure the maximum amount of hits to be returned.
744-- >>> let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
745-- >>> let search = mkSearch (Just query) Nothing
747-- Search {queryBody = Just (QueryMatchQuery (MatchQuery {matchQueryField = FieldName "_all", matchQueryQueryString = QueryString "haskell", matchQueryOperator = Or, matchQueryZeroTerms = ZeroTermsNone, matchQueryCutoffFrequency = Nothing, matchQueryMatchType = Nothing, matchQueryAnalyzer = Nothing, matchQueryMaxExpansions = Nothing, matchQueryLenient = Nothing, matchQueryBoost = Nothing})), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 0, size = Size 10, searchType = SearchTypeQueryThenFetch, fields = Nothing, source = Nothing}
748-- >>> pageSearch (From 10) (Size 100) search
749-- Search {queryBody = Just (QueryMatchQuery (MatchQuery {matchQueryField = FieldName "_all", matchQueryQueryString = QueryString "haskell", matchQueryOperator = Or, matchQueryZeroTerms = ZeroTermsNone, matchQueryCutoffFrequency = Nothing, matchQueryMatchType = Nothing, matchQueryAnalyzer = Nothing, matchQueryMaxExpansions = Nothing, matchQueryLenient = Nothing, matchQueryBoost = Nothing})), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 10, size = Size 100, searchType = SearchTypeQueryThenFetch, fields = Nothing, source = Nothing}
750pageSearch :: From -- ^ The result offset
751 -> Size -- ^ The number of results to return
752 -> Search -- ^ The current seach
753 -> Search -- ^ The paged search
754pageSearch resultOffset pageSize search = search { from = resultOffset, size = pageSize }
756parseUrl' :: MonadThrow m => Text -> m Request
757parseUrl' t = parseUrl (URI.escapeURIString URI.isAllowedInURI (T.unpack t))
759-- | Was there an optimistic concurrency control conflict when
760-- indexing a document?
761isVersionConflict :: Reply -> Bool
762isVersionConflict = statusCheck (== 409)
764isSuccess :: Reply -> Bool
765isSuccess = statusCheck (inRange (200, 299))
767isCreated :: Reply -> Bool
768isCreated = statusCheck (== 201)
770statusCheck :: (Int -> Bool) -> Reply -> Bool
771statusCheck prd = prd . NHTS.statusCode . responseStatus
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list