@@ -18,428 +18,40 @@
19module Main where
19module Main where
21import Test.Import
22import Test.Import
23−import Control.Error hiding (Script)
24−import qualified Data.HashMap.Strict as HM
25−import Data.List (nub)
26−import qualified Data.List as L
27−import Data.List.NonEmpty (NonEmpty (..))
28−import qualified Data.List.NonEmpty as NE
29−import qualified Data.Map.Strict as M
30−import Data.Text (Text)
31−import qualified Data.Text as T
32−import Data.Time.Calendar (Day (..), fromGregorian)
33−import Data.Time.Clock (UTCTime (..),
35−import qualified Data.Vector as V
36−import qualified Data.Version as Vers
37−import qualified Database.V5.Bloodhound
38−import qualified Lens.Micro.Aeson as LMA
39−import qualified Network.HTTP.Types.Method as NHTM
40−import qualified Network.HTTP.Types.Status as NHTS
41−import qualified Network.URI as URI
42import Prelude hiding (filter)
24import Prelude hiding (filter)
26+import qualified Test.Aggregation as Aggregation
27+import qualified Test.BulkAPI as Bulk
28+import qualified Test.Documents as Documents
29+import qualified Test.Highlights as Highlights
30+import qualified Test.Indices as Indices
44import qualified Test.JSON as JSON
31import qualified Test.JSON as JSON
45−
32+import qualified Test.Query as Query
46−testServer :: Server
33+import qualified Test.Script as Script
47−testServer = Server "http://localhost:9200"
34+import qualified Test.Snapshots as Snapshots
48−testIndex :: IndexName
35+import qualified Test.Sorting as Sorting
49−testIndex = IndexName "bloodhound-tests-twitter-1"
36+import qualified Test.SourceFiltering as SourceFiltering
50−testMapping :: MappingName
37+import qualified Test.Suggest as Suggest
51−testMapping = MappingName "tweet"
38+import qualified Test.Templates as Templates
53−withTestEnv :: BH IO a -> IO a
54−withTestEnv = withBH defaultManagerSettings testServer
56−validateStatus :: Show body => Response body -> Int -> Expectation
57−validateStatus resp expected =
58− if actual == expected
60− else expectationFailure ("Expected " <> show expected <> " but got " <> show actual <> ": " <> show body)
62− actual = NHTS.statusCode (responseStatus resp)
63− body = responseBody resp
65−createExampleIndex :: (MonadBH m) => m Reply
66−createExampleIndex = createIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) testIndex
67−deleteExampleIndex :: (MonadBH m) => m Reply
68−deleteExampleIndex = deleteIndex testIndex
71−es13 = Vers.Version [1, 3, 0] []
74−es12 = Vers.Version [1, 2, 0] []
77−es11 = Vers.Version [1, 1, 0] []
80−es14 = Vers.Version [1, 4, 0] []
83−es15 = Vers.Version [1, 5, 0] []
86−es16 = Vers.Version [1, 6, 0] []
89−es20 = Vers.Version [2, 0, 0] []
92−es50 = Vers.Version [5, 0, 0] []
94−getServerVersion :: IO (Maybe Vers.Version)
95−getServerVersion = fmap extractVersion <$> withTestEnv getStatus
97− extractVersion = versionNumber . number . version
99−-- | Get configured repo paths for snapshotting. Note that by default
100−-- this is not enabled and if we are over es 1.5, we won't be able to
101−-- test snapshotting. Note that this can and should be part of the
102−-- client functionality in a much less ad-hoc incarnation.
103−getRepoPaths :: IO [FilePath]
104−getRepoPaths = withTestEnv $ do
106− let Server s = bhServer bhe
107− let tUrl = s <> "/" <> "_nodes"
108− initReq <- parseRequest (URI.escapeURIString URI.isAllowedInURI (T.unpack tUrl))
109− let req = setRequestIgnoreStatus $ initReq { method = NHTM.methodGet }
110− Right (Object o) <- parseEsResponse =<< liftIO (httpLbs req (bhManager bhe))
111− return $ fromMaybe mempty $ do
112− Object nodes <- HM.lookup "nodes" o
113− Object firstNode <- snd <$> headMay (HM.toList nodes)
114− Object settings <- HM.lookup "settings" firstNode
115− Object path <- HM.lookup "path" settings
116− Array repo <- HM.lookup "repo" path
117− return [ T.unpack t | String t <- V.toList repo]
119−-- | 1.5 and earlier don't care about repo paths
120−canSnapshot :: IO Bool
122− caresAboutRepos <- atleast es16
123− repoPaths <- getRepoPaths
124− return (not caresAboutRepos || not (null (repoPaths)))
126−atleast :: Vers.Version -> IO Bool
127−atleast v = getServerVersion >>= \x -> return $ x >= Just v
129−atmost :: Vers.Version -> IO Bool
130−atmost v = getServerVersion >>= \x -> return $ x <= Just v
132−is :: Vers.Version -> IO Bool
133−is v = getServerVersion >>= \x -> return $ x == Just v
135−when' :: Monad m => m Bool -> m () -> m ()
136−when' b f = b >>= \x -> when x f
138−data Location = Location { lat :: Double
139− , lon :: Double } deriving (Eq, Show)
141−data Tweet = Tweet { user :: Text
142− , postDate :: UTCTime
145− , location :: Location
146− , extra :: Maybe Text }
149−$(deriveJSON defaultOptions ''Location)
150−$(deriveJSON defaultOptions ''Tweet)
152−data ParentMapping = ParentMapping deriving (Eq, Show)
154−instance ToJSON ParentMapping where
155− toJSON ParentMapping =
156− object ["properties" .=
157− object [ "user" .= object ["type" .= ("string" :: Text)
158− , "fielddata" .= True
160− -- Serializing the date as a date is breaking other tests, mysteriously.
161− -- , "postDate" .= object [ "type" .= ("date" :: Text)
162− -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
163− , "message" .= object ["type" .= ("string" :: Text)]
164− , "age" .= object ["type" .= ("integer" :: Text)]
165− , "location" .= object ["type" .= ("geo_point" :: Text)]
166− , "extra" .= object ["type" .= ("keyword" :: Text)]
169−data ChildMapping = ChildMapping deriving (Eq, Show)
171−instance ToJSON ChildMapping where
172− toJSON ChildMapping =
173− object ["_parent" .= object ["type" .= ("parent" :: Text)]
175− object [ "user" .= object ["type" .= ("string" :: Text)
176− , "fielddata" .= True
178− -- Serializing the date as a date is breaking other tests, mysteriously.
179− -- , "postDate" .= object [ "type" .= ("date" :: Text)
180− -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
181− , "message" .= object ["type" .= ("string" :: Text)]
182− , "age" .= object ["type" .= ("integer" :: Text)]
183− , "location" .= object ["type" .= ("geo_point" :: Text)]
184− , "extra" .= object ["type" .= ("keyword" :: Text)]
187−data TweetMapping = TweetMapping deriving (Eq, Show)
189−instance ToJSON TweetMapping where
190− toJSON TweetMapping =
192− object ["properties" .=
193− object [ "user" .= object [ "type" .= ("string" :: Text)
194− , "fielddata" .= True
196− -- Serializing the date as a date is breaking other tests, mysteriously.
197− -- , "postDate" .= object [ "type" .= ("date" :: Text)
198− -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
199− , "message" .= object ["type" .= ("string" :: Text)]
200− , "age" .= object ["type" .= ("integer" :: Text)]
201− , "location" .= object ["type" .= ("geo_point" :: Text)]
202− , "extra" .= object ["type" .= ("keyword" :: Text)]
205−exampleTweet :: Tweet
206−exampleTweet = Tweet { user = "bitemyapp"
207− , postDate = UTCTime
208− (ModifiedJulianDay 55000)
209− (secondsToDiffTime 10)
210− , message = "Use haskell!"
212− , location = Location 40.12 (-71.34)
215−tweetWithExtra :: Tweet
216−tweetWithExtra = Tweet { user = "bitemyapp"
217− , postDate = UTCTime
218− (ModifiedJulianDay 55000)
219− (secondsToDiffTime 10)
220− , message = "Use haskell!"
222− , location = Location 40.12 (-71.34)
223− , extra = Just "blah blah" }
229−newUser = "someotherapp"
233− object [ "age" .= newAge
237−patchedTweet :: Tweet
238−patchedTweet = exampleTweet{age = newAge, user = newUser}
241−otherTweet = Tweet { user = "notmyapp"
242− , postDate = UTCTime
243− (ModifiedJulianDay 55000)
244− (secondsToDiffTime 11)
245− , message = "Use haskell!"
247− , location = Location 40.12 (-71.34)
250−resetIndex :: BH IO ()
252− _ <- deleteExampleIndex
253− _ <- createExampleIndex
254− _ <- putMapping testIndex testMapping TweetMapping
257−insertData :: BH IO Reply
260− insertData' defaultIndexDocumentSettings
262−insertData' :: IndexDocumentSettings -> BH IO Reply
264− r <- indexDocument testIndex testMapping ids exampleTweet (DocId "1")
265− _ <- refreshIndex testIndex
268−updateData :: BH IO Reply
270− r <- updateDocument testIndex testMapping defaultIndexDocumentSettings tweetPatch (DocId "1")
271− _ <- refreshIndex testIndex
274−insertOther :: BH IO ()
276− _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings otherTweet (DocId "2")
277− _ <- refreshIndex testIndex
280−insertExtra :: BH IO ()
282− _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings tweetWithExtra (DocId "4")
283− _ <- refreshIndex testIndex
286−insertWithSpaceInId :: BH IO ()
287−insertWithSpaceInId = do
288− _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "Hello World")
289− _ <- refreshIndex testIndex
292−searchTweet :: Search -> BH IO (Either EsError Tweet)
293−searchTweet search = do
294− result <- searchTweets search
295− let myTweet :: Either EsError Tweet
296− myTweet = grabFirst result
299−searchTweets :: Search -> BH IO (Either EsError (SearchResult Tweet))
300−searchTweets search = parseEsResponse =<< searchByIndex testIndex search
302−searchExpectNoResults :: Search -> BH IO ()
303−searchExpectNoResults search = do
304− result <- searchTweets search
305− let emptyHits = fmap (hits . searchHits) result
307− emptyHits `shouldBe` Right []
309−searchExpectAggs :: Search -> BH IO ()
310−searchExpectAggs search = do
311− reply <- searchByIndex testIndex search
312− let isEmpty x = return (M.null x)
313− let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
315− (result >>= aggregations >>= isEmpty) `shouldBe` Just False
317−searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) =>
318− Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> BH IO ()
319−searchValidBucketAgg search aggKey extractor = do
320− reply <- searchByIndex testIndex search
321− let bucketDocs = docCount . head . buckets
322− let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
323− let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)
325− count `shouldBe` Just 1
327−searchTermsAggHint :: [ExecutionHint] -> BH IO ()
328−searchTermsAggHint hints = do
329− let terms hint = TermsAgg $ (mkTermsAggregation "user") { termExecutionHint = Just hint }
330− let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint
331− forM_ hints $ searchExpectAggs . search
332− forM_ hints (\x -> searchValidBucketAgg (search x) "users" toTerms)
334−searchTweetHighlight :: Search -> BH IO (Either EsError (Maybe HitHighlight))
335−searchTweetHighlight search = do
336− result <- searchTweets search
337− let myHighlight = fmap (hitHighlight . head . hits . searchHits) result
340−searchExpectSource :: Source -> Either EsError Value -> BH IO ()
341−searchExpectSource src expected = do
343− let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
344− let search = (mkSearch (Just query) Nothing) { source = Just src }
345− reply <- searchByIndex testIndex search
346− result <- parseEsResponse reply
347− let value = grabFirst result
349− value `shouldBe` expected
356− -> (GenericSnapshotRepo -> m a)
358−withSnapshotRepo srn@(SnapshotRepoName n) f = do
359− repoPaths <- liftIO getRepoPaths
360− -- we'll use the first repo path if available, otherwise system temp
361− -- dir. Note that this will fail on ES > 1.6, so be sure you use
362− -- @when' canSnapshot@.
364− (firstRepoPath:_) -> withTempDirectory firstRepoPath (T.unpack n) $ \dir -> bracket (alloc dir) free f
365− [] -> withSystemTempDirectory (T.unpack n) $ \dir -> bracket (alloc dir) free f
368− liftIO (setFileMode dir mode)
369− let repo = FsSnapshotRepo srn "bloodhound-tests-backups" True Nothing Nothing Nothing
370− resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings repo
371− liftIO (validateStatus resp 200)
372− return (toGSnapshotRepo repo)
373− mode = ownerModes `unionFileModes` groupModes `unionFileModes` otherModes
374− free GenericSnapshotRepo {..} = do
375− resp <- deleteSnapshotRepo gSnapshotRepoName
376− liftIO (validateStatus resp 200)
387−withSnapshot srn sn = bracket_ alloc free
390− resp <- createSnapshot srn sn createSettings
391− liftIO (validateStatus resp 200)
392− -- We'll make this synchronous for testing purposes
393− createSettings = defaultSnapshotCreateSettings { snapWaitForCompletion = True
394− , snapIndices = Just (IndexList (testIndex :| []))
395− -- We don't actually need to back up any data
398− deleteSnapshot srn sn
403− BulkTest { name :: Text }
406−instance ToJSON BulkTest where
407− toJSON (BulkTest name) =
408− object ["name" .= name]
410−instance FromJSON BulkTest where
411− parseJSON = withObject "BulkTest" parse
415− BulkTest <$> parseJSON t
417−noDuplicates :: Eq a => [a] -> Bool
418−noDuplicates xs = nub xs == xs
421−getSource :: EsResult a -> Maybe a
422−getSource = fmap _source . foundResult
424−grabFirst :: Either EsError (SearchResult a) -> Either EsError a
426− case fmap (hitSource . head . hits . searchHits) r of
428− (Right Nothing) -> Left (EsError 500 "Source was missing")
429− (Right (Just x)) -> Right x
431main :: IO ()
40main :: IO ()
432main = hspec $ do
41main = hspec $ do
433 JSON.spec
47 JSON.spec
434− describe "index create/delete API" $ do
48+ Query.spec
435− it "creates and then deletes the requested index" $ withTestEnv $ do
49+ Script.spec
436− -- priming state.
50+ Snapshots.spec
437− _ <- deleteExampleIndex
51+ Sorting.spec
438− resp <- createExampleIndex
52+ SourceFiltering.spec
439− deleteResp <- deleteExampleIndex
53+ Suggest.spec
440− liftIO $ do
54+ Templates.spec
441− validateStatus resp 200
442− validateStatus deleteResp 200
444 describe "error parsing" $ do
56 describe "error parsing" $ do
445 it "can parse EsErrors for < 2.0" $ when' (atmost es16) $ withTestEnv $ do
57 it "can parse EsErrors for < 2.0" $ when' (atmost es16) $ withTestEnv $ do
@@ -452,484 +64,6 @@ main = hspec $ do
452 let errorResp = eitherDecode (responseBody res)
64 let errorResp = eitherDecode (responseBody res)
453 liftIO (errorResp `shouldBe` Right (EsError 404 "no such index"))
65 liftIO (errorResp `shouldBe` Right (EsError 404 "no such index"))
455− describe "document API" $ do
456− it "indexes, updates, gets, and then deletes the generated document" $ withTestEnv $ do
459− docInserted <- getDocument testIndex testMapping (DocId "1")
460− let newTweet = eitherDecode
461− (responseBody docInserted) :: Either String (EsResult Tweet)
462− liftIO $ (fmap getSource newTweet `shouldBe` Right (Just patchedTweet))
464− it "indexes, gets, and then deletes the generated document with a DocId containing a space" $ withTestEnv $ do
465− _ <- insertWithSpaceInId
466− docInserted <- getDocument testIndex testMapping (DocId "Hello World")
467− let newTweet = eitherDecode
468− (responseBody docInserted) :: Either String (EsResult Tweet)
469− liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))
471− it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do
472− doc <- getDocument testIndex testMapping (DocId "bogus")
473− let noTweet = eitherDecode
474− (responseBody doc) :: Either String (EsResult Tweet)
475− liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing
477− it "can use optimistic concurrency control" $ withTestEnv $ do
478− let ev = ExternalDocVersion minBound
479− let cfg = defaultIndexDocumentSettings { idsVersionControl = ExternalGT ev }
481− res <- insertData' cfg
482− liftIO $ isCreated res `shouldBe` True
483− res' <- insertData' cfg
484− liftIO $ isVersionConflict res' `shouldBe` True
486− it "indexes two documents in a parent/child relationship and checks that the child exists" $ withTestEnv $ do
488− _ <- putMapping testIndex (MappingName "child") ChildMapping
489− _ <- putMapping testIndex (MappingName "parent") ParentMapping
490− _ <- indexDocument testIndex (MappingName "parent") defaultIndexDocumentSettings exampleTweet (DocId "1")
491− let parent = (Just . DocumentParent . DocId) "1"
492− ids = IndexDocumentSettings NoVersionControl parent
493− _ <- indexDocument testIndex (MappingName "child") ids otherTweet (DocId "2")
494− _ <- refreshIndex testIndex
495− exists <- documentExists testIndex (MappingName "child") parent (DocId "2")
496− liftIO $ exists `shouldBe` True
498− describe "template API" $ do
499− it "can create a template" $ withTestEnv $ do
500− let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
501− resp <- putTemplate idxTpl (TemplateName "tweet-tpl")
502− liftIO $ validateStatus resp 200
504− it "can detect if a template exists" $ withTestEnv $ do
505− exists <- templateExists (TemplateName "tweet-tpl")
506− liftIO $ exists `shouldBe` True
508− it "can delete a template" $ withTestEnv $ do
509− resp <- deleteTemplate (TemplateName "tweet-tpl")
510− liftIO $ validateStatus resp 200
512− it "can detect if a template doesn't exist" $ withTestEnv $ do
513− exists <- templateExists (TemplateName "tweet-tpl")
514− liftIO $ exists `shouldBe` False
516− describe "bulk API" $ do
517− it "inserts all documents we request" $ withTestEnv $ do
519− let firstTest = BulkTest "blah"
520− let secondTest = BulkTest "bloo"
521− let thirdTest = BulkTest "graffle"
522− let fourthTest = BulkTest "garabadoo"
523− let fifthTest = BulkTest "serenity"
524− let firstDoc = BulkIndex testIndex
525− testMapping (DocId "2") (toJSON firstTest)
526− let secondDoc = BulkCreate testIndex
527− testMapping (DocId "3") (toJSON secondTest)
528− let thirdDoc = BulkCreateEncoding testIndex
529− testMapping (DocId "4") (toEncoding thirdTest)
530− let fourthDoc = BulkIndexAuto testIndex
531− testMapping (toJSON fourthTest)
532− let fifthDoc = BulkIndexEncodingAuto testIndex
533− testMapping (toEncoding fifthTest)
534− let stream = V.fromList [firstDoc, secondDoc, thirdDoc, fourthDoc, fifthDoc]
536− -- liftIO $ pPrint bulkResp
537− _ <- refreshIndex testIndex
538− -- liftIO $ pPrint refreshResp
539− fDoc <- getDocument testIndex testMapping (DocId "2")
540− sDoc <- getDocument testIndex testMapping (DocId "3")
541− tDoc <- getDocument testIndex testMapping (DocId "4")
542− -- note that we cannot query for fourthDoc and fifthDoc since we
543− -- do not know their autogenerated ids.
547− :: Either String (EsResult BulkTest)
551− :: Either String (EsResult BulkTest)
555− :: Either String (EsResult BulkTest)
556− -- liftIO $ pPrint [maybeFirst, maybeSecond, maybeThird]
558− fmap getSource maybeFirst `shouldBe` Right (Just firstTest)
559− fmap getSource maybeSecond `shouldBe` Right (Just secondTest)
560− fmap getSource maybeThird `shouldBe` Right (Just thirdTest)
561− -- Since we can't get the docs by doc id, we check for their existence in
562− -- a match all query.
563− let query = MatchAllQuery Nothing
564− let search = mkSearch (Just query) Nothing
565− resp <- searchByIndex testIndex search
566− parsed <- parseEsResponse resp :: BH IO (Either EsError (SearchResult Value))
569− liftIO $ expectationFailure ("Expected a script-transformed result but got: " <> show e)
572− hitsTotal (searchHits sr) `shouldBe` 6
573− let nameList :: [Text]
575− (hits (searchHits sr))
583− `shouldBe` ["blah","bloo","graffle","garabadoo","serenity"]
586− describe "query API" $ do
587− it "returns document for term query and identity filter" $ withTestEnv $ do
589− let query = TermQuery (Term "user" "bitemyapp") Nothing
590− let filter = Filter $ MatchAllQuery Nothing
591− let search = mkSearch (Just query) (Just filter)
592− myTweet <- searchTweet search
594− myTweet `shouldBe` Right exampleTweet
596− it "handles constant score queries" $ withTestEnv $ do
598− let query = TermsQuery "user" ("bitemyapp" :| [])
599− let cfQuery = ConstantScoreQuery query (Boost 1.0)
600− let filter = Filter $ MatchAllQuery Nothing
601− let search = mkSearch (Just cfQuery) (Just filter)
602− myTweet <- searchTweet search
604− myTweet `shouldBe` Right exampleTweet
606− it "returns document for terms query and identity filter" $ withTestEnv $ do
608− let query = TermsQuery "user" ("bitemyapp" :| [])
609− let filter = Filter $ MatchAllQuery Nothing
610− let search = mkSearch (Just query) (Just filter)
611− myTweet <- searchTweet search
613− myTweet `shouldBe` Right exampleTweet
615− it "returns document for match query" $ withTestEnv $ do
617− let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
618− let search = mkSearch (Just query) Nothing
619− myTweet <- searchTweet search
621− myTweet `shouldBe` Right exampleTweet
623− it "returns document for multi-match query" $ withTestEnv $ do
625− let flds = [FieldName "user", FieldName "message"]
626− let query = QueryMultiMatchQuery $ mkMultiMatchQuery flds (QueryString "bitemyapp")
627− let search = mkSearch (Just query) Nothing
628− myTweet <- searchTweet search
630− myTweet `shouldBe` Right exampleTweet
632− it "returns document for multi-match query with a custom tiebreaker" $ withTestEnv $ do
634− let tiebreaker = Just $ Tiebreaker 0.3
635− flds = [FieldName "user", FieldName "message"]
636− multiQuery' = mkMultiMatchQuery flds (QueryString "bitemyapp")
637− query = QueryMultiMatchQuery $ multiQuery' { multiMatchQueryTiebreaker = tiebreaker }
638− search = mkSearch (Just query) Nothing
639− myTweet <- searchTweet search
641− myTweet `shouldBe` Right exampleTweet
643− it "returns document for bool query" $ withTestEnv $ do
645− let innerQuery = QueryMatchQuery $
646− mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
647− let query = QueryBoolQuery $
648− mkBoolQuery [innerQuery] [] [] []
649− let search = mkSearch (Just query) Nothing
650− myTweet <- searchTweet search
652− myTweet `shouldBe` Right exampleTweet
654− it "returns document for boosting query" $ withTestEnv $ do
656− let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
657− let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
658− let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
659− let search = mkSearch (Just query) Nothing
660− myTweet <- searchTweet search
662− myTweet `shouldBe` Right exampleTweet
664− it "returns document for common terms query" $ withTestEnv $ do
666− let query = QueryCommonTermsQuery $
667− CommonTermsQuery (FieldName "user")
668− (QueryString "bitemyapp")
669− (CutoffFrequency 0.0001)
670− Or Or Nothing Nothing Nothing Nothing
671− let search = mkSearch (Just query) Nothing
672− myTweet <- searchTweet search
674− myTweet `shouldBe` Right exampleTweet
676− it "returns document for for inline template query" $ withTestEnv $ do
678− let innerQuery = QueryMatchQuery $
679− mkMatchQuery (FieldName "{{userKey}}")
680− (QueryString "{{bitemyappKey}}")
681− templateParams = TemplateQueryKeyValuePairs $ HM.fromList
682− [ ("userKey", "user")
683− , ("bitemyappKey", "bitemyapp")
685− templateQuery = QueryTemplateQueryInline $
686− TemplateQueryInline innerQuery templateParams
687− search = mkSearch (Just templateQuery) Nothing
688− myTweet <- searchTweet search
689− liftIO $ myTweet `shouldBe` Right exampleTweet
692− describe "sorting" $ do
693− it "returns documents in the right order" $ withTestEnv $ do
696− let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
697− let search = Search Nothing
698− Nothing (Just [sortSpec]) Nothing Nothing
699− False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
701− result <- searchTweets search
702− let myTweet = grabFirst result
704− myTweet `shouldBe` Right otherTweet
706− describe "Aggregation API" $ do
707− it "returns term aggregation results" $ withTestEnv $ do
709− let terms = TermsAgg $ mkTermsAggregation "user"
710− let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
711− searchExpectAggs search
712− searchValidBucketAgg search "users" toTerms
714− it "return sub-aggregation results" $ withTestEnv $ do
716− let subaggs = mkAggregations "age_agg" . TermsAgg $ mkTermsAggregation "age"
717− agg = TermsAgg $ (mkTermsAggregation "user") { termAggs = Just subaggs}
718− search = mkAggregateSearch Nothing $ mkAggregations "users" agg
719− reply <- searchByIndex testIndex search
720− let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
721− usersAggResults = result >>= aggregations >>= toTerms "users"
722− subAggResults = usersAggResults >>= (listToMaybe . buckets) >>= termsAggs >>= toTerms "age_agg"
723− subAddResultsExists = isJust subAggResults
724− liftIO $ (subAddResultsExists) `shouldBe` True
726− it "returns cardinality aggregation results" $ withTestEnv $ do
728− let cardinality = CardinalityAgg $ mkCardinalityAggregation $ FieldName "user"
729− let search = mkAggregateSearch Nothing $ mkAggregations "users" cardinality
730− let search' = search { Database.V5.Bloodhound.from = From 0, size = Size 0 }
731− searchExpectAggs search'
732− let docCountPair k n = (k, object ["value" .= Number n])
733− res <- searchTweets search'
735− fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "users" 1]))
737− it "returns stats aggregation results" $ withTestEnv $ do
739− let stats = StatsAgg $ mkStatsAggregation $ FieldName "age"
740− let search = mkAggregateSearch Nothing $ mkAggregations "users" stats
741− let search' = search { Database.V5.Bloodhound.from = From 0, size = Size 0 }
742− searchExpectAggs search'
743− let statsAggRes k n = (k, object [ "max" .= Number n
745− , "count" .= Number 1
747− , "sum" .= Number n])
748− res <- searchTweets search'
750− fmap aggregations res `shouldBe` Right (Just (M.fromList [ statsAggRes "users" 10000]))
752− it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
754− let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
755− let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
756− searchExpectAggs search
757− searchValidBucketAgg search "users" toTerms
759− -- One of these fails with 1.7.3
760− it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
762− searchTermsAggHint [Map, Ordinals]
764− it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do
766− searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
768− it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
770− searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
771− -- One of the above.
773− it "can execute value_count aggregations" $ withTestEnv $ do
776− let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>
777− mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))
778− let search = mkAggregateSearch Nothing ags
779− let docCountPair k n = (k, object ["value" .= Number n])
780− res <- searchTweets search
782− fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2
783− , docCountPair "bogus_count" 0
786− it "can execute date_range aggregations" $ withTestEnv $ do
787− let now = fromGregorian 2015 3 14
788− let ltAMonthAgo = UTCTime (fromGregorian 2015 3 1) 0
789− let ltAWeekAgo = UTCTime (fromGregorian 2015 3 10) 0
790− let oldDoc = exampleTweet { postDate = ltAMonthAgo }
791− let newDoc = exampleTweet { postDate = ltAWeekAgo }
792− _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings oldDoc (DocId "1")
793− _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings newDoc (DocId "2")
794− _ <- refreshIndex testIndex
795− let thisMonth = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMMonth])
796− let thisWeek = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMWeek])
797− let agg = DateRangeAggregation (FieldName "postDate") Nothing (thisMonth :| [thisWeek])
798− let ags = mkAggregations "date_ranges" (DateRangeAgg agg)
799− let search = mkAggregateSearch Nothing ags
800− res <- searchTweets search
801− liftIO $ hitsTotal . searchHits <$> res `shouldBe` Right 2
802− let bucks = do magrs <- fmapL show (aggregations <$> res)
803− agrs <- note "no aggregations returned" magrs
804− rawBucks <- note "no date_ranges aggregation" $ M.lookup "date_ranges" agrs
805− parseEither parseJSON rawBucks
806− let fromMonthT = UTCTime (fromGregorian 2015 2 14) 0
807− let fromWeekT = UTCTime (fromGregorian 2015 3 7) 0
808− liftIO $ buckets <$> bucks `shouldBe` Right [ DateRangeResult "2015-02-14T00:00:00.000Z-*"
810− (Just "2015-02-14T00:00:00.000Z")
815− , DateRangeResult "2015-03-07T00:00:00.000Z-*"
817− (Just "2015-03-07T00:00:00.000Z")
824− it "returns date histogram aggregation results" $ withTestEnv $ do
826− let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
827− let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
828− searchExpectAggs search
829− searchValidBucketAgg search "byDate" toDateHistogram
831− it "can execute missing aggregations" $ withTestEnv $ do
834− let ags = mkAggregations "missing_agg" (MissingAgg (MissingAggregation "extra"))
835− let search = mkAggregateSearch Nothing ags
836− let docCountPair k n = (k, object ["doc_count" .= Number n])
837− res <- searchTweets search
839− fmap aggregations res `shouldBe` Right (Just (M.fromList [docCountPair "missing_agg" 1]))
841− describe "Highlights API" $ do
843− it "returns highlight from query when there should be one" $ withTestEnv $ do
846− let query = QueryMatchQuery $ mkMatchQuery (FieldName "message") (QueryString "haskell")
847− let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
849− let search = mkHighlightSearch (Just query) testHighlight
850− myHighlight <- searchTweetHighlight search
852− myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
854− it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
857− let query = QueryMatchQuery $ mkMatchQuery (FieldName "message") (QueryString "haskell")
858− let testHighlight = Highlights Nothing [FieldHighlight (FieldName "user") Nothing]
860− let search = mkHighlightSearch (Just query) testHighlight
861− myHighlight <- searchTweetHighlight search
863− myHighlight `shouldBe` Right Nothing
865− describe "Source filtering" $ do
867− it "doesn't include source when sources are disabled" $ withTestEnv $ do
870− (Left (EsError 500 "Source was missing"))
872− it "includes a source" $ withTestEnv $ do
874− (SourcePatterns (PopPattern (Pattern "message")))
875− (Right (Object (HM.fromList [("message", String "Use haskell!")])))
877− it "includes sources" $ withTestEnv $ do
879− (SourcePatterns (PopPatterns [Pattern "user", Pattern "message"]))
880− (Right (Object (HM.fromList [("user",String "bitemyapp"),("message", String "Use haskell!")])))
882− it "includes source patterns" $ withTestEnv $ do
884− (SourcePatterns (PopPattern (Pattern "*ge")))
885− (Right (Object (HM.fromList [("age", Number 10000),("message", String "Use haskell!")])))
887− it "excludes source patterns" $ withTestEnv $ do
889− (SourceIncludeExclude (Include [])
890− (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate", Pattern "extra"]))
891− (Right (Object (HM.fromList [("user",String "bitemyapp")])))
893− describe "ToJSON RegexpFlags" $ do
894− it "generates the correct JSON for AllRegexpFlags" $
895− toJSON AllRegexpFlags `shouldBe` String "ALL"
897− it "generates the correct JSON for NoRegexpFlags" $
898− toJSON NoRegexpFlags `shouldBe` String "NONE"
900− it "generates the correct JSON for SomeRegexpFlags" $
901− let flags = AnyString :| [ Automaton
906− in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
908− prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
909− let String str = toJSON flags
910− flagStrs = T.splitOn "|" str
911− in noDuplicates flagStrs
913− describe "omitNulls" $ do
914− it "checks that omitNulls drops list elements when it should" $
915− let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))
916− , "test2" .= (toJSON ("some value" :: Text))]
917− in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
919− it "checks that omitNulls doesn't drop list elements when it shouldn't" $
920− let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))
921− , "test2" .= (toJSON ("some value" :: Text))]
922− in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))
923− , ("test2", String "some value")])
924− it "checks that omitNulls drops non list elements when it should" $
925− let dropped = omitNulls $ [ "test1" .= (toJSON Null)
926− , "test2" .= (toJSON ("some value" :: Text))]
927− in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
928− it "checks that omitNulls doesn't drop non list elements when it shouldn't" $
929− let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
930− , "test2" .= (toJSON ("some value" :: Text))]
931− in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
932− , ("test2", String "some value")])
933 describe "Monoid (SearchHits a)" $ do
67 describe "Monoid (SearchHits a)" $ do
934 prop "abides the monoid laws" $ eq $
68 prop "abides the monoid laws" $ eq $
935 prop_Monoid (T :: T (SearchHits ()))
69 prop_Monoid (T :: T (SearchHits ()))
@@ -943,112 +77,6 @@ main = hspec $ do
943 (dv <= maxBound) .&&.
77 (dv <= maxBound) .&&.
944 docVersionNumber dv === i
78 docVersionNumber dv === i
946− describe "FsSnapshotRepo" $ do
947− prop "SnapshotRepo laws" $ \fsr ->
948− fromGSnapshotRepo (toGSnapshotRepo fsr) === Right (fsr :: FsSnapshotRepo)
950− describe "snapshot repos" $ do
951− it "always parses all snapshot repos API" $ when' canSnapshot $ withTestEnv $ do
952− res <- getSnapshotRepos AllSnapshotRepos
953− liftIO $ case res of
954− Left e -> expectationFailure ("Expected a right but got Left " <> show e)
955− Right _ -> return ()
957− it "finds an existing list of repos" $ when' canSnapshot $ withTestEnv $ do
958− let r1n = SnapshotRepoName "bloodhound-repo1"
959− let r2n = SnapshotRepoName "bloodhound-repo2"
960− withSnapshotRepo r1n $ \r1 ->
961− withSnapshotRepo r2n $ \r2 -> do
962− repos <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| [ExactRepo r2n]))
963− liftIO $ case repos of
965− let srt = L.sortBy (comparing gSnapshotRepoName)
966− srt xs `shouldBe` srt [r1, r2]
967− Left e -> expectationFailure (show e)
969− it "creates and updates with updateSnapshotRepo" $ when' canSnapshot $ withTestEnv $ do
970− let r1n = SnapshotRepoName "bloodhound-repo1"
971− withSnapshotRepo r1n $ \r1 -> do
972− let Just (String dir) = HM.lookup "location" (gSnapshotRepoSettingsObject (gSnapshotRepoSettings r1))
973− let noCompression = FsSnapshotRepo r1n (T.unpack dir) False Nothing Nothing Nothing
974− resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings noCompression
975− liftIO (validateStatus resp 200)
976− Right [roundtrippedNoCompression] <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| []))
977− liftIO (roundtrippedNoCompression `shouldBe` toGSnapshotRepo noCompression)
979− -- verify came around in 1.4 it seems
980− it "can verify existing repos" $ when' canSnapshot $ when' (atleast es14) $ withTestEnv $ do
981− let r1n = SnapshotRepoName "bloodhound-repo1"
982− withSnapshotRepo r1n $ \_ -> do
983− res <- verifySnapshotRepo r1n
984− liftIO $ case res of
985− Right (SnapshotVerification vs)
986− | null vs -> expectationFailure "Expected nonempty set of verifying nodes"
987− | otherwise -> return ()
988− Left e -> expectationFailure (show e)
990− describe "snapshots" $ do
991− it "always parses all snapshots API" $ when' canSnapshot $ withTestEnv $ do
992− let r1n = SnapshotRepoName "bloodhound-repo1"
993− withSnapshotRepo r1n $ \_ -> do
994− res <- getSnapshots r1n AllSnapshots
995− liftIO $ case res of
996− Left e -> expectationFailure ("Expected a right but got Left " <> show e)
997− Right _ -> return ()
999− it "can parse a snapshot that it created" $ when' canSnapshot $ withTestEnv $ do
1000− let r1n = SnapshotRepoName "bloodhound-repo1"
1001− withSnapshotRepo r1n $ \_ -> do
1002− let s1n = SnapshotName "example-snapshot"
1003− withSnapshot r1n s1n $ do
1004− res <- getSnapshots r1n (SnapshotList (ExactSnap s1n :| []))
1005− liftIO $ case res of
1007− | snapInfoState snap == SnapshotSuccess &&
1008− snapInfoName snap == s1n -> return ()
1009− | otherwise -> expectationFailure (show snap)
1010− Right [] -> expectationFailure "There were no snapshots"
1011− Right snaps -> expectationFailure ("Expected 1 snapshot but got" <> show (length snaps))
1012− Left e -> expectationFailure (show e)
1014− describe "snapshot restore" $ do
1015− it "can restore a snapshot that we create" $ when' canSnapshot $ withTestEnv $ do
1016− let r1n = SnapshotRepoName "bloodhound-repo1"
1017− withSnapshotRepo r1n $ \_ -> do
1018− let s1n = SnapshotName "example-snapshot"
1019− withSnapshot r1n s1n $ do
1020− let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True }
1021− -- have to close an index to restore it
1022− resp1 <- closeIndex testIndex
1023− liftIO (validateStatus resp1 200)
1024− resp2 <- restoreSnapshot r1n s1n settings
1025− liftIO (validateStatus resp2 200)
1027− it "can restore and rename" $ when' canSnapshot $ withTestEnv $ do
1028− let r1n = SnapshotRepoName "bloodhound-repo1"
1029− withSnapshotRepo r1n $ \_ -> do
1030− let s1n = SnapshotName "example-snapshot"
1031− withSnapshot r1n s1n $ do
1032− let pat = RestoreRenamePattern "bloodhound-tests-twitter-(\\d+)"
1033− let replace = RRTLit "restored-" :| [RRSubWholeMatch]
1034− let expectedIndex = IndexName "restored-bloodhound-tests-twitter-1"
1035− oldEnoughForOverrides <- liftIO (atleast es15)
1036− let overrides = RestoreIndexSettings { restoreOverrideReplicas = Just (ReplicaCount 0) }
1037− let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True
1038− , snapRestoreRenamePattern = Just pat
1039− , snapRestoreRenameReplacement = Just replace
1040− , snapRestoreIndexSettingsOverrides = if oldEnoughForOverrides
1041− then Just overrides
1044− -- have to close an index to restore it
1046− resp <- restoreSnapshot r1n s1n settings
1047− liftIO (validateStatus resp 200)
1048− exists <- indexExists expectedIndex
1049− liftIO (exists `shouldBe` True)
1050− go `finally` deleteIndex expectedIndex
1052 describe "getNodesInfo" $ do
80 describe "getNodesInfo" $ do
1053 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
81 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
1054 res <- getNodesInfo LocalNode
82 res <- getNodesInfo LocalNode
@@ -1079,7 +107,7 @@ main = hspec $ do
1079 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
107 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1080 enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]
108 enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]
1082− describe "scan&scroll API" $ do
110+ describe "Scan & Scroll API" $ do
1083 it "returns documents using the scan&scroll API" $ withTestEnv $ do
111 it "returns documents using the scan&scroll API" $ withTestEnv $ do
1084 _ <- insertData
112 _ <- insertData
1085 _ <- insertOther
113 _ <- insertOther
@@ -1091,173 +119,3 @@ main = hspec $ do
1091 regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored
119 regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored
1092 liftIO $
120 liftIO $
1093 scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]
121 scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]
1095− describe "index aliases" $ do
1096− let aname = IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias")
1097− let alias = IndexAlias (testIndex) aname
1098− let create = IndexAliasCreate Nothing Nothing
1099− let action = AddAlias alias create
1100− it "handles the simple case of aliasing an existing index" $ do
1103− resp <- updateIndexAliases (action :| [])
1104− liftIO $ validateStatus resp 200
1105− let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1106− (do aliases <- withTestEnv getIndexAliases
1107− let expected = IndexAliasSummary alias create
1109− Right (IndexAliasesSummary summs) ->
1110− L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1111− Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1112− it "allows alias deletion" $ do
1113− aliases <- withTestEnv $ do
1115− resp <- updateIndexAliases (action :| [])
1116− liftIO $ validateStatus resp 200
1117− _ <- deleteIndexAlias aname
1119− -- let expected = IndexAliasSummary alias create
1121− Right (IndexAliasesSummary summs) ->
1122− L.find ( (== aname)
1124− . indexAliasSummaryAlias
1127− Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)
1129− describe "Index Listing" $ do
1130− it "returns a list of index names" $ withTestEnv $ do
1131− _ <- createExampleIndex
1132− ixns <- listIndices
1133− liftIO (ixns `shouldContain` [testIndex])
1135− describe "Index Settings" $ do
1136− it "persists settings" $ withTestEnv $ do
1137− _ <- deleteExampleIndex
1138− _ <- createExampleIndex
1139− let updates = BlocksWrite False :| []
1140− updateResp <- updateIndexSettings updates testIndex
1141− liftIO $ validateStatus updateResp 200
1142− getResp <- getIndexSettings testIndex
1144− getResp `shouldBe` Right (IndexSettingsSummary
1146− (IndexSettings (ShardCount 1) (ReplicaCount 0))
1147− (NE.toList updates))
1149− it "allows total fields to be set" $ when' (atleast es50) $ withTestEnv $ do
1150− _ <- deleteExampleIndex
1151− _ <- createExampleIndex
1152− let updates = MappingTotalFieldsLimit 2500 :| []
1153− updateResp <- updateIndexSettings updates testIndex
1154− liftIO $ validateStatus updateResp 200
1155− getResp <- getIndexSettings testIndex
1157− getResp `shouldBe` Right (IndexSettingsSummary
1159− (IndexSettings (ShardCount 1) (ReplicaCount 0))
1160− (NE.toList updates))
1162− it "accepts customer analyzers" $ when' (atleast es50) $ withTestEnv $ do
1163− _ <- deleteExampleIndex
1164− let analysis = Analysis
1165− (M.singleton "ex_analyzer"
1166− ( AnalyzerDefinition
1167− (Just (Tokenizer "ex_tokenizer"))
1169− [ "ex_filter_lowercase","ex_filter_uppercase","ex_filter_apostrophe"
1170− , "ex_filter_reverse","ex_filter_snowball"
1171− , "ex_filter_shingle"
1176− (M.singleton "ex_tokenizer"
1177− ( TokenizerDefinitionNgram
1178− ( Ngram 3 4 [TokenLetter,TokenDigit])
1182− [ ("ex_filter_lowercase",TokenFilterDefinitionLowercase (Just Greek))
1183− , ("ex_filter_uppercase",TokenFilterDefinitionUppercase Nothing)
1184− , ("ex_filter_apostrophe",TokenFilterDefinitionApostrophe)
1185− , ("ex_filter_reverse",TokenFilterDefinitionReverse)
1186− , ("ex_filter_snowball",TokenFilterDefinitionSnowball English)
1187− , ("ex_filter_shingle",TokenFilterDefinitionShingle (Shingle 3 3 True False " " "_"))
1190− updates = [AnalysisSetting analysis]
1191− createResp <- createIndexWith (updates ++ [NumberOfReplicas (ReplicaCount 0)]) 1 testIndex
1192− liftIO $ validateStatus createResp 200
1193− getResp <- getIndexSettings testIndex
1195− getResp `shouldBe` Right (IndexSettingsSummary
1197− (IndexSettings (ShardCount 1) (ReplicaCount 0))
1201− it "accepts default compression codec" $ when' (atleast es50) $ withTestEnv $ do
1202− _ <- deleteExampleIndex
1203− let updates = [CompressionSetting CompressionDefault]
1204− createResp <- createIndexWith (updates ++ [NumberOfReplicas (ReplicaCount 0)]) 1 testIndex
1205− liftIO $ validateStatus createResp 200
1206− getResp <- getIndexSettings testIndex
1207− liftIO $ getResp `shouldBe` Right
1208− (IndexSettingsSummary testIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) updates)
1210− it "accepts best compression codec" $ when' (atleast es50) $ withTestEnv $ do
1211− _ <- deleteExampleIndex
1212− let updates = [CompressionSetting CompressionBest]
1213− createResp <- createIndexWith (updates ++ [NumberOfReplicas (ReplicaCount 0)]) 1 testIndex
1214− liftIO $ validateStatus createResp 200
1215− getResp <- getIndexSettings testIndex
1216− liftIO $ getResp `shouldBe` Right
1217− (IndexSettingsSummary testIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) updates)
1220− describe "Index Optimization" $ do
1221− it "returns a successful response upon completion" $ withTestEnv $ do
1222− _ <- createExampleIndex
1223− resp <- forceMergeIndex (IndexList (testIndex :| [])) defaultForceMergeIndexSettings
1224− liftIO $ validateStatus resp 200
1226− describe "Suggest" $ do
1227− it "returns a search suggestion using the phrase suggester" $ withTestEnv $ do
1229− let query = QueryMatchNoneQuery
1230− phraseSuggester = mkPhraseSuggester (FieldName "message")
1231− namedSuggester = Suggest "Use haskel" "suggest_name" (SuggestTypePhraseSuggester phraseSuggester)
1232− search' = mkSearch (Just query) Nothing
1233− search = search' { suggestBody = Just namedSuggester }
1234− expectedText = Just "use haskell"
1235− resp <- searchByIndex testIndex search
1236− parsed <- parseEsResponse resp :: BH IO (Either EsError (SearchResult Tweet))
1238− Left e -> liftIO $ expectationFailure ("Expected an search suggestion but got " <> show e)
1239− Right sr -> liftIO $ (suggestOptionsText . head . suggestResponseOptions . head . nsrResponses <$> suggest sr) `shouldBe` expectedText
1241− describe "Script" $ do
1242− it "returns a transformed document based on the script field" $ withTestEnv $ do
1244− let query = MatchAllQuery Nothing
1247− (Just (ScriptLanguage "painless"))
1248− (Just (ScriptInline "doc['age'].value * 2"))
1251− sf = ScriptFields $
1252− HM.fromList [("test1", sfv)]
1253− search' = mkSearch (Just query) Nothing
1254− search = search' { scriptFields = Just sf }
1255− resp <- searchByIndex testIndex search
1256− parsed <- parseEsResponse resp :: BH IO (Either EsError (SearchResult Value))
1259− liftIO $ expectationFailure ("Expected a script-transformed result but got: " <> show e)
1262− hitFields (head (hits (searchHits sr)))
1263− liftIO $ results `shouldBe` (HitFields (M.fromList [("test1", [Number 20000.0])]))