1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE RecordWildCards #-}
3{-# LANGUAGE TupleSections #-}
5-------------------------------------------------------------------------------
7-- Module : Database.Bloodhound.Client
8-- Copyright : (C) 2014 Chris Allen
9-- License : BSD-style (see the file LICENSE)
10-- Maintainer : Chris Allen <cma@bitemyapp.com
11-- Stability : provisional
12-- Portability : OverloadedStrings
14-- Client side functions for talking to Elasticsearch servers.
16-------------------------------------------------------------------------------
18module Database.Bloodhound.Client
19 ( -- * Bloodhound client functions
20 -- | The examples in this module assume the following code has been run.
21 -- The :{ and :} will only work in GHCi. You'll only need the data types
22 -- and typeclass instances for the functions that make use of them.
62 , encodeBulkOperations
66 -- * Reply-handling tools
74import qualified Blaze.ByteString.Builder as BB
75import Control.Applicative
77import Control.Monad.Catch
78import Control.Monad.IO.Class
80import Data.ByteString.Lazy.Builder
81import qualified Data.ByteString.Lazy.Char8 as L
82import Data.Foldable (toList)
83import qualified Data.HashMap.Strict as HM
85import qualified Data.List as LS (filter, foldl')
86import Data.List.NonEmpty (NonEmpty (..))
87import Data.Maybe (catMaybes, fromMaybe, isJust)
89import Data.Text (Text)
90import qualified Data.Text as T
91import qualified Data.Text.Encoding as T
93import qualified Data.Vector as V
94import Network.HTTP.Client
95import qualified Network.HTTP.Types.Method as NHTM
96import qualified Network.HTTP.Types.Status as NHTS
97import qualified Network.HTTP.Types.URI as NHTU
98import qualified Network.URI as URI
99import Prelude hiding (filter, head)
101import Database.Bloodhound.Types
104-- >>> :set -XOverloadedStrings
105-- >>> :set -XDeriveGeneric
106-- >>> import Database.Bloodhound
107-- >>> import Test.DocTest.Prop (assert)
108-- >>> let testServer = (Server "http://localhost:9200")
109-- >>> let runBH' = withBH defaultManagerSettings testServer
110-- >>> let testIndex = IndexName "twitter"
111-- >>> let testMapping = MappingName "tweet"
112-- >>> let defaultIndexSettings = IndexSettings (ShardCount 1) (ReplicaCount 0)
113-- >>> data TweetMapping = TweetMapping deriving (Eq, Show)
114-- >>> _ <- runBH' $ deleteIndex testIndex >> deleteMapping testIndex testMapping
115-- >>> import GHC.Generics
116-- >>> import Data.Time.Calendar (Day (..))
117-- >>> import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
119--instance ToJSON TweetMapping where
120-- toJSON TweetMapping =
122-- object ["properties" .=
123-- object ["location" .=
124-- object ["type" .= ("geo_point" :: Text)]]]]
125--data Location = Location { lat :: Double
126-- , lon :: Double } deriving (Eq, Generic, Show)
127--data Tweet = Tweet { user :: Text
128-- , postDate :: UTCTime
131-- , location :: Location } deriving (Eq, Generic, Show)
132--exampleTweet = Tweet { user = "bitemyapp"
133-- , postDate = UTCTime
134-- (ModifiedJulianDay 55000)
135-- (secondsToDiffTime 10)
136-- , message = "Use haskell!"
138-- , location = Location 40.12 (-71.34) }
139--instance ToJSON Tweet where
140-- toJSON = genericToJSON defaultOptions
141--instance FromJSON Tweet where
142-- parseJSON = genericParseJSON defaultOptions
143--instance ToJSON Location where
144-- toJSON = genericToJSON defaultOptions
145--instance FromJSON Location where
146-- parseJSON = genericParseJSON defaultOptions
147--data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
148--instance FromJSON BulkTest where
149-- parseJSON = genericParseJSON defaultOptions
150--instance ToJSON BulkTest where
151-- toJSON = genericToJSON defaultOptions
154-- | 'mkShardCount' is a straight-forward smart constructor for 'ShardCount'
155-- which rejects 'Int' values below 1 and above 1000.
157-- >>> mkShardCount 10
158-- Just (ShardCount 10)
159mkShardCount :: Int -> Maybe ShardCount
163 | otherwise = Just (ShardCount n)
165-- | 'mkReplicaCount' is a straight-forward smart constructor for 'ReplicaCount'
166-- which rejects 'Int' values below 1 and above 1000.
168-- >>> mkReplicaCount 10
169-- Just (ReplicaCount 10)
170mkReplicaCount :: Int -> Maybe ReplicaCount
173 | n > 1000 = Nothing -- ...
174 | otherwise = Just (ReplicaCount n)
176emptyBody :: L.ByteString
182 -> Maybe L.ByteString
184dispatch dMethod url body = do
185 initReq <- liftIO $ parseUrl' url
186 reqHook <- bhRequestHook <$> getBHEnv
187 let reqBody = RequestBodyLBS $ fromMaybe emptyBody body
188 req <- liftIO $ reqHook $ setRequestIgnoreStatus $ initReq { method = dMethod
189 , requestBody = reqBody }
190 mgr <- bhManager <$> getBHEnv
191 liftIO $ httpLbs req mgr
193joinPath' :: [Text] -> Text
194joinPath' = T.intercalate "/"
196joinPath :: MonadBH m => [Text] -> m Text
198 Server s <- bhServer <$> getBHEnv
199 return $ joinPath' (s:ps)
201appendSearchTypeParam :: Text -> SearchType -> Text
202appendSearchTypeParam originalUrl st = addQuery params originalUrl
203 where stText = "search_type"
205 | st == SearchTypeDfsQueryThenFetch = [(stText, Just "dfs_query_then_fetch")]
206 | st == SearchTypeCount = [(stText, Just "count")]
207 | st == SearchTypeScan = [(stText, Just "scan"), ("scroll", Just "1m")]
208 | st == SearchTypeQueryAndFetch = [(stText, Just "query_and_fetch")]
209 | st == SearchTypeDfsQueryAndFetch = [(stText, Just "dfs_query_and_fetch")]
210 -- used to catch 'SearchTypeQueryThenFetch', which is also the default
211 | otherwise = [(stText, Just "query_then_fetch")]
213-- | Severely dumbed down query renderer. Assumes your data doesn't
215addQuery :: [(Text, Maybe Text)] -> Text -> Text
216addQuery q u = u <> rendered
219 T.decodeUtf8 $ BB.toByteString $ NHTU.renderQueryText prependQuestionMark q
220 prependQuestionMark = True
222bindM2 :: (Applicative m, Monad m) => (a -> b -> m c) -> m a -> m b -> m c
223bindM2 f ma mb = join (f <$> ma <*> mb)
225-- | Convenience function that sets up a manager and BHEnv and runs
226-- the given set of bloodhound operations. Connections will be
227-- pipelined automatically in accordance with the given manager
228-- settings in IO. If you've got your own monad transformer stack, you
229-- should use 'runBH' directly.
230withBH :: ManagerSettings -> Server -> BH IO a -> IO a
233 let env = mkBHEnv s mgr
236-- Shortcut functions for HTTP methods
237delete :: MonadBH m => Text -> m Reply
238delete = flip (dispatch NHTM.methodDelete) Nothing
239get :: MonadBH m => Text -> m Reply
240get = flip (dispatch NHTM.methodGet) Nothing
241head :: MonadBH m => Text -> m Reply
242head = flip (dispatch NHTM.methodHead) Nothing
243put :: MonadBH m => Text -> Maybe L.ByteString -> m Reply
244put = dispatch NHTM.methodPut
245post :: MonadBH m => Text -> Maybe L.ByteString -> m Reply
246post = dispatch NHTM.methodPost
248-- indexDocument s ix name doc = put (root </> s </> ix </> name </> doc) (Just encode doc)
249-- http://hackage.haskell.org/package/http-client-lens-0.1.0/docs/Network-HTTP-Client-Lens.html
250-- https://github.com/supki/libjenkins/blob/master/src/Jenkins/Rest/Internal.hs
252-- | 'getStatus' fetches the 'Status' of a 'Server'
254-- >>> serverStatus <- runBH' getStatus
255-- >>> fmap status (serverStatus)
257getStatus :: MonadBH m => m (Maybe Status)
259 response <- get =<< url
260 return $ decode (responseBody response)
261 where url = joinPath []
263-- | 'createIndex' will create an index given a 'Server', 'IndexSettings', and an 'IndexName'.
265-- >>> response <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
266-- >>> respIsTwoHunna response
268-- >>> runBH' $ indexExists (IndexName "didimakeanindex")
270createIndex :: MonadBH m => IndexSettings -> IndexName -> m Reply
271createIndex indexSettings (IndexName indexName) =
272 bindM2 put url (return body)
273 where url = joinPath [indexName]
274 body = Just $ encode indexSettings
277-- | 'deleteIndex' will delete an index given a 'Server', and an 'IndexName'.
279-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
280-- >>> response <- runBH' $ deleteIndex (IndexName "didimakeanindex")
281-- >>> respIsTwoHunna response
283-- >>> runBH' $ indexExists testIndex
285deleteIndex :: MonadBH m => IndexName -> m Reply
286deleteIndex (IndexName indexName) =
287 delete =<< joinPath [indexName]
289-- | 'updateIndexSettings' will apply a non-empty list of setting updates to an index
291-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "unconfiguredindex")
292-- >>> response <- runBH' $ updateIndexSettings (BlocksWrite False :| []) (IndexName "unconfiguredindex")
293-- >>> respIsTwoHunna response
295updateIndexSettings :: MonadBH m => NonEmpty UpdatableIndexSetting -> IndexName -> m Reply
296updateIndexSettings updates (IndexName indexName) =
297 bindM2 put url (return body)
298 where url = joinPath [indexName, "_settings"]
299 body = Just (encode jsonBody)
300 jsonBody = Object (deepMerge [u | Object u <- toJSON <$> toList updates])
303getIndexSettings :: (MonadBH m, MonadThrow m) => IndexName
304 -> m (Either EsError IndexSettingsSummary)
305getIndexSettings (IndexName indexName) = do
306 parseEsResponse =<< get =<< url
307 where url = joinPath [indexName, "_settings"]
310-- | 'optimizeIndex' will optimize a single index, list of indexes or
311-- all indexes. Note that this call will block until finishing but
312-- will continue even if the request times out. Concurrent requests to
313-- optimize an index while another is performing will block until the
314-- previous one finishes. For more information see
315-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-optimize.html>. Nothing
316-- worthwhile comes back in the reply body, so matching on the status
319-- 'optimizeIndex' with a maxNumSegments of 1 and onlyExpungeDeletes
320-- to True is the main way to release disk space back to the OS being
321-- held by deleted documents.
323-- Note that this API was deprecated in ElasticSearch 2.1 for the
324-- almost completely identical forcemerge API. Adding support to that
325-- API would be trivial but due to the significant breaking changes,
326-- this library cannot currently be used with >= 2.0, so that feature was omitted.
328-- >>> let ixn = IndexName "unoptimizedindex"
329-- >>> _ <- runBH' $ deleteIndex ixn >> createIndex defaultIndexSettings ixn
330-- >>> response <- runBH' $ optimizeIndex (IndexList (ixn :| [])) (defaultIndexOptimizationSettings { maxNumSegments = Just 1, onlyExpungeDeletes = True })
331-- >>> respIsTwoHunna response
333optimizeIndex :: MonadBH m => IndexSelection -> IndexOptimizationSettings -> m Reply
334optimizeIndex ixs IndexOptimizationSettings {..} =
335 bindM2 post url (return body)
336 where url = addQuery params <$> joinPath [indexName, "_optimize"]
337 params = catMaybes [ ("max_num_segments",) . Just . showText <$> maxNumSegments
338 , Just ("only_expunge_deletes", Just (boolQP onlyExpungeDeletes))
339 , Just ("flush", Just (boolQP flushAfterOptimize))
341 indexName = indexSelectionName ixs
343 boolQP False = "false"
347-------------------------------------------------------------------------------
348indexSelectionName :: IndexSelection -> Text
349indexSelectionName (IndexList names) = T.intercalate "," [n | IndexName n <- toList names]
350indexSelectionName AllIndexes = "_all"
352deepMerge :: [Object] -> Object
353deepMerge = LS.foldl' go mempty
354 where go acc = LS.foldl' go' acc . HM.toList
355 go' acc (k, v) = HM.insertWith merge k v acc
356 merge (Object a) (Object b) = Object (deepMerge [a, b])
360statusCodeIs :: (Int, Int) -> Reply -> Bool
361statusCodeIs r resp = inRange r $ NHTS.statusCode (responseStatus resp)
363respIsTwoHunna :: Reply -> Bool
364respIsTwoHunna = statusCodeIs (200, 299)
366existentialQuery :: MonadBH m => Text -> m (Reply, Bool)
367existentialQuery url = do
369 return (reply, respIsTwoHunna reply)
372-- | Tries to parse a response body as the expected type @a@ and
373-- failing that tries to parse it as an EsError. All well-formed, JSON
374-- responses from elasticsearch should fall into these two
375-- categories. If they don't, a 'EsProtocolException' will be
376-- thrown. If you encounter this, please report the full body it
377-- reports along with your ElasticSearch verison.
378parseEsResponse :: (MonadThrow m, FromJSON a) => Reply
379 -> m (Either EsError a)
381 | respIsTwoHunna reply = case eitherDecode body of
382 Right a -> return (Right a)
383 Left _ -> tryParseError
384 | otherwise = tryParseError
385 where body = responseBody reply
386 tryParseError = case eitherDecode body of
387 Right e -> return (Left e)
388 -- this case should not be possible
390 explode = throwM (EsProtocolException body)
392-- | 'indexExists' enables you to check if an index exists. Returns 'Bool'
395-- >>> exists <- runBH' $ indexExists testIndex
396indexExists :: MonadBH m => IndexName -> m Bool
397indexExists (IndexName indexName) = do
398 (_, exists) <- existentialQuery =<< joinPath [indexName]
401-- | 'refreshIndex' will force a refresh on an index. You must
402-- do this if you want to read what you wrote.
404-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
405-- >>> _ <- runBH' $ refreshIndex testIndex
406refreshIndex :: MonadBH m => IndexName -> m Reply
407refreshIndex (IndexName indexName) =
408 bindM2 post url (return Nothing)
409 where url = joinPath [indexName, "_refresh"]
411stringifyOCIndex :: OpenCloseIndex -> Text
412stringifyOCIndex oci = case oci of
414 CloseIndex -> "_close"
416openOrCloseIndexes :: MonadBH m => OpenCloseIndex -> IndexName -> m Reply
417openOrCloseIndexes oci (IndexName indexName) =
418 bindM2 post url (return Nothing)
419 where ociString = stringifyOCIndex oci
420 url = joinPath [indexName, ociString]
422-- | 'openIndex' opens an index given a 'Server' and an 'IndexName'. Explained in further detail at
423-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
425-- >>> reply <- runBH' $ openIndex testIndex
426openIndex :: MonadBH m => IndexName -> m Reply
427openIndex = openOrCloseIndexes OpenIndex
429-- | 'closeIndex' closes an index given a 'Server' and an 'IndexName'. Explained in further detail at
430-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
432-- >>> reply <- runBH' $ closeIndex testIndex
433closeIndex :: MonadBH m => IndexName -> m Reply
434closeIndex = openOrCloseIndexes CloseIndex
436-- | 'listIndices' returns a list of all index names on a given 'Server'
437listIndices :: (MonadThrow m, MonadBH m) => m [IndexName]
439 parse . responseBody =<< get =<< url
441 url = joinPath ["_cat/indices?v"]
442 -- parses the tabular format the indices api provides
443 parse body = case T.lines (T.decodeUtf8 (L.toStrict body)) of
444 (hdr:rows) -> let ks = T.words hdr
445 keyedRows = [ HM.fromList (zip ks (T.words row)) | row <- rows ]
446 names = catMaybes (HM.lookup "index" <$> keyedRows)
447 in return (IndexName <$> names)
448 [] -> throwM (EsProtocolException body)
450-- | 'updateIndexAliases' updates the server's index alias
451-- table. Operations are atomic. Explained in further detail at
452-- <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-aliases.html>
454-- >>> let src = IndexName "a-real-index"
455-- >>> let aliasName = IndexName "an-alias"
456-- >>> let iAlias = IndexAlias src (IndexAliasName aliasName)
457-- >>> let aliasCreate = IndexAliasCreate Nothing Nothing
458-- >>> _ <- runBH' $ deleteIndex src
459-- >>> respIsTwoHunna <$> runBH' (createIndex defaultIndexSettings src)
461-- >>> runBH' $ indexExists src
463-- >>> respIsTwoHunna <$> runBH' (updateIndexAliases (AddAlias iAlias aliasCreate :| []))
465-- >>> runBH' $ indexExists aliasName
467updateIndexAliases :: MonadBH m => NonEmpty IndexAliasAction -> m Reply
468updateIndexAliases actions = bindM2 post url (return body)
469 where url = joinPath ["_aliases"]
470 body = Just (encode bodyJSON)
471 bodyJSON = object [ "actions" .= toList actions]
473-- | Get all aliases configured on the server.
474getIndexAliases :: (MonadBH m, MonadThrow m)
475 => m (Either EsError IndexAliasesSummary)
476getIndexAliases = parseEsResponse =<< get =<< url
477 where url = joinPath ["_aliases"]
479-- | 'putTemplate' creates a template given an 'IndexTemplate' and a 'TemplateName'.
480-- Explained in further detail at
481-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html>
483-- >>> let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
484-- >>> resp <- runBH' $ putTemplate idxTpl (TemplateName "tweet-tpl")
485putTemplate :: MonadBH m => IndexTemplate -> TemplateName -> m Reply
486putTemplate indexTemplate (TemplateName templateName) =
487 bindM2 put url (return body)
488 where url = joinPath ["_template", templateName]
489 body = Just $ encode indexTemplate
491-- | 'templateExists' checks to see if a template exists.
493-- >>> exists <- runBH' $ templateExists (TemplateName "tweet-tpl")
494templateExists :: MonadBH m => TemplateName -> m Bool
495templateExists (TemplateName templateName) = do
496 (_, exists) <- existentialQuery =<< joinPath ["_template", templateName]
499-- | 'deleteTemplate' is an HTTP DELETE and deletes a template.
501-- >>> let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
502-- >>> _ <- runBH' $ putTemplate idxTpl (TemplateName "tweet-tpl")
503-- >>> resp <- runBH' $ deleteTemplate (TemplateName "tweet-tpl")
504deleteTemplate :: MonadBH m => TemplateName -> m Reply
505deleteTemplate (TemplateName templateName) =
506 delete =<< joinPath ["_template", templateName]
508-- | 'putMapping' is an HTTP PUT and has upsert semantics. Mappings are schemas
509-- for documents in indexes.
511-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
512-- >>> resp <- runBH' $ putMapping testIndex testMapping TweetMapping
514-- 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}
515putMapping :: (MonadBH m, ToJSON a) => IndexName
516 -> MappingName -> a -> m Reply
517putMapping (IndexName indexName) (MappingName mappingName) mapping =
518 bindM2 put url (return body)
519 where url = joinPath [indexName, "_mapping", mappingName]
520 -- "_mapping" and mappingName above were originally transposed
521 -- erroneously. The correct API call is: "/INDEX/_mapping/MAPPING_NAME"
522 body = Just $ encode mapping
524-- | 'deleteMapping' is an HTTP DELETE and deletes a mapping for a given index.
525-- Mappings are schemas for documents in indexes.
527-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
528-- >>> _ <- runBH' $ putMapping testIndex testMapping TweetMapping
529-- >>> resp <- runBH' $ deleteMapping testIndex testMapping
531-- 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}
532deleteMapping :: MonadBH m => IndexName -> MappingName -> m Reply
533deleteMapping (IndexName indexName)
534 (MappingName mappingName) =
535 -- "_mapping" and mappingName below were originally transposed
536 -- erroneously. The correct API call is: "/INDEX/_mapping/MAPPING_NAME"
537 delete =<< joinPath [indexName, "_mapping", mappingName]
539versionCtlParams :: IndexDocumentSettings -> [(Text, Maybe Text)]
540versionCtlParams cfg =
541 case idsVersionControl cfg of
542 NoVersionControl -> []
543 InternalVersion v -> versionParams v "internal"
544 ExternalGT (ExternalDocVersion v) -> versionParams v "external_gt"
545 ExternalGTE (ExternalDocVersion v) -> versionParams v "external_gte"
546 ForceVersion (ExternalDocVersion v) -> versionParams v "force"
548 vt = showText . docVersionNumber
549 versionParams v t = [ ("version", Just $ vt v)
550 , ("version_type", Just t)
553-- | 'indexDocument' is the primary way to save a single document in
554-- Elasticsearch. The document itself is simply something we can
555-- convert into a JSON 'Value'. The 'DocId' will function as the
556-- primary key for the document.
558-- >>> resp <- runBH' $ indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "1")
560-- 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}
561indexDocument :: (ToJSON doc, MonadBH m) => IndexName -> MappingName
562 -> IndexDocumentSettings -> doc -> DocId -> m Reply
563indexDocument (IndexName indexName)
564 (MappingName mappingName) cfg document (DocId docId) =
565 bindM2 put url (return body)
566 where url = addQuery params <$> joinPath [indexName, mappingName, docId]
567 parentParams = case idsParent cfg of
569 Just (DocumentParent (DocId p)) -> [ ("parent", Just p) ]
570 params = versionCtlParams cfg ++ parentParams
571 body = Just (encode document)
573-- | 'updateDocument' provides a way to perform an partial update of a
574-- an already indexed document.
575updateDocument :: (ToJSON patch, MonadBH m) => IndexName -> MappingName
576 -> IndexDocumentSettings -> patch -> DocId -> m Reply
577updateDocument (IndexName indexName)
578 (MappingName mappingName) cfg patch (DocId docId) =
579 bindM2 post url (return body)
580 where url = addQuery (versionCtlParams cfg) <$>
581 joinPath [indexName, mappingName, docId, "_update"]
582 body = Just (encode $ object ["doc" .= toJSON patch])
584-- | 'deleteDocument' is the primary way to delete a single document.
586-- >>> _ <- runBH' $ deleteDocument testIndex testMapping (DocId "1")
587deleteDocument :: MonadBH m => IndexName -> MappingName
589deleteDocument (IndexName indexName)
590 (MappingName mappingName) (DocId docId) =
591 delete =<< joinPath [indexName, mappingName, docId]
594-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html Elasticsearch's bulk API>
595-- to perform bulk operations. The 'BulkOperation' data type encodes the
596-- index\/update\/delete\/create operations. You pass a 'V.Vector' of 'BulkOperation's
597-- and a 'Server' to 'bulk' in order to send those operations up to your Elasticsearch
598-- server to be performed. I changed from [BulkOperation] to a Vector due to memory overhead.
600-- >>> let stream = V.fromList [BulkIndex testIndex testMapping (DocId "2") (toJSON (BulkTest "blah"))]
601-- >>> _ <- runBH' $ bulk stream
602-- >>> _ <- runBH' $ refreshIndex testIndex
603bulk :: MonadBH m => V.Vector BulkOperation -> m Reply
604bulk bulkOps = bindM2 post url (return body)
605 where url = joinPath ["_bulk"]
606 body = Just $ encodeBulkOperations bulkOps
608-- | 'encodeBulkOperations' is a convenience function for dumping a vector of 'BulkOperation'
609-- into an 'L.ByteString'
611-- >>> let bulkOps = V.fromList [BulkIndex testIndex testMapping (DocId "2") (toJSON (BulkTest "blah"))]
612-- >>> encodeBulkOperations bulkOps
613-- "\n{\"index\":{\"_type\":\"tweet\",\"_id\":\"2\",\"_index\":\"twitter\"}}\n{\"name\":\"blah\"}\n"
614encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString
615encodeBulkOperations stream = collapsed where
616 blobs = fmap encodeBulkOperation stream
617 mashedTaters = mash (mempty :: Builder) blobs
618 collapsed = toLazyByteString $ mappend mashedTaters (byteString "\n")
620mash :: Builder -> V.Vector L.ByteString -> Builder
621mash = V.foldl' (\b x -> b `mappend` (byteString "\n") `mappend` (lazyByteString x))
623mkBulkStreamValue :: Text -> Text -> Text -> Text -> Value
624mkBulkStreamValue operation indexName mappingName docId =
626 object [ "_index" .= indexName
627 , "_type" .= mappingName
630-- | 'encodeBulkOperation' is a convenience function for dumping a single 'BulkOperation'
631-- into an 'L.ByteString'
633-- >>> let bulkOp = BulkIndex testIndex testMapping (DocId "2") (toJSON (BulkTest "blah"))
634-- >>> encodeBulkOperation bulkOp
635-- "{\"index\":{\"_type\":\"tweet\",\"_id\":\"2\",\"_index\":\"twitter\"}}\n{\"name\":\"blah\"}"
636encodeBulkOperation :: BulkOperation -> L.ByteString
637encodeBulkOperation (BulkIndex (IndexName indexName)
638 (MappingName mappingName)
639 (DocId docId) value) = blob
640 where metadata = mkBulkStreamValue "index" indexName mappingName docId
641 blob = encode metadata `mappend` "\n" `mappend` encode value
643encodeBulkOperation (BulkCreate (IndexName indexName)
644 (MappingName mappingName)
645 (DocId docId) value) = blob
646 where metadata = mkBulkStreamValue "create" indexName mappingName docId
647 blob = encode metadata `mappend` "\n" `mappend` encode value
649encodeBulkOperation (BulkDelete (IndexName indexName)
650 (MappingName mappingName)
651 (DocId docId)) = blob
652 where metadata = mkBulkStreamValue "delete" indexName mappingName docId
653 blob = encode metadata
655encodeBulkOperation (BulkUpdate (IndexName indexName)
656 (MappingName mappingName)
657 (DocId docId) value) = blob
658 where metadata = mkBulkStreamValue "update" indexName mappingName docId
659 doc = object ["doc" .= value]
660 blob = encode metadata `mappend` "\n" `mappend` encode doc
662-- | 'getDocument' is a straight-forward way to fetch a single document from
663-- Elasticsearch using a 'Server', 'IndexName', 'MappingName', and a 'DocId'.
664-- The 'DocId' is the primary key for your Elasticsearch document.
666-- >>> yourDoc <- runBH' $ getDocument testIndex testMapping (DocId "1")
667getDocument :: MonadBH m => IndexName -> MappingName
669getDocument (IndexName indexName)
670 (MappingName mappingName) (DocId docId) =
671 get =<< joinPath [indexName, mappingName, docId]
673-- | 'documentExists' enables you to check if a document exists. Returns 'Bool'
676-- >>> exists <- runBH' $ documentExists testIndex testMapping Nothing (DocId "1")
677documentExists :: MonadBH m => IndexName -> MappingName
678 -> Maybe DocumentParent -> DocId -> m Bool
679documentExists (IndexName indexName) (MappingName mappingName)
680 parent (DocId docId) = do
681 (_, exists) <- existentialQuery =<< url
683 where url = addQuery params <$> joinPath [indexName, mappingName, docId]
684 parentParam = fmap (\(DocumentParent (DocId p)) -> p) parent
685 params = LS.filter (\(_, v) -> isJust v) [("parent", parentParam)]
687dispatchSearch :: MonadBH m => Text -> Search -> m Reply
688dispatchSearch url search = post url' (Just (encode search))
689 where url' = appendSearchTypeParam url (searchType search)
691-- | 'searchAll', given a 'Search', will perform that search against all indexes
692-- on an Elasticsearch server. Try to avoid doing this if it can be helped.
694-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
695-- >>> let search = mkSearch (Just query) Nothing
696-- >>> reply <- runBH' $ searchAll search
697searchAll :: MonadBH m => Search -> m Reply
698searchAll = bindM2 dispatchSearch url . return
699 where url = joinPath ["_search"]
701-- | 'searchByIndex', given a 'Search' and an 'IndexName', will perform that search
702-- against all mappings within an index on an Elasticsearch server.
704-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
705-- >>> let search = mkSearch (Just query) Nothing
706-- >>> reply <- runBH' $ searchByIndex testIndex search
707searchByIndex :: MonadBH m => IndexName -> Search -> m Reply
708searchByIndex (IndexName indexName) = bindM2 dispatchSearch url . return
709 where url = joinPath [indexName, "_search"]
711-- | 'searchByType', given a 'Search', 'IndexName', and 'MappingName', will perform that
712-- search against a specific mapping within an index on an Elasticsearch server.
714-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
715-- >>> let search = mkSearch (Just query) Nothing
716-- >>> reply <- runBH' $ searchByType testIndex testMapping search
717searchByType :: MonadBH m => IndexName -> MappingName -> Search
719searchByType (IndexName indexName)
720 (MappingName mappingName) = bindM2 dispatchSearch url . return
721 where url = joinPath [indexName, mappingName, "_search"]
723-- | For a given scearch, request a scroll for efficient streaming of
724-- search results. Note that the search is put into 'SearchTypeScan'
725-- mode and thus results will not be sorted. Combine this with
726-- 'advanceScroll' to efficiently stream through the full result set
727getInitialScroll :: MonadBH m => IndexName -> MappingName -> Search -> m (Maybe ScrollId)
728getInitialScroll (IndexName indexName) (MappingName mappingName) search = do
729 let url = joinPath [indexName, mappingName, "_search"]
730 search' = search { searchType = SearchTypeScan }
731 resp' <- bindM2 dispatchSearch url (return search')
732 let msr = decode' $ responseBody resp' :: Maybe (SearchResult ())
733 msid = maybe Nothing scrollId msr
736scroll' :: (FromJSON a, MonadBH m, MonadThrow m) => Maybe ScrollId -> m ([Hit a], Maybe ScrollId)
737scroll' Nothing = return ([], Nothing)
738scroll' (Just sid) = do
739 res <- advanceScroll sid 60
741 Right SearchResult {..} -> return (hits searchHits, scrollId)
742 Left _ -> return ([], Nothing)
744-- | Use the given scroll to fetch the next page of documents. If there are no
745-- further pages, 'SearchResult.searchHits.hits' will be '[]'.
753 -- ^ 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.
754 -> m (Either EsError (SearchResult a))
755advanceScroll (ScrollId sid) scroll = do
756 url <- joinPath ["_search/scroll?scroll=" <> scrollTime]
757 parseEsResponse =<< post url (Just . L.fromStrict $ T.encodeUtf8 sid)
758 where scrollTime = showText secs <> "s"
762simpleAccumulator :: (FromJSON a, MonadBH m, MonadThrow m) => [Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
763simpleAccumulator oldHits (newHits, Nothing) = return (oldHits ++ newHits, Nothing)
764simpleAccumulator oldHits ([], _) = return (oldHits, Nothing)
765simpleAccumulator oldHits (newHits, msid) = do
766 (newHits', msid') <- scroll' msid
767 simpleAccumulator (oldHits ++ newHits) (newHits', msid')
769-- | 'scanSearch' uses the 'scan&scroll' API of elastic,
770-- for a given 'IndexName' and 'MappingName'. Note that this will
771-- consume the entire search result set and will be doing O(n) list
772-- appends so this may not be suitable for large result sets. In that
773-- case, 'getInitialScroll' and 'advanceScroll' are good low level
774-- tools. You should be able to hook them up trivially to conduit,
775-- pipes, or your favorite streaming IO abstraction of choice. Note
776-- that ordering on the search would destroy performance and thus is
778scanSearch :: (FromJSON a, MonadBH m, MonadThrow m) => IndexName -> MappingName -> Search -> m [Hit a]
779scanSearch indexName mappingName search = do
780 msid <- getInitialScroll indexName mappingName search
781 (hits, msid') <- scroll' msid
782 (totalHits, _) <- simpleAccumulator [] (hits, msid')
785-- | 'mkSearch' is a helper function for defaulting additional fields of a 'Search'
786-- to Nothing in case you only care about your 'Query' and 'Filter'. Use record update
787-- syntax if you want to add things like aggregations or highlights while still using
788-- this helper function.
790-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
791-- >>> mkSearch (Just query) Nothing
792-- 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}
793mkSearch :: Maybe Query -> Maybe Filter -> Search
794mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
796-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for
797-- the 'Query' and the 'Aggregation'.
799-- >>> let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
801-- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing})
802-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms
803mkAggregateSearch :: Maybe Query -> Aggregations -> Search
804mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) SearchTypeQueryThenFetch Nothing Nothing
806-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for
807-- the 'Query' and the 'Aggregation'.
809-- >>> let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
810-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
811-- >>> let search = mkHighlightSearch (Just query) testHighlight
812mkHighlightSearch :: Maybe Query -> Highlights -> Search
813mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
815-- | 'pageSearch' is a helper function that takes a search and assigns the from
816-- and size fields for the search. The from parameter defines the offset
817-- from the first result you want to fetch. The size parameter allows you to
818-- configure the maximum amount of hits to be returned.
820-- >>> let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
821-- >>> let search = mkSearch (Just query) Nothing
823-- 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}
824-- >>> pageSearch (From 10) (Size 100) search
825-- 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}
826pageSearch :: From -- ^ The result offset
827 -> Size -- ^ The number of results to return
828 -> Search -- ^ The current seach
829 -> Search -- ^ The paged search
830pageSearch resultOffset pageSize search = search { from = resultOffset, size = pageSize }
832parseUrl' :: MonadThrow m => Text -> m Request
833parseUrl' t = parseRequest (URI.escapeURIString URI.isAllowedInURI (T.unpack t))
835-- | Was there an optimistic concurrency control conflict when
836-- indexing a document?
837isVersionConflict :: Reply -> Bool
838isVersionConflict = statusCheck (== 409)
840isSuccess :: Reply -> Bool
841isSuccess = statusCheck (inRange (200, 299))
843isCreated :: Reply -> Bool
844isCreated = statusCheck (== 201)
846statusCheck :: (Int -> Bool) -> Reply -> Bool
847statusCheck prd = prd . NHTS.statusCode . responseStatus
849-- | This is a hook that can be set via the 'bhRequestHook' function
850-- that will authenticate all requests using an HTTP Basic
851-- Authentication header. Note that it is *strongly* recommended that
852-- this option only be used over an SSL connection.
854-- >> (mkBHEnv myServer myManager) { bhRequestHook = basicAuthHook (EsUsername "myuser") (EsPassword "mypass") }
855basicAuthHook :: Monad m => EsUsername -> EsPassword -> Request -> m Request
856basicAuthHook (EsUsername u) (EsPassword p) = return . applyBasicAuth u' p'
857 where u' = T.encodeUtf8 u
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