git.iko.soy/typeable/bloodhound
on es-2-canary help sign in
typeable/bloodhound/src/Database/Bloodhound/Client.hs
1097 lines 49 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE RecordWildCards #-}
3{-# LANGUAGE TupleSections #-}
5-------------------------------------------------------------------------------
6-- |
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
13--
14-- Client side functions for talking to Elasticsearch servers.
15--
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.
24 -- $setup
25 withBH
26 -- ** Indices
27 , createIndex
28 , deleteIndex
29 , updateIndexSettings
30 , getIndexSettings
31 , optimizeIndex
32 , indexExists
33 , openIndex
34 , closeIndex
35 , listIndices
36 , waitForYellowIndex
37 -- *** Index Aliases
38 , updateIndexAliases
39 , getIndexAliases
40 -- *** Index Templates
41 , putTemplate
42 , templateExists
43 , deleteTemplate
44 -- ** Mapping
45 , putMapping
46 , deleteMapping
47 -- ** Documents
48 , indexDocument
49 , updateDocument
50 , getDocument
51 , documentExists
52 , deleteDocument
53 -- ** Searching
54 , searchAll
55 , searchByIndex
56 , searchByType
57 , scanSearch
58 , getInitialScroll
59 , advanceScroll
60 , refreshIndex
61 , mkSearch
62 , mkAggregateSearch
63 , mkHighlightSearch
64 , bulk
65 , pageSearch
66 , mkShardCount
67 , mkReplicaCount
68 , getStatus
69 -- ** Snapshot/Restore
70 -- *** Snapshot Repos
71 , getSnapshotRepos
72 , updateSnapshotRepo
73 , verifySnapshotRepo
74 , deleteSnapshotRepo
75 -- *** Snapshots
76 , createSnapshot
77 , getSnapshots
78 , deleteSnapshot
79 -- *** Restoring Snapshots
80 , restoreSnapshot
81 -- ** Nodes
82 , getNodesInfo
83 , getNodesStats
84 -- ** Request Utilities
85 , encodeBulkOperations
86 , encodeBulkOperation
87 -- * Authentication
88 , basicAuthHook
89 -- * Reply-handling tools
90 , isVersionConflict
91 , isSuccess
92 , isCreated
93 , parseEsResponse
94 )
95 where
97import qualified Blaze.ByteString.Builder as BB
98import Control.Applicative as A
99import Control.Monad
100import Control.Monad.Catch
101import Control.Monad.IO.Class
102import Data.Aeson
103import Data.ByteString.Lazy.Builder
104import qualified Data.ByteString.Lazy.Char8 as L
105import Data.Foldable (toList)
106import qualified Data.HashMap.Strict as HM
107import Data.Ix
108import qualified Data.List as LS (filter, foldl')
109import Data.List.NonEmpty (NonEmpty (..))
110import Data.Maybe (catMaybes, fromMaybe, isJust)
111import Data.Monoid
112import Data.Text (Text)
113import qualified Data.Text as T
114import qualified Data.Text.Encoding as T
115import Data.Time.Clock
116import qualified Data.Vector as V
117import Network.HTTP.Client
118import qualified Network.HTTP.Types.Method as NHTM
119import qualified Network.HTTP.Types.Status as NHTS
120import qualified Network.HTTP.Types.URI as NHTU
121import qualified Network.URI as URI
122import Prelude hiding (filter, head)
124import Database.Bloodhound.Types
126-- $setup
127-- >>> :set -XOverloadedStrings
128-- >>> :set -XDeriveGeneric
129-- >>> import Database.Bloodhound
130-- >>> let testServer = (Server "http://localhost:9200")
131-- >>> let runBH' = withBH defaultManagerSettings testServer
132-- >>> let testIndex = IndexName "twitter"
133-- >>> let testMapping = MappingName "tweet"
134-- >>> let defaultIndexSettings = IndexSettings (ShardCount 1) (ReplicaCount 0)
135-- >>> data TweetMapping = TweetMapping deriving (Eq, Show)
136-- >>> _ <- runBH' $ deleteIndex testIndex >> deleteMapping testIndex testMapping
137-- >>> import GHC.Generics
138-- >>> import Data.Time.Calendar (Day (..))
139-- >>> import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
140-- >>> :{
141--instance ToJSON TweetMapping where
142-- toJSON TweetMapping =
143-- object ["properties" .=
144-- object ["location" .=
145-- object ["type" .= ("geo_point" :: Text)]]]
146--data Location = Location { lat :: Double
147-- , lon :: Double } deriving (Eq, Generic, Show)
148--data Tweet = Tweet { user :: Text
149-- , postDate :: UTCTime
150-- , message :: Text
151-- , age :: Int
152-- , location :: Location } deriving (Eq, Generic, Show)
153--exampleTweet = Tweet { user = "bitemyapp"
154-- , postDate = UTCTime
155-- (ModifiedJulianDay 55000)
156-- (secondsToDiffTime 10)
157-- , message = "Use haskell!"
158-- , age = 10000
159-- , location = Location 40.12 (-71.34) }
160--instance ToJSON Tweet where
161-- toJSON = genericToJSON defaultOptions
162--instance FromJSON Tweet where
163-- parseJSON = genericParseJSON defaultOptions
164--instance ToJSON Location where
165-- toJSON = genericToJSON defaultOptions
166--instance FromJSON Location where
167-- parseJSON = genericParseJSON defaultOptions
168--data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
169--instance FromJSON BulkTest where
170-- parseJSON = genericParseJSON defaultOptions
171--instance ToJSON BulkTest where
172-- toJSON = genericToJSON defaultOptions
173-- :}
175-- | 'mkShardCount' is a straight-forward smart constructor for 'ShardCount'
176-- which rejects 'Int' values below 1 and above 1000.
177--
178-- >>> mkShardCount 10
179-- Just (ShardCount 10)
180mkShardCount :: Int -> Maybe ShardCount
181mkShardCount n
182 | n < 1 = Nothing
183 | n > 1000 = Nothing
184 | otherwise = Just (ShardCount n)
186-- | 'mkReplicaCount' is a straight-forward smart constructor for 'ReplicaCount'
187-- which rejects 'Int' values below 0 and above 1000.
188--
189-- >>> mkReplicaCount 10
190-- Just (ReplicaCount 10)
191mkReplicaCount :: Int -> Maybe ReplicaCount
192mkReplicaCount n
193 | n < 0 = Nothing
194 | n > 1000 = Nothing -- ...
195 | otherwise = Just (ReplicaCount n)
197emptyBody :: L.ByteString
198emptyBody = L.pack ""
200dispatch :: MonadBH m
201 => Method
202 -> Text
203 -> Maybe L.ByteString
204 -> m Reply
205dispatch dMethod url body = do
206 initReq <- liftIO $ parseUrl' url
207 reqHook <- bhRequestHook A.<$> getBHEnv
208 let reqBody = RequestBodyLBS $ fromMaybe emptyBody body
209 req <- liftIO $ reqHook $ setRequestIgnoreStatus $ initReq { method = dMethod
210 , requestBody = reqBody }
211 mgr <- bhManager <$> getBHEnv
212 liftIO $ httpLbs req mgr
214joinPath' :: [Text] -> Text
215joinPath' = T.intercalate "/"
217joinPath :: MonadBH m => [Text] -> m Text
218joinPath ps = do
219 Server s <- bhServer <$> getBHEnv
220 return $ joinPath' (s:ps)
222appendSearchTypeParam :: Text -> SearchType -> Text
223appendSearchTypeParam originalUrl st = addQuery params originalUrl
224 where stText = "search_type"
225 params
226 | st == SearchTypeDfsQueryThenFetch = [(stText, Just "dfs_query_then_fetch")]
227 | st == SearchTypeCount = [(stText, Just "count")]
228 | st == SearchTypeScan = [(stText, Just "scan"), ("scroll", Just "1m")]
229 | st == SearchTypeQueryAndFetch = [(stText, Just "query_and_fetch")]
230 | st == SearchTypeDfsQueryAndFetch = [(stText, Just "dfs_query_and_fetch")]
231 -- used to catch 'SearchTypeQueryThenFetch', which is also the default
232 | otherwise = [(stText, Just "query_then_fetch")]
234-- | Severely dumbed down query renderer. Assumes your data doesn't
235-- need any encoding
236addQuery :: [(Text, Maybe Text)] -> Text -> Text
237addQuery q u = u <> rendered
238 where
239 rendered =
240 T.decodeUtf8 $ BB.toByteString $ NHTU.renderQueryText prependQuestionMark q
241 prependQuestionMark = True
243bindM2 :: (Applicative m, Monad m) => (a -> b -> m c) -> m a -> m b -> m c
244bindM2 f ma mb = join (f <$> ma <*> mb)
246-- | Convenience function that sets up a manager and BHEnv and runs
247-- the given set of bloodhound operations. Connections will be
248-- pipelined automatically in accordance with the given manager
249-- settings in IO. If you've got your own monad transformer stack, you
250-- should use 'runBH' directly.
251withBH :: ManagerSettings -> Server -> BH IO a -> IO a
252withBH ms s f = do
253 mgr <- newManager ms
254 let env = mkBHEnv s mgr
255 runBH env f
257-- Shortcut functions for HTTP methods
258delete :: MonadBH m => Text -> m Reply
259delete = flip (dispatch NHTM.methodDelete) Nothing
260get :: MonadBH m => Text -> m Reply
261get = flip (dispatch NHTM.methodGet) Nothing
262head :: MonadBH m => Text -> m Reply
263head = flip (dispatch NHTM.methodHead) Nothing
264put :: MonadBH m => Text -> Maybe L.ByteString -> m Reply
265put = dispatch NHTM.methodPut
266post :: MonadBH m => Text -> Maybe L.ByteString -> m Reply
267post = dispatch NHTM.methodPost
269-- indexDocument s ix name doc = put (root </> s </> ix </> name </> doc) (Just encode doc)
270-- http://hackage.haskell.org/package/http-client-lens-0.1.0/docs/Network-HTTP-Client-Lens.html
271-- https://github.com/supki/libjenkins/blob/master/src/Jenkins/Rest/Internal.hs
273-- | 'getStatus' fetches the 'Status' of a 'Server'
274--
275-- >>> serverStatus <- runBH' getStatus
276-- >>> fmap status (serverStatus)
277-- Just 200
278getStatus :: MonadBH m => m (Maybe Status)
279getStatus = do
280 response <- get =<< url
281 return $ decode (responseBody response)
282 where url = joinPath []
284-- | 'getSnapshotRepos' gets the definitions of a subset of the
285-- defined snapshot repos.
286getSnapshotRepos
287 :: ( MonadBH m
288 , MonadThrow m
289 )
290 => SnapshotRepoSelection
291 -> m (Either EsError [GenericSnapshotRepo])
292getSnapshotRepos sel = fmap (fmap unGSRs) . parseEsResponse =<< get =<< url
293 where
294 url = joinPath ["_snapshot", selectorSeg]
295 selectorSeg = case sel of
296 AllSnapshotRepos -> "_all"
297 SnapshotRepoList (p :| ps) -> T.intercalate "," (renderPat <$> (p:ps))
298 renderPat (RepoPattern t) = t
299 renderPat (ExactRepo (SnapshotRepoName t)) = t
302-- | Wrapper to extract the list of 'GenericSnapshotRepo' in the
303-- format they're returned in
304newtype GSRs = GSRs { unGSRs :: [GenericSnapshotRepo] }
307instance FromJSON GSRs where
308 parseJSON = withObject "Collection of GenericSnapshotRepo" parse
309 where
310 parse = fmap GSRs . mapM (uncurry go) . HM.toList
311 go rawName = withObject "GenericSnapshotRepo" $ \o -> do
312 GenericSnapshotRepo (SnapshotRepoName rawName) <$> o .: "type"
313 <*> o .: "settings"
316-- | Create or update a snapshot repo
317updateSnapshotRepo
318 :: ( MonadBH m
319 , SnapshotRepo repo
320 )
321 => SnapshotRepoUpdateSettings
322 -- ^ Use 'defaultSnapshotRepoUpdateSettings' if unsure
323 -> repo
324 -> m Reply
325updateSnapshotRepo SnapshotRepoUpdateSettings {..} repo =
326 bindM2 put url (return (Just body))
327 where
328 url = addQuery params <$> joinPath ["_snapshot", snapshotRepoName gSnapshotRepoName]
329 params
330 | repoUpdateVerify = []
331 | otherwise = [("verify", Just "false")]
332 body = encode $ object [ "type" .= gSnapshotRepoType
333 , "settings" .= gSnapshotRepoSettings
334 ]
335 GenericSnapshotRepo {..} = toGSnapshotRepo repo
339-- | Verify if a snapshot repo is working. __NOTE:__ this API did not
340-- make it into ElasticSearch until 1.4. If you use an older version,
341-- you will get an error here.
342verifySnapshotRepo
343 :: ( MonadBH m
344 , MonadThrow m
345 )
346 => SnapshotRepoName
347 -> m (Either EsError SnapshotVerification)
348verifySnapshotRepo (SnapshotRepoName n) =
349 parseEsResponse =<< bindM2 post url (return Nothing)
350 where
351 url = joinPath ["_snapshot", n, "_verify"]
354deleteSnapshotRepo :: MonadBH m => SnapshotRepoName -> m Reply
355deleteSnapshotRepo (SnapshotRepoName n) = delete =<< url
356 where
357 url = joinPath ["_snapshot", n]
360-- | Create and start a snapshot
361createSnapshot
362 :: (MonadBH m)
363 => SnapshotRepoName
364 -> SnapshotName
365 -> SnapshotCreateSettings
366 -> m Reply
367createSnapshot (SnapshotRepoName repoName)
368 (SnapshotName snapName)
369 SnapshotCreateSettings {..} =
370 bindM2 put url (return (Just body))
371 where
372 url = addQuery params <$> joinPath ["_snapshot", repoName, snapName]
373 params = [("wait_for_completion", Just (boolQP snapWaitForCompletion))]
374 body = encode $ object prs
375 prs = catMaybes [ ("indices" .=) . indexSelectionName <$> snapIndices
376 , Just ("ignore_unavailable" .= snapIgnoreUnavailable)
377 , Just ("ignore_global_state" .= snapIncludeGlobalState)
378 , Just ("partial" .= snapPartial)
379 ]
382indexSelectionName :: IndexSelection -> Text
383indexSelectionName AllIndexes = "_all"
384indexSelectionName (IndexList (i :| is)) = T.intercalate "," (renderIndex <$> (i:is))
385 where
386 renderIndex (IndexName n) = n
389-- | Get info about known snapshots given a pattern and repo name.
390getSnapshots
391 :: ( MonadBH m
392 , MonadThrow m
393 )
394 => SnapshotRepoName
395 -> SnapshotSelection
396 -> m (Either EsError [SnapshotInfo])
397getSnapshots (SnapshotRepoName repoName) sel =
398 fmap (fmap unSIs) . parseEsResponse =<< get =<< url
399 where
400 url = joinPath ["_snapshot", repoName, snapPath]
401 snapPath = case sel of
402 AllSnapshots -> "_all"
403 SnapshotList (s :| ss) -> T.intercalate "," (renderPath <$> (s:ss))
404 renderPath (SnapPattern t) = t
405 renderPath (ExactSnap (SnapshotName t)) = t
408newtype SIs = SIs { unSIs :: [SnapshotInfo] }
411instance FromJSON SIs where
412 parseJSON = withObject "Collection of SnapshotInfo" parse
413 where
414 parse o = SIs <$> o .: "snapshots"
417-- | Delete a snapshot. Cancels if it is running.
418deleteSnapshot :: MonadBH m => SnapshotRepoName -> SnapshotName -> m Reply
419deleteSnapshot (SnapshotRepoName repoName) (SnapshotName snapName) =
420 delete =<< url
421 where
422 url = joinPath ["_snapshot", repoName, snapName]
425-- | Restore a snapshot to the cluster See
426-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/modules-snapshots.html#_restore>
427-- for more details.
428restoreSnapshot
429 :: MonadBH m
430 => SnapshotRepoName
431 -> SnapshotName
432 -> SnapshotRestoreSettings
433 -- ^ Start with 'defaultSnapshotRestoreSettings' and customize
434 -- from there for reasonable defaults.
435 -> m Reply
436restoreSnapshot (SnapshotRepoName repoName)
437 (SnapshotName snapName)
438 SnapshotRestoreSettings {..} = bindM2 post url (return (Just body))
439 where
440 url = addQuery params <$> joinPath ["_snapshot", repoName, snapName, "_restore"]
441 params = [("wait_for_completion", Just (boolQP snapRestoreWaitForCompletion))]
442 body = encode (object prs)
445 prs = catMaybes [ ("indices" .=) . indexSelectionName <$> snapRestoreIndices
446 , Just ("ignore_unavailable" .= snapRestoreIgnoreUnavailable)
447 , Just ("include_global_state" .= snapRestoreIncludeGlobalState)
448 , ("rename_pattern" .=) <$> snapRestoreRenamePattern
449 , ("rename_replacement" .=) . renderTokens <$> snapRestoreRenameReplacement
450 , Just ("include_aliases" .= snapRestoreIncludeAliases)
451 , ("index_settings" .= ) <$> snapRestoreIndexSettingsOverrides
452 , ("ignore_index_settings" .= ) <$> snapRestoreIgnoreIndexSettings
453 ]
454 renderTokens (t :| ts) = mconcat (renderToken <$> (t:ts))
455 renderToken (RRTLit t) = t
456 renderToken RRSubWholeMatch = "$0"
457 renderToken (RRSubGroup g) = T.pack (show (rrGroupRefNum g))
460getNodesInfo
461 :: ( MonadBH m
462 , MonadThrow m
463 )
464 => NodeSelection
465 -> m (Either EsError NodesInfo)
466getNodesInfo sel = parseEsResponse =<< get =<< url
467 where
468 url = joinPath ["_nodes", selectionSeg]
469 selectionSeg = case sel of
470 LocalNode -> "_local"
471 NodeList (l :| ls) -> T.intercalate "," (selToSeg <$> (l:ls))
472 AllNodes -> "_all"
473 selToSeg (NodeByName (NodeName n)) = n
474 selToSeg (NodeByFullNodeId (FullNodeId i)) = i
475 selToSeg (NodeByHost (Server s)) = s
476 selToSeg (NodeByAttribute (NodeAttrName a) v) = a <> ":" <> v
478getNodesStats
479 :: ( MonadBH m
480 , MonadThrow m
481 )
482 => NodeSelection
483 -> m (Either EsError NodesStats)
484getNodesStats sel = parseEsResponse =<< get =<< url
485 where
486 url = joinPath ["_nodes", selectionSeg, "stats"]
487 selectionSeg = case sel of
488 LocalNode -> "_local"
489 NodeList (l :| ls) -> T.intercalate "," (selToSeg <$> (l:ls))
490 AllNodes -> "_all"
491 selToSeg (NodeByName (NodeName n)) = n
492 selToSeg (NodeByFullNodeId (FullNodeId i)) = i
493 selToSeg (NodeByHost (Server s)) = s
494 selToSeg (NodeByAttribute (NodeAttrName a) v) = a <> ":" <> v
496-- | 'createIndex' will create an index given a 'Server', 'IndexSettings', and an 'IndexName'.
497--
498-- >>> response <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
499-- >>> respIsTwoHunna response
500-- True
501-- >>> runBH' $ indexExists (IndexName "didimakeanindex")
502-- True
503createIndex :: MonadBH m => IndexSettings -> IndexName -> m Reply
504createIndex indexSettings (IndexName indexName) =
505 bindM2 put url (return body)
506 where url = joinPath [indexName]
507 body = Just $ encode indexSettings
510-- | 'deleteIndex' will delete an index given a 'Server', and an 'IndexName'.
511--
512-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
513-- >>> response <- runBH' $ deleteIndex (IndexName "didimakeanindex")
514-- >>> respIsTwoHunna response
515-- True
516-- >>> runBH' $ indexExists testIndex
517-- False
518deleteIndex :: MonadBH m => IndexName -> m Reply
519deleteIndex (IndexName indexName) =
520 delete =<< joinPath [indexName]
522-- | 'updateIndexSettings' will apply a non-empty list of setting updates to an index
523--
524-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "unconfiguredindex")
525-- >>> response <- runBH' $ updateIndexSettings (BlocksWrite False :| []) (IndexName "unconfiguredindex")
526-- >>> respIsTwoHunna response
527-- True
528updateIndexSettings :: MonadBH m => NonEmpty UpdatableIndexSetting -> IndexName -> m Reply
529updateIndexSettings updates (IndexName indexName) =
530 bindM2 put url (return body)
531 where url = joinPath [indexName, "_settings"]
532 body = Just (encode jsonBody)
533 jsonBody = Object (deepMerge [u | Object u <- toJSON <$> toList updates])
536getIndexSettings :: (MonadBH m, MonadThrow m) => IndexName
537 -> m (Either EsError IndexSettingsSummary)
538getIndexSettings (IndexName indexName) = do
539 parseEsResponse =<< get =<< url
540 where url = joinPath [indexName, "_settings"]
543-- | 'optimizeIndex' will optimize a single index, list of indexes or
544-- all indexes. Note that this call will block until finishing but
545-- will continue even if the request times out. Concurrent requests to
546-- optimize an index while another is performing will block until the
547-- previous one finishes. For more information see
548-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-optimize.html>. Nothing
549-- worthwhile comes back in the reply body, so matching on the status
550-- should suffice.
551--
552-- 'optimizeIndex' with a maxNumSegments of 1 and onlyExpungeDeletes
553-- to True is the main way to release disk space back to the OS being
554-- held by deleted documents.
555--
556-- Note that this API was deprecated in ElasticSearch 2.1 for the
557-- almost completely identical forcemerge API. Adding support to that
558-- API would be trivial but due to the significant breaking changes,
559-- this library cannot currently be used with >= 2.0, so that feature was omitted.
560--
561-- >>> let ixn = IndexName "unoptimizedindex"
562-- >>> _ <- runBH' $ deleteIndex ixn >> createIndex defaultIndexSettings ixn
563-- >>> response <- runBH' $ optimizeIndex (IndexList (ixn :| [])) (defaultIndexOptimizationSettings { maxNumSegments = Just 1, onlyExpungeDeletes = True })
564-- >>> respIsTwoHunna response
565-- True
566optimizeIndex :: MonadBH m => IndexSelection -> IndexOptimizationSettings -> m Reply
567optimizeIndex ixs IndexOptimizationSettings {..} =
568 bindM2 post url (return body)
569 where url = addQuery params <$> joinPath [indexName, "_optimize"]
570 params = catMaybes [ ("max_num_segments",) . Just . showText <$> maxNumSegments
571 , Just ("only_expunge_deletes", Just (boolQP onlyExpungeDeletes))
572 , Just ("flush", Just (boolQP flushAfterOptimize))
573 ]
574 indexName = indexSelectionName ixs
575 body = Nothing
578deepMerge :: [Object] -> Object
579deepMerge = LS.foldl' go mempty
580 where go acc = LS.foldl' go' acc . HM.toList
581 go' acc (k, v) = HM.insertWith merge k v acc
582 merge (Object a) (Object b) = Object (deepMerge [a, b])
583 merge _ b = b
586statusCodeIs :: (Int, Int) -> Reply -> Bool
587statusCodeIs r resp = inRange r $ NHTS.statusCode (responseStatus resp)
589respIsTwoHunna :: Reply -> Bool
590respIsTwoHunna = statusCodeIs (200, 299)
592existentialQuery :: MonadBH m => Text -> m (Reply, Bool)
593existentialQuery url = do
594 reply <- head url
595 return (reply, respIsTwoHunna reply)
598-- | Tries to parse a response body as the expected type @a@ and
599-- failing that tries to parse it as an EsError. All well-formed, JSON
600-- responses from elasticsearch should fall into these two
601-- categories. If they don't, a 'EsProtocolException' will be
602-- thrown. If you encounter this, please report the full body it
603-- reports along with your ElasticSearch verison.
604parseEsResponse :: (MonadThrow m, FromJSON a) => Reply
605 -> m (Either EsError a)
606parseEsResponse reply
607 | respIsTwoHunna reply = case eitherDecode body of
608 Right a -> return (Right a)
609 Left _ -> tryParseError
610 | otherwise = tryParseError
611 where body = responseBody reply
612 tryParseError = case eitherDecode body of
613 Right e -> return (Left e)
614 -- this case should not be possible
615 Left _ -> explode
616 explode = throwM (EsProtocolException body)
618-- | 'indexExists' enables you to check if an index exists. Returns 'Bool'
619-- in IO
620--
621-- >>> exists <- runBH' $ indexExists testIndex
622indexExists :: MonadBH m => IndexName -> m Bool
623indexExists (IndexName indexName) = do
624 (_, exists) <- existentialQuery =<< joinPath [indexName]
625 return exists
627-- | 'refreshIndex' will force a refresh on an index. You must
628-- do this if you want to read what you wrote.
629--
630-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
631-- >>> _ <- runBH' $ refreshIndex testIndex
632refreshIndex :: MonadBH m => IndexName -> m Reply
633refreshIndex (IndexName indexName) =
634 bindM2 post url (return Nothing)
635 where url = joinPath [indexName, "_refresh"]
637-- | Block until the index becomes available for indexing
638-- documents. This is useful for integration tests in which
639-- indices are rapidly created and deleted.
640waitForYellowIndex :: MonadBH m => IndexName -> m Reply
641waitForYellowIndex (IndexName indexName) = get =<< url
642 where url = addQuery q <$> joinPath ["_cluster","health",indexName]
643 q = [("wait_for_status",Just "yellow"),("timeout",Just "10s")]
645stringifyOCIndex :: OpenCloseIndex -> Text
646stringifyOCIndex oci = case oci of
647 OpenIndex -> "_open"
648 CloseIndex -> "_close"
650openOrCloseIndexes :: MonadBH m => OpenCloseIndex -> IndexName -> m Reply
651openOrCloseIndexes oci (IndexName indexName) =
652 bindM2 post url (return Nothing)
653 where ociString = stringifyOCIndex oci
654 url = joinPath [indexName, ociString]
656-- | 'openIndex' opens an index given a 'Server' and an 'IndexName'. Explained in further detail at
657-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
658--
659-- >>> reply <- runBH' $ openIndex testIndex
660openIndex :: MonadBH m => IndexName -> m Reply
661openIndex = openOrCloseIndexes OpenIndex
663-- | 'closeIndex' closes an index given a 'Server' and an 'IndexName'. Explained in further detail at
664-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
665--
666-- >>> reply <- runBH' $ closeIndex testIndex
667closeIndex :: MonadBH m => IndexName -> m Reply
668closeIndex = openOrCloseIndexes CloseIndex
670-- | 'listIndices' returns a list of all index names on a given 'Server'
671listIndices :: (MonadThrow m, MonadBH m) => m [IndexName]
672listIndices =
673 parse . responseBody =<< get =<< url
674 where
675 url = joinPath ["_cat/indices?v"]
676 -- parses the tabular format the indices api provides
677 parse body = case T.lines (T.decodeUtf8 (L.toStrict body)) of
678 (hdr:rows) -> let ks = T.words hdr
679 keyedRows = [ HM.fromList (zip ks (T.words row)) | row <- rows ]
680 names = catMaybes (HM.lookup "index" <$> keyedRows)
681 in return (IndexName <$> names)
682 [] -> throwM (EsProtocolException body)
684-- | 'updateIndexAliases' updates the server's index alias
685-- table. Operations are atomic. Explained in further detail at
686-- <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-aliases.html>
687--
688-- >>> let src = IndexName "a-real-index"
689-- >>> let aliasName = IndexName "an-alias"
690-- >>> let iAlias = IndexAlias src (IndexAliasName aliasName)
691-- >>> let aliasCreate = IndexAliasCreate Nothing Nothing
692-- >>> _ <- runBH' $ deleteIndex src
693-- >>> respIsTwoHunna <$> runBH' (createIndex defaultIndexSettings src)
694-- True
695-- >>> runBH' $ indexExists src
696-- True
697-- >>> respIsTwoHunna <$> runBH' (updateIndexAliases (AddAlias iAlias aliasCreate :| []))
698-- True
699-- >>> runBH' $ indexExists aliasName
700-- True
701updateIndexAliases :: MonadBH m => NonEmpty IndexAliasAction -> m Reply
702updateIndexAliases actions = bindM2 post url (return body)
703 where url = joinPath ["_aliases"]
704 body = Just (encode bodyJSON)
705 bodyJSON = object [ "actions" .= toList actions]
707-- | Get all aliases configured on the server.
708getIndexAliases :: (MonadBH m, MonadThrow m)
709 => m (Either EsError IndexAliasesSummary)
710getIndexAliases = parseEsResponse =<< get =<< url
711 where url = joinPath ["_aliases"]
713-- | 'putTemplate' creates a template given an 'IndexTemplate' and a 'TemplateName'.
714-- Explained in further detail at
715-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html>
716--
717-- >>> let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
718-- >>> resp <- runBH' $ putTemplate idxTpl (TemplateName "tweet-tpl")
719putTemplate :: MonadBH m => IndexTemplate -> TemplateName -> m Reply
720putTemplate indexTemplate (TemplateName templateName) =
721 bindM2 put url (return body)
722 where url = joinPath ["_template", templateName]
723 body = Just $ encode indexTemplate
725-- | 'templateExists' checks to see if a template exists.
726--
727-- >>> exists <- runBH' $ templateExists (TemplateName "tweet-tpl")
728templateExists :: MonadBH m => TemplateName -> m Bool
729templateExists (TemplateName templateName) = do
730 (_, exists) <- existentialQuery =<< joinPath ["_template", templateName]
731 return exists
733-- | 'deleteTemplate' is an HTTP DELETE and deletes a template.
734--
735-- >>> let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
736-- >>> _ <- runBH' $ putTemplate idxTpl (TemplateName "tweet-tpl")
737-- >>> resp <- runBH' $ deleteTemplate (TemplateName "tweet-tpl")
738deleteTemplate :: MonadBH m => TemplateName -> m Reply
739deleteTemplate (TemplateName templateName) =
740 delete =<< joinPath ["_template", templateName]
742-- | 'putMapping' is an HTTP PUT and has upsert semantics. Mappings are schemas
743-- for documents in indexes.
744--
745-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
746-- >>> resp <- runBH' $ putMapping testIndex testMapping TweetMapping
747-- >>> print resp
748-- 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}
749putMapping :: (MonadBH m, ToJSON a) => IndexName
750 -> MappingName -> a -> m Reply
751putMapping (IndexName indexName) (MappingName mappingName) mapping =
752 bindM2 put url (return body)
753 where url = joinPath [indexName, "_mapping", mappingName]
754 -- "_mapping" and mappingName above were originally transposed
755 -- erroneously. The correct API call is: "/INDEX/_mapping/MAPPING_NAME"
756 body = Just $ encode mapping
758-- | 'deleteMapping' is an HTTP DELETE and deletes a mapping for a given index.
759-- Mappings are schemas for documents in indexes.
760--
761-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
762-- >>> _ <- runBH' $ putMapping testIndex testMapping TweetMapping
763-- >>> resp <- runBH' $ deleteMapping testIndex testMapping
764-- >>> print resp
765-- 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}
766deleteMapping :: MonadBH m => IndexName -> MappingName -> m Reply
767deleteMapping (IndexName indexName)
768 (MappingName mappingName) =
769 -- "_mapping" and mappingName below were originally transposed
770 -- erroneously. The correct API call is: "/INDEX/_mapping/MAPPING_NAME"
771 delete =<< joinPath [indexName, "_mapping", mappingName]
773versionCtlParams :: IndexDocumentSettings -> [(Text, Maybe Text)]
774versionCtlParams cfg =
775 case idsVersionControl cfg of
776 NoVersionControl -> []
777 InternalVersion v -> versionParams v "internal"
778 ExternalGT (ExternalDocVersion v) -> versionParams v "external_gt"
779 ExternalGTE (ExternalDocVersion v) -> versionParams v "external_gte"
780 ForceVersion (ExternalDocVersion v) -> versionParams v "force"
781 where
782 vt = showText . docVersionNumber
783 versionParams v t = [ ("version", Just $ vt v)
784 , ("version_type", Just t)
785 ]
787-- | 'indexDocument' is the primary way to save a single document in
788-- Elasticsearch. The document itself is simply something we can
789-- convert into a JSON 'Value'. The 'DocId' will function as the
790-- primary key for the document.
791--
792-- >>> resp <- runBH' $ indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "1")
793-- >>> print resp
794-- 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}
795indexDocument :: (ToJSON doc, MonadBH m) => IndexName -> MappingName
796 -> IndexDocumentSettings -> doc -> DocId -> m Reply
797indexDocument (IndexName indexName)
798 (MappingName mappingName) cfg document (DocId docId) =
799 bindM2 put url (return body)
800 where url = addQuery params <$> joinPath [indexName, mappingName, docId]
801 parentParams = case idsParent cfg of
802 Nothing -> []
803 Just (DocumentParent (DocId p)) -> [ ("parent", Just p) ]
804 params = versionCtlParams cfg ++ parentParams
805 body = Just (encode document)
807-- | 'updateDocument' provides a way to perform an partial update of a
808-- an already indexed document.
809updateDocument :: (ToJSON patch, MonadBH m) => IndexName -> MappingName
810 -> IndexDocumentSettings -> patch -> DocId -> m Reply
811updateDocument (IndexName indexName)
812 (MappingName mappingName) cfg patch (DocId docId) =
813 bindM2 post url (return body)
814 where url = addQuery (versionCtlParams cfg) <$>
815 joinPath [indexName, mappingName, docId, "_update"]
816 body = Just (encode $ object ["doc" .= toJSON patch])
818-- | 'deleteDocument' is the primary way to delete a single document.
819--
820-- >>> _ <- runBH' $ deleteDocument testIndex testMapping (DocId "1")
821deleteDocument :: MonadBH m => IndexName -> MappingName
822 -> DocId -> m Reply
823deleteDocument (IndexName indexName)
824 (MappingName mappingName) (DocId docId) =
825 delete =<< joinPath [indexName, mappingName, docId]
827-- | 'bulk' uses
828-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html Elasticsearch's bulk API>
829-- to perform bulk operations. The 'BulkOperation' data type encodes the
830-- index\/update\/delete\/create operations. You pass a 'V.Vector' of 'BulkOperation's
831-- and a 'Server' to 'bulk' in order to send those operations up to your Elasticsearch
832-- server to be performed. I changed from [BulkOperation] to a Vector due to memory overhead.
833--
834-- >>> let stream = V.fromList [BulkIndex testIndex testMapping (DocId "2") (toJSON (BulkTest "blah"))]
835-- >>> _ <- runBH' $ bulk stream
836-- >>> _ <- runBH' $ refreshIndex testIndex
837bulk :: MonadBH m => V.Vector BulkOperation -> m Reply
838bulk bulkOps = bindM2 post url (return body)
839 where url = joinPath ["_bulk"]
840 body = Just $ encodeBulkOperations bulkOps
842-- | 'encodeBulkOperations' is a convenience function for dumping a vector of 'BulkOperation'
843-- into an 'L.ByteString'
844--
845-- >>> let bulkOps = V.fromList [BulkIndex testIndex testMapping (DocId "2") (toJSON (BulkTest "blah"))]
846-- >>> encodeBulkOperations bulkOps
847-- "\n{\"index\":{\"_type\":\"tweet\",\"_id\":\"2\",\"_index\":\"twitter\"}}\n{\"name\":\"blah\"}\n"
848encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString
849encodeBulkOperations stream = collapsed where
850 blobs = fmap encodeBulkOperation stream
851 mashedTaters = mash (mempty :: Builder) blobs
852 collapsed = toLazyByteString $ mappend mashedTaters (byteString "\n")
854mash :: Builder -> V.Vector L.ByteString -> Builder
855mash = V.foldl' (\b x -> b `mappend` (byteString "\n") `mappend` (lazyByteString x))
857mkBulkStreamValue :: Text -> Text -> Text -> Text -> Value
858mkBulkStreamValue operation indexName mappingName docId =
859 object [operation .=
860 object [ "_index" .= indexName
861 , "_type" .= mappingName
862 , "_id" .= docId]]
864-- | 'encodeBulkOperation' is a convenience function for dumping a single 'BulkOperation'
865-- into an 'L.ByteString'
866--
867-- >>> let bulkOp = BulkIndex testIndex testMapping (DocId "2") (toJSON (BulkTest "blah"))
868-- >>> encodeBulkOperation bulkOp
869-- "{\"index\":{\"_type\":\"tweet\",\"_id\":\"2\",\"_index\":\"twitter\"}}\n{\"name\":\"blah\"}"
870encodeBulkOperation :: BulkOperation -> L.ByteString
871encodeBulkOperation (BulkIndex (IndexName indexName)
872 (MappingName mappingName)
873 (DocId docId) value) = blob
874 where metadata = mkBulkStreamValue "index" indexName mappingName docId
875 blob = encode metadata `mappend` "\n" `mappend` encode value
877encodeBulkOperation (BulkCreate (IndexName indexName)
878 (MappingName mappingName)
879 (DocId docId) value) = blob
880 where metadata = mkBulkStreamValue "create" indexName mappingName docId
881 blob = encode metadata `mappend` "\n" `mappend` encode value
883encodeBulkOperation (BulkDelete (IndexName indexName)
884 (MappingName mappingName)
885 (DocId docId)) = blob
886 where metadata = mkBulkStreamValue "delete" indexName mappingName docId
887 blob = encode metadata
889encodeBulkOperation (BulkUpdate (IndexName indexName)
890 (MappingName mappingName)
891 (DocId docId) value) = blob
892 where metadata = mkBulkStreamValue "update" indexName mappingName docId
893 doc = object ["doc" .= value]
894 blob = encode metadata `mappend` "\n" `mappend` encode doc
896-- | 'getDocument' is a straight-forward way to fetch a single document from
897-- Elasticsearch using a 'Server', 'IndexName', 'MappingName', and a 'DocId'.
898-- The 'DocId' is the primary key for your Elasticsearch document.
899--
900-- >>> yourDoc <- runBH' $ getDocument testIndex testMapping (DocId "1")
901getDocument :: MonadBH m => IndexName -> MappingName
902 -> DocId -> m Reply
903getDocument (IndexName indexName)
904 (MappingName mappingName) (DocId docId) =
905 get =<< joinPath [indexName, mappingName, docId]
907-- | 'documentExists' enables you to check if a document exists. Returns 'Bool'
908-- in IO
909--
910-- >>> exists <- runBH' $ documentExists testIndex testMapping Nothing (DocId "1")
911documentExists :: MonadBH m => IndexName -> MappingName
912 -> Maybe DocumentParent -> DocId -> m Bool
913documentExists (IndexName indexName) (MappingName mappingName)
914 parent (DocId docId) = do
915 (_, exists) <- existentialQuery =<< url
916 return exists
917 where url = addQuery params <$> joinPath [indexName, mappingName, docId]
918 parentParam = fmap (\(DocumentParent (DocId p)) -> p) parent
919 params = LS.filter (\(_, v) -> isJust v) [("parent", parentParam)]
921dispatchSearch :: MonadBH m => Text -> Search -> m Reply
922dispatchSearch url search = post url' (Just (encode search))
923 where url' = appendSearchTypeParam url (searchType search)
925-- | 'searchAll', given a 'Search', will perform that search against all indexes
926-- on an Elasticsearch server. Try to avoid doing this if it can be helped.
927--
928-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
929-- >>> let search = mkSearch (Just query) Nothing
930-- >>> reply <- runBH' $ searchAll search
931searchAll :: MonadBH m => Search -> m Reply
932searchAll = bindM2 dispatchSearch url . return
933 where url = joinPath ["_search"]
935-- | 'searchByIndex', given a 'Search' and an 'IndexName', will perform that search
936-- against all mappings within an index on an Elasticsearch server.
937--
938-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
939-- >>> let search = mkSearch (Just query) Nothing
940-- >>> reply <- runBH' $ searchByIndex testIndex search
941searchByIndex :: MonadBH m => IndexName -> Search -> m Reply
942searchByIndex (IndexName indexName) = bindM2 dispatchSearch url . return
943 where url = joinPath [indexName, "_search"]
945-- | 'searchByType', given a 'Search', 'IndexName', and 'MappingName', will perform that
946-- search against a specific mapping within an index on an Elasticsearch server.
947--
948-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
949-- >>> let search = mkSearch (Just query) Nothing
950-- >>> reply <- runBH' $ searchByType testIndex testMapping search
951searchByType :: MonadBH m => IndexName -> MappingName -> Search
952 -> m Reply
953searchByType (IndexName indexName)
954 (MappingName mappingName) = bindM2 dispatchSearch url . return
955 where url = joinPath [indexName, mappingName, "_search"]
957-- | For a given scearch, request a scroll for efficient streaming of
958-- search results. Note that the search is put into 'SearchTypeScan'
959-- mode and thus results will not be sorted. Combine this with
960-- 'advanceScroll' to efficiently stream through the full result set
961getInitialScroll :: MonadBH m => IndexName -> MappingName -> Search -> m (Maybe ScrollId)
962getInitialScroll (IndexName indexName) (MappingName mappingName) search = do
963 let url = joinPath [indexName, mappingName, "_search"]
964 search' = search { searchType = SearchTypeScan }
965 resp' <- bindM2 dispatchSearch url (return search')
966 let msr = decode' $ responseBody resp' :: Maybe (SearchResult ())
967 msid = maybe Nothing scrollId msr
968 return msid
970scroll' :: (FromJSON a, MonadBH m, MonadThrow m) => Maybe ScrollId -> m ([Hit a], Maybe ScrollId)
971scroll' Nothing = return ([], Nothing)
972scroll' (Just sid) = do
973 res <- advanceScroll sid 60
974 case res of
975 Right SearchResult {..} -> return (hits searchHits, scrollId)
976 Left _ -> return ([], Nothing)
978-- | Use the given scroll to fetch the next page of documents. If there are no
979-- further pages, 'SearchResult.searchHits.hits' will be '[]'.
980advanceScroll
981 :: ( FromJSON a
982 , MonadBH m
983 , MonadThrow m
984 )
985 => ScrollId
986 -> NominalDiffTime
987 -- ^ 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.
988 -> m (Either EsError (SearchResult a))
989advanceScroll (ScrollId sid) scroll = do
990 url <- joinPath ["_search/scroll?scroll=" <> scrollTime]
991 parseEsResponse =<< post url (Just . L.fromStrict $ T.encodeUtf8 sid)
992 where scrollTime = showText secs <> "s"
993 secs :: Integer
994 secs = round scroll
996simpleAccumulator :: (FromJSON a, MonadBH m, MonadThrow m) => [Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
997simpleAccumulator oldHits (newHits, Nothing) = return (oldHits ++ newHits, Nothing)
998simpleAccumulator oldHits ([], _) = return (oldHits, Nothing)
999simpleAccumulator oldHits (newHits, msid) = do
1000 (newHits', msid') <- scroll' msid
1001 simpleAccumulator (oldHits ++ newHits) (newHits', msid')
1003-- | 'scanSearch' uses the 'scan&scroll' API of elastic,
1004-- for a given 'IndexName' and 'MappingName'. Note that this will
1005-- consume the entire search result set and will be doing O(n) list
1006-- appends so this may not be suitable for large result sets. In that
1007-- case, 'getInitialScroll' and 'advanceScroll' are good low level
1008-- tools. You should be able to hook them up trivially to conduit,
1009-- pipes, or your favorite streaming IO abstraction of choice. Note
1010-- that ordering on the search would destroy performance and thus is
1011-- ignored.
1012scanSearch :: (FromJSON a, MonadBH m, MonadThrow m) => IndexName -> MappingName -> Search -> m [Hit a]
1013scanSearch indexName mappingName search = do
1014 msid <- getInitialScroll indexName mappingName search
1015 (hits, msid') <- scroll' msid
1016 (totalHits, _) <- simpleAccumulator [] (hits, msid')
1017 return totalHits
1019-- | 'mkSearch' is a helper function for defaulting additional fields of a 'Search'
1020-- to Nothing in case you only care about your 'Query' and 'Filter'. Use record update
1021-- syntax if you want to add things like aggregations or highlights while still using
1022-- this helper function.
1024-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
1025-- >>> mkSearch (Just query) Nothing
1026-- 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}
1027mkSearch :: Maybe Query -> Maybe Filter -> Search
1028mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
1030-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for
1031-- the 'Query' and the 'Aggregation'.
1033-- >>> let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
1034-- >>> terms
1035-- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing})
1036-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms
1037mkAggregateSearch :: Maybe Query -> Aggregations -> Search
1038mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) SearchTypeQueryThenFetch Nothing Nothing
1040-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for
1041-- the 'Query' and the 'Aggregation'.
1043-- >>> let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1044-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
1045-- >>> let search = mkHighlightSearch (Just query) testHighlight
1046mkHighlightSearch :: Maybe Query -> Highlights -> Search
1047mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
1049-- | 'pageSearch' is a helper function that takes a search and assigns the from
1050-- and size fields for the search. The from parameter defines the offset
1051-- from the first result you want to fetch. The size parameter allows you to
1052-- configure the maximum amount of hits to be returned.
1054-- >>> let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1055-- >>> let search = mkSearch (Just query) Nothing
1056-- >>> search
1057-- 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}
1058-- >>> pageSearch (From 10) (Size 100) search
1059-- 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}
1060pageSearch :: From -- ^ The result offset
1061 -> Size -- ^ The number of results to return
1062 -> Search -- ^ The current seach
1063 -> Search -- ^ The paged search
1064pageSearch resultOffset pageSize search = search { from = resultOffset, size = pageSize }
1066parseUrl' :: MonadThrow m => Text -> m Request
1067parseUrl' t = parseRequest (URI.escapeURIString URI.isAllowedInURI (T.unpack t))
1069-- | Was there an optimistic concurrency control conflict when
1070-- indexing a document?
1071isVersionConflict :: Reply -> Bool
1072isVersionConflict = statusCheck (== 409)
1074isSuccess :: Reply -> Bool
1075isSuccess = statusCheck (inRange (200, 299))
1077isCreated :: Reply -> Bool
1078isCreated = statusCheck (== 201)
1080statusCheck :: (Int -> Bool) -> Reply -> Bool
1081statusCheck prd = prd . NHTS.statusCode . responseStatus
1083-- | This is a hook that can be set via the 'bhRequestHook' function
1084-- that will authenticate all requests using an HTTP Basic
1085-- Authentication header. Note that it is *strongly* recommended that
1086-- this option only be used over an SSL connection.
1088-- >> (mkBHEnv myServer myManager) { bhRequestHook = basicAuthHook (EsUsername "myuser") (EsPassword "mypass") }
1089basicAuthHook :: Monad m => EsUsername -> EsPassword -> Request -> m Request
1090basicAuthHook (EsUsername u) (EsPassword p) = return . applyBasicAuth u' p'
1091 where u' = T.encodeUtf8 u
1092 p' = T.encodeUtf8 p
1095boolQP :: Bool -> Text
1096boolQP True = "true"
1097boolQP False = "false"