git.iko.soy/typeable/bloodhound
on index-aliases help sign in
typeable/bloodhound/tests/tests.hs
1201 lines 52 kB history raw
1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE TemplateHaskell #-}
6{-# OPTIONS_GHC -fno-warn-orphans #-}
7module Main where
9import Control.Applicative
10import Control.Exception
11import Control.Monad
12import Control.Monad.Reader
13import Data.Aeson
14import Data.Aeson.Types (parseEither)
15import Data.DeriveTH
16import qualified Data.HashMap.Strict as HM
17import Data.List (nub)
18import qualified Data.List as L
19import Data.List.NonEmpty (NonEmpty (..))
20import qualified Data.List.NonEmpty as NE
21import qualified Data.Map.Strict as M
22import Data.Monoid
23import Data.Proxy
24import Data.Text (Text)
25import qualified Data.Text as T
26import Data.Time.Calendar (Day (..))
27import Data.Time.Clock (UTCTime (..),
28 secondsToDiffTime)
29import Data.Typeable
30import qualified Data.Vector as V
31import Database.Bloodhound
32import GHC.Generics (Generic)
33import Network.HTTP.Client hiding (Proxy)
34import qualified Network.HTTP.Types.Status as NHTS
35import Prelude hiding (filter)
36import Test.Hspec
37import Test.QuickCheck.Property.Monoid (T (..), eq, prop_Monoid)
39import Test.Hspec.QuickCheck (prop)
40import Test.QuickCheck
41import Test.QuickCheck.Instances ()
43testServer :: Server
44testServer = Server "http://localhost:9200"
45testIndex :: IndexName
46testIndex = IndexName "bloodhound-tests-twitter-1"
47testMapping :: MappingName
48testMapping = MappingName "tweet"
50withTestEnv :: BH IO a -> IO a
51withTestEnv = withBH defaultManagerSettings testServer
53validateStatus :: Response body -> Int -> Expectation
54validateStatus resp expected =
55 (NHTS.statusCode $ responseStatus resp)
56 `shouldBe` (expected :: Int)
58createExampleIndex :: BH IO Reply
59createExampleIndex = createIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) testIndex
60deleteExampleIndex :: BH IO Reply
61deleteExampleIndex = deleteIndex testIndex
63data ServerVersion = ServerVersion Int Int Int deriving (Show, Eq, Ord)
65es14 :: ServerVersion
66es14 = ServerVersion 1 4 0
68es13 :: ServerVersion
69es13 = ServerVersion 1 3 0
71es12 :: ServerVersion
72es12 = ServerVersion 1 2 0
74es11 :: ServerVersion
75es11 = ServerVersion 1 1 0
77es10 :: ServerVersion
78es10 = ServerVersion 1 0 0
80serverBranch :: ServerVersion -> ServerVersion
81serverBranch (ServerVersion majorVer minorVer patchVer) =
82 ServerVersion majorVer minorVer patchVer
84mkServerVersion :: [Int] -> Maybe ServerVersion
85mkServerVersion [majorVer, minorVer, patchVer] =
86 Just (ServerVersion majorVer minorVer patchVer)
87mkServerVersion _ = Nothing
89getServerVersion :: IO (Maybe ServerVersion)
90getServerVersion = liftM extractVersion (withTestEnv getStatus)
91 where
92 version' = T.splitOn "." . number . version
93 toInt = read . T.unpack
94 parseVersion v = map toInt (version' v)
95 extractVersion = join . liftM (mkServerVersion . parseVersion)
97testServerBranch :: IO (Maybe ServerVersion)
98testServerBranch = getServerVersion >>= \v -> return $ liftM serverBranch v
100atleast :: ServerVersion -> IO Bool
101atleast v = testServerBranch >>= \x -> return $ x >= Just (serverBranch v)
103atmost :: ServerVersion -> IO Bool
104atmost v = testServerBranch >>= \x -> return $ x <= Just (serverBranch v)
106is :: ServerVersion -> IO Bool
107is v = testServerBranch >>= \x -> return $ x == Just (serverBranch v)
109when' :: Monad m => m Bool -> m () -> m ()
110when' b f = b >>= \x -> when x f
112propJSON :: forall a. (Arbitrary a, ToJSON a, FromJSON a, Show a, Eq a, Typeable a) => Proxy a -> Spec
113propJSON _ = prop testName $ \(a :: a) ->
114 parseEither parseJSON (toJSON a) === Right a
115 where testName = show ty <> " FromJSON/ToJSON roundtrips"
116 ty = typeOf (undefined :: a)
118data Location = Location { lat :: Double
119 , lon :: Double } deriving (Eq, Generic, Show)
121data Tweet = Tweet { user :: Text
122 , postDate :: UTCTime
123 , message :: Text
124 , age :: Int
125 , location :: Location }
126 deriving (Eq, Generic, Show)
128instance ToJSON Tweet where
129 toJSON = genericToJSON defaultOptions
130instance FromJSON Tweet where
131 parseJSON = genericParseJSON defaultOptions
132instance ToJSON Location where
133 toJSON = genericToJSON defaultOptions
134instance FromJSON Location where
135 parseJSON = genericParseJSON defaultOptions
137data ParentMapping = ParentMapping deriving (Eq, Show)
139instance ToJSON ParentMapping where
140 toJSON ParentMapping =
141 object ["parent" .= Null ]
143data ChildMapping = ChildMapping deriving (Eq, Show)
145instance ToJSON ChildMapping where
146 toJSON ChildMapping =
147 object ["child" .=
148 object ["_parent" .= object ["type" .= ("parent" :: Text)]]
149 ]
151data TweetMapping = TweetMapping deriving (Eq, Show)
153instance ToJSON TweetMapping where
154 toJSON TweetMapping =
155 object ["tweet" .=
156 object ["properties" .=
157 object [ "user" .= object ["type" .= ("string" :: Text)]
158 -- Serializing the date as a date is breaking other tests, mysteriously.
159 -- , "postDate" .= object [ "type" .= ("date" :: Text)
160 -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
161 , "message" .= object ["type" .= ("string" :: Text)]
162 , "age" .= object ["type" .= ("integer" :: Text)]
163 , "location" .= object ["type" .= ("geo_point" :: Text)]
164 ]]]
166exampleTweet :: Tweet
167exampleTweet = Tweet { user = "bitemyapp"
168 , postDate = UTCTime
169 (ModifiedJulianDay 55000)
170 (secondsToDiffTime 10)
171 , message = "Use haskell!"
172 , age = 10000
173 , location = Location 40.12 (-71.34) }
175otherTweet :: Tweet
176otherTweet = Tweet { user = "notmyapp"
177 , postDate = UTCTime
178 (ModifiedJulianDay 55000)
179 (secondsToDiffTime 11)
180 , message = "Use haskell!"
181 , age = 1000
182 , location = Location 40.12 (-71.34) }
184resetIndex :: BH IO ()
185resetIndex = do
186 _ <- deleteExampleIndex
187 _ <- createExampleIndex
188 _ <- putMapping testIndex testMapping TweetMapping
189 return ()
191insertData :: BH IO Reply
192insertData = do
193 resetIndex
194 insertData' defaultIndexDocumentSettings
196insertData' :: IndexDocumentSettings -> BH IO Reply
197insertData' ids = do
198 r <- indexDocument testIndex testMapping ids exampleTweet (DocId "1")
199 _ <- refreshIndex testIndex
200 return r
202insertOther :: BH IO ()
203insertOther = do
204 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings otherTweet (DocId "2")
205 _ <- refreshIndex testIndex
206 return ()
208insertWithSpaceInId :: BH IO ()
209insertWithSpaceInId = do
210 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "Hello World")
211 _ <- refreshIndex testIndex
212 return ()
214searchTweet :: Search -> BH IO (Either EsError Tweet)
215searchTweet search = do
216 result <- searchTweets search
217 let myTweet :: Either EsError Tweet
218 myTweet = grabFirst result
219 return myTweet
221searchTweets :: Search -> BH IO (Either EsError (SearchResult Tweet))
222searchTweets search = parseEsResponse =<< searchByIndex testIndex search
224searchExpectNoResults :: Search -> BH IO ()
225searchExpectNoResults search = do
226 result <- searchTweets search
227 let emptyHits = fmap (hits . searchHits) result
228 liftIO $
229 emptyHits `shouldBe` Right []
231searchExpectAggs :: Search -> BH IO ()
232searchExpectAggs search = do
233 reply <- searchAll search
234 let isEmpty x = return (M.null x)
235 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
236 liftIO $
237 (result >>= aggregations >>= isEmpty) `shouldBe` Just False
239searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) =>
240 Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> BH IO ()
241searchValidBucketAgg search aggKey extractor = do
242 reply <- searchAll search
243 let bucketDocs = docCount . head . buckets
244 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
245 let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)
246 liftIO $
247 count `shouldBe` Just 1
249searchTermsAggHint :: [ExecutionHint] -> BH IO ()
250searchTermsAggHint hints = do
251 let terms hint = TermsAgg $ (mkTermsAggregation "user") { termExecutionHint = Just hint }
252 let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint
253 forM_ hints $ searchExpectAggs . search
254 forM_ hints (\x -> searchValidBucketAgg (search x) "users" toTerms)
256searchTweetHighlight :: Search -> BH IO (Either EsError (Maybe HitHighlight))
257searchTweetHighlight search = do
258 result <- searchTweets search
259 let myHighlight = fmap (hitHighlight . head . hits . searchHits) result
260 return myHighlight
262searchExpectSource :: Source -> Either EsError Value -> BH IO ()
263searchExpectSource src expected = do
264 _ <- insertData
265 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
266 let search = (mkSearch (Just query) Nothing) { source = Just src }
267 reply <- searchAll search
268 result <- parseEsResponse reply-- :: Either EsError (SearchResult Value)
269 let value = grabFirst result
270 liftIO $
271 value `shouldBe` expected
273data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
274instance FromJSON BulkTest where
275 parseJSON = genericParseJSON defaultOptions
276instance ToJSON BulkTest where
277 toJSON = genericToJSON defaultOptions
279noDuplicates :: Eq a => [a] -> Bool
280noDuplicates xs = nub xs == xs
282instance Arbitrary a => Arbitrary (NonEmpty a) where
283 arbitrary = liftA2 (:|) arbitrary arbitrary
285arbitraryScore :: Gen Score
286arbitraryScore = fmap getPositive <$> arbitrary
288instance Arbitrary a => Arbitrary (Hit a) where
289 arbitrary = Hit <$> arbitrary
290 <*> arbitrary
291 <*> arbitrary
292 <*> arbitraryScore
293 <*> arbitrary
294 <*> arbitrary
297instance Arbitrary a => Arbitrary (SearchHits a) where
298 arbitrary = reduceSize $ do
299 tot <- getPositive <$> arbitrary
300 score <- arbitraryScore
301 hs <- arbitrary
302 return $ SearchHits tot score hs
304reduceSize :: Gen a -> Gen a
305reduceSize f = sized $ \n -> resize (n `div` 2) f
307getSource :: EsResult a -> Maybe a
308getSource = fmap _source . foundResult
310grabFirst :: Either EsError (SearchResult a) -> Either EsError a
311grabFirst r =
312 case fmap (hitSource . head . hits . searchHits) r of
313 (Left e) -> Left e
314 (Right Nothing) -> Left (EsError 500 "Source was missing")
315 (Right (Just x)) -> Right x
317-------------------------------------------------------------------------------
318arbitraryAlphaNum :: Gen Char
319arbitraryAlphaNum = oneof [choose ('a', 'z')
320 ,choose ('A','Z')
321 , choose ('0', '9')]
323instance Arbitrary RoutingValue where
324 arbitrary = RoutingValue . T.pack <$> listOf1 arbitraryAlphaNum
326instance Arbitrary AliasRouting where
327 arbitrary = oneof [allAlias
328 ,one
329 ,theOther
330 ,both]
331 where one = GranularAliasRouting
332 <$> (Just <$> arbitrary)
333 <*> pure Nothing
334 theOther = GranularAliasRouting Nothing
335 <$> (Just <$> arbitrary)
336 both = GranularAliasRouting
337 <$> (Just <$> arbitrary)
338 <*> (Just <$> arbitrary)
339 allAlias = AllAliasRouting <$> arbitrary
341instance Arbitrary FieldName where
342 arbitrary = FieldName . T.pack <$> listOf1 arbitraryAlphaNum
344instance Arbitrary RegexpFlags where
345 arbitrary = oneof [ pure AllRegexpFlags
346 , pure NoRegexpFlags
347 , SomeRegexpFlags <$> genUniqueFlags
348 ]
349 where genUniqueFlags = NE.fromList . nub <$> listOf1 arbitrary
351instance Arbitrary IndexAliasCreate where
352 arbitrary = IndexAliasCreate <$> arbitrary <*> reduceSize arbitrary
354instance Arbitrary Query where
355 arbitrary = reduceSize $ oneof [ TermQuery <$> arbitrary <*> arbitrary
356 , TermsQuery <$> arbitrary <*> arbitrary
357 , QueryMatchQuery <$> arbitrary
358 , QueryMultiMatchQuery <$> arbitrary
359 , QueryBoolQuery <$> arbitrary
360 , QueryBoostingQuery <$> arbitrary
361 , QueryCommonTermsQuery <$> arbitrary
362 , ConstantScoreFilter <$> arbitrary <*> arbitrary
363 , ConstantScoreQuery <$> arbitrary <*> arbitrary
364 , QueryDisMaxQuery <$> arbitrary
365 , QueryFilteredQuery <$> arbitrary
366 , QueryFuzzyLikeThisQuery <$> arbitrary
367 , QueryFuzzyLikeFieldQuery <$> arbitrary
368 , QueryFuzzyQuery <$> arbitrary
369 , QueryHasChildQuery <$> arbitrary
370 , QueryHasParentQuery <$> arbitrary
371 , IdsQuery <$> arbitrary <*> arbitrary
372 , QueryIndicesQuery <$> arbitrary
373 , MatchAllQuery <$> arbitrary
374 , QueryMoreLikeThisQuery <$> arbitrary
375 , QueryMoreLikeThisFieldQuery <$> arbitrary
376 , QueryNestedQuery <$> arbitrary
377 , QueryPrefixQuery <$> arbitrary
378 , QueryQueryStringQuery <$> arbitrary
379 , QuerySimpleQueryStringQuery <$> arbitrary
380 , QueryRangeQuery <$> arbitrary
381 , QueryRegexpQuery <$> arbitrary
382 ]
384instance Arbitrary Filter where
385 arbitrary = reduceSize $ oneof [ AndFilter <$> arbitrary <*> arbitrary
386 , OrFilter <$> arbitrary <*> arbitrary
387 , NotFilter <$> arbitrary <*> arbitrary
388 , pure IdentityFilter
389 , BoolFilter <$> arbitrary
390 , ExistsFilter <$> arbitrary
391 , GeoBoundingBoxFilter <$> arbitrary
392 , GeoDistanceFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
393 , GeoDistanceRangeFilter <$> arbitrary <*> arbitrary
394 , GeoPolygonFilter <$> arbitrary <*> arbitrary
395 , IdsFilter <$> arbitrary <*> arbitrary
396 , LimitFilter <$> arbitrary
397 , MissingFilter <$> arbitrary <*> arbitrary <*> arbitrary
398 , PrefixFilter <$> arbitrary <*> arbitrary <*> arbitrary
399 , QueryFilter <$> arbitrary <*> arbitrary
400 , RangeFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
401 , RegexpFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
402 , TermFilter <$> arbitrary <*> arbitrary]
404$(derive makeArbitrary ''IndexName)
405$(derive makeArbitrary ''MappingName)
406$(derive makeArbitrary ''DocId)
407$(derive makeArbitrary ''Version)
408$(derive makeArbitrary ''IndexAliasRouting)
409$(derive makeArbitrary ''ShardCount)
410$(derive makeArbitrary ''ReplicaCount)
411$(derive makeArbitrary ''TemplateName)
412$(derive makeArbitrary ''TemplatePattern)
413$(derive makeArbitrary ''QueryString)
414$(derive makeArbitrary ''CacheName)
415$(derive makeArbitrary ''CacheKey)
416$(derive makeArbitrary ''Existence)
417$(derive makeArbitrary ''CutoffFrequency)
418$(derive makeArbitrary ''Analyzer)
419$(derive makeArbitrary ''MaxExpansions)
420$(derive makeArbitrary ''Lenient)
421$(derive makeArbitrary ''Tiebreaker)
422$(derive makeArbitrary ''Boost)
423$(derive makeArbitrary ''BoostTerms)
424$(derive makeArbitrary ''MinimumMatch)
425$(derive makeArbitrary ''DisableCoord)
426$(derive makeArbitrary ''IgnoreTermFrequency)
427$(derive makeArbitrary ''MinimumTermFrequency)
428$(derive makeArbitrary ''MaxQueryTerms)
429$(derive makeArbitrary ''Fuzziness)
430$(derive makeArbitrary ''PrefixLength)
431$(derive makeArbitrary ''TypeName)
432$(derive makeArbitrary ''PercentMatch)
433$(derive makeArbitrary ''StopWord)
434$(derive makeArbitrary ''QueryPath)
435$(derive makeArbitrary ''AllowLeadingWildcard)
436$(derive makeArbitrary ''LowercaseExpanded)
437$(derive makeArbitrary ''EnablePositionIncrements)
438$(derive makeArbitrary ''AnalyzeWildcard)
439$(derive makeArbitrary ''GeneratePhraseQueries)
440$(derive makeArbitrary ''Locale)
441$(derive makeArbitrary ''MaxWordLength)
442$(derive makeArbitrary ''MinWordLength)
443$(derive makeArbitrary ''PhraseSlop)
444$(derive makeArbitrary ''MinDocFrequency)
445$(derive makeArbitrary ''MaxDocFrequency)
446$(derive makeArbitrary ''Regexp)
447$(derive makeArbitrary ''SimpleQueryStringQuery)
448$(derive makeArbitrary ''FieldOrFields)
449$(derive makeArbitrary ''SimpleQueryFlag)
450$(derive makeArbitrary ''RegexpQuery)
451$(derive makeArbitrary ''QueryStringQuery)
452$(derive makeArbitrary ''RangeQuery)
453$(derive makeArbitrary ''RangeValue)
454$(derive makeArbitrary ''PrefixQuery)
455$(derive makeArbitrary ''NestedQuery)
456$(derive makeArbitrary ''MoreLikeThisFieldQuery)
457$(derive makeArbitrary ''MoreLikeThisQuery)
458$(derive makeArbitrary ''IndicesQuery)
459$(derive makeArbitrary ''HasParentQuery)
460$(derive makeArbitrary ''HasChildQuery)
461$(derive makeArbitrary ''FuzzyQuery)
462$(derive makeArbitrary ''FuzzyLikeFieldQuery)
463$(derive makeArbitrary ''FuzzyLikeThisQuery)
464$(derive makeArbitrary ''FilteredQuery)
465$(derive makeArbitrary ''DisMaxQuery)
466$(derive makeArbitrary ''CommonTermsQuery)
467$(derive makeArbitrary ''DistanceRange)
468$(derive makeArbitrary ''MultiMatchQuery)
469$(derive makeArbitrary ''LessThanD)
470$(derive makeArbitrary ''LessThanEqD)
471$(derive makeArbitrary ''GreaterThanD)
472$(derive makeArbitrary ''GreaterThanEqD)
473$(derive makeArbitrary ''LessThan)
474$(derive makeArbitrary ''LessThanEq)
475$(derive makeArbitrary ''GreaterThan)
476$(derive makeArbitrary ''GreaterThanEq)
477$(derive makeArbitrary ''GeoPoint)
478$(derive makeArbitrary ''NullValue)
479$(derive makeArbitrary ''MinimumMatchHighLow)
480$(derive makeArbitrary ''CommonMinimumMatch)
481$(derive makeArbitrary ''BoostingQuery)
482$(derive makeArbitrary ''BoolQuery)
483$(derive makeArbitrary ''MatchQuery)
484$(derive makeArbitrary ''MultiMatchQueryType)
485$(derive makeArbitrary ''BooleanOperator)
486$(derive makeArbitrary ''ZeroTermsQuery)
487$(derive makeArbitrary ''MatchQueryType)
488$(derive makeArbitrary ''SearchAliasRouting)
489$(derive makeArbitrary ''ScoreType)
490$(derive makeArbitrary ''Distance)
491$(derive makeArbitrary ''DistanceUnit)
492$(derive makeArbitrary ''DistanceType)
493$(derive makeArbitrary ''OptimizeBbox)
494$(derive makeArbitrary ''GeoBoundingBoxConstraint)
495$(derive makeArbitrary ''GeoFilterType)
496$(derive makeArbitrary ''GeoBoundingBox)
497$(derive makeArbitrary ''LatLon)
498$(derive makeArbitrary ''RangeExecution)
499$(derive makeArbitrary ''RegexpFlag)
500$(derive makeArbitrary ''BoolMatch)
501$(derive makeArbitrary ''Term)
504main :: IO ()
505main = hspec $ do
507 describe "index create/delete API" $ do
508 it "creates and then deletes the requested index" $ withTestEnv $ do
509 -- priming state.
510 _ <- deleteExampleIndex
511 resp <- createExampleIndex
512 deleteResp <- deleteExampleIndex
513 liftIO $ do
514 validateStatus resp 200
515 validateStatus deleteResp 200
517 describe "error parsing" $ do
518 it "can parse EsErrors" $ withTestEnv $ do
519 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
520 let errorResp = eitherDecode (responseBody res)
521 liftIO (errorResp `shouldBe` Right (EsError 404 "IndexMissingException[[bogus] missing]"))
523 describe "document API" $ do
524 it "indexes, gets, and then deletes the generated document" $ withTestEnv $ do
525 _ <- insertData
526 docInserted <- getDocument testIndex testMapping (DocId "1")
527 let newTweet = eitherDecode
528 (responseBody docInserted) :: Either String (EsResult Tweet)
529 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))
531 it "indexes, gets, and then deletes the generated document with a DocId containing a space" $ withTestEnv $ do
532 _ <- insertWithSpaceInId
533 docInserted <- getDocument testIndex testMapping (DocId "Hello World")
534 let newTweet = eitherDecode
535 (responseBody docInserted) :: Either String (EsResult Tweet)
536 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))
538 it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do
539 doc <- getDocument testIndex testMapping (DocId "bogus")
540 let noTweet = eitherDecode
541 (responseBody doc) :: Either String (EsResult Tweet)
542 liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing
544 it "can use optimistic concurrency control" $ withTestEnv $ do
545 let ev = ExternalDocVersion minBound
546 let cfg = defaultIndexDocumentSettings { idsVersionControl = ExternalGT ev }
547 resetIndex
548 res <- insertData' cfg
549 liftIO $ isCreated res `shouldBe` True
550 res' <- insertData' cfg
551 liftIO $ isVersionConflict res' `shouldBe` True
553 it "indexes two documents in a parent/child relationship and checks that the child exists" $ withTestEnv $ do
554 resetIndex
555 _ <- putMapping testIndex (MappingName "parent") ParentMapping
556 _ <- putMapping testIndex (MappingName "child") ChildMapping
557 _ <- indexDocument testIndex (MappingName "parent") defaultIndexDocumentSettings exampleTweet (DocId "1")
558 let parent = (Just . DocumentParent . DocId) "1"
559 ids = IndexDocumentSettings NoVersionControl parent
560 _ <- indexDocument testIndex (MappingName "child") ids otherTweet (DocId "2")
561 _ <- refreshIndex testIndex
562 exists <- documentExists testIndex (MappingName "child") parent (DocId "2")
563 liftIO $ exists `shouldBe` True
565 describe "template API" $ do
566 it "can create a template" $ withTestEnv $ do
567 let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
568 resp <- putTemplate idxTpl (TemplateName "tweet-tpl")
569 liftIO $ validateStatus resp 200
571 it "can detect if a template exists" $ withTestEnv $ do
572 exists <- templateExists (TemplateName "tweet-tpl")
573 liftIO $ exists `shouldBe` True
575 it "can delete a template" $ withTestEnv $ do
576 resp <- deleteTemplate (TemplateName "tweet-tpl")
577 liftIO $ validateStatus resp 200
579 it "can detect if a template doesn't exist" $ withTestEnv $ do
580 exists <- templateExists (TemplateName "tweet-tpl")
581 liftIO $ exists `shouldBe` False
583 describe "bulk API" $ do
584 it "inserts all documents we request" $ withTestEnv $ do
585 _ <- insertData
586 let firstTest = BulkTest "blah"
587 let secondTest = BulkTest "bloo"
588 let firstDoc = BulkIndex testIndex
589 testMapping (DocId "2") (toJSON firstTest)
590 let secondDoc = BulkCreate testIndex
591 testMapping (DocId "3") (toJSON secondTest)
592 let stream = V.fromList [firstDoc, secondDoc]
593 _ <- bulk stream
594 _ <- refreshIndex testIndex
595 fDoc <- getDocument testIndex testMapping (DocId "2")
596 sDoc <- getDocument testIndex testMapping (DocId "3")
597 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
598 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
599 liftIO $ do
600 fmap getSource maybeFirst `shouldBe` Right (Just firstTest)
601 fmap getSource maybeSecond `shouldBe` Right (Just secondTest)
604 describe "query API" $ do
605 it "returns document for term query and identity filter" $ withTestEnv $ do
606 _ <- insertData
607 let query = TermQuery (Term "user" "bitemyapp") Nothing
608 let filter = IdentityFilter <&&> IdentityFilter
609 let search = mkSearch (Just query) (Just filter)
610 myTweet <- searchTweet search
611 liftIO $
612 myTweet `shouldBe` Right exampleTweet
614 it "handles constant score queries" $ withTestEnv $ do
615 _ <- insertData
616 let query = TermsQuery "user" ("bitemyapp" :| [])
617 let cfQuery = ConstantScoreQuery query (Boost 1.0)
618 let filter = IdentityFilter
619 let search = mkSearch (Just cfQuery) (Just filter)
620 myTweet <- searchTweet search
621 liftIO $
622 myTweet `shouldBe` Right exampleTweet
623 it "handles constant score filters" $ withTestEnv $ do
624 _ <- insertData
625 let query = TermsQuery "user" ("bitemyapp" :| [])
626 let cfFilter = ConstantScoreFilter IdentityFilter (Boost 1.0)
627 let boolQuery = mkBoolQuery [query, cfFilter] [] []
628 let search = mkSearch (Just (QueryBoolQuery boolQuery)) Nothing
629 myTweet <- searchTweet search
630 liftIO $
631 myTweet `shouldBe` Right exampleTweet
634 it "returns document for terms query and identity filter" $ withTestEnv $ do
635 _ <- insertData
636 let query = TermsQuery "user" ("bitemyapp" :| [])
637 let filter = IdentityFilter <&&> IdentityFilter
638 let search = mkSearch (Just query) (Just filter)
639 myTweet <- searchTweet search
640 liftIO $
641 myTweet `shouldBe` Right exampleTweet
643 it "returns document for match query" $ withTestEnv $ do
644 _ <- insertData
645 let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
646 let search = mkSearch (Just query) Nothing
647 myTweet <- searchTweet search
648 liftIO $
649 myTweet `shouldBe` Right exampleTweet
651 it "returns document for multi-match query" $ withTestEnv $ do
652 _ <- insertData
653 let flds = [FieldName "user", FieldName "message"]
654 let query = QueryMultiMatchQuery $ mkMultiMatchQuery flds (QueryString "bitemyapp")
655 let search = mkSearch (Just query) Nothing
656 myTweet <- searchTweet search
657 liftIO $
658 myTweet `shouldBe` Right exampleTweet
660 it "returns document for bool query" $ withTestEnv $ do
661 _ <- insertData
662 let innerQuery = QueryMatchQuery $
663 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
664 let query = QueryBoolQuery $
665 mkBoolQuery [innerQuery] [] []
666 let search = mkSearch (Just query) Nothing
667 myTweet <- searchTweet search
668 liftIO $
669 myTweet `shouldBe` Right exampleTweet
671 it "returns document for boosting query" $ withTestEnv $ do
672 _ <- insertData
673 let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
674 let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
675 let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
676 let search = mkSearch (Just query) Nothing
677 myTweet <- searchTweet search
678 liftIO $
679 myTweet `shouldBe` Right exampleTweet
681 it "returns document for common terms query" $ withTestEnv $ do
682 _ <- insertData
683 let query = QueryCommonTermsQuery $
684 CommonTermsQuery (FieldName "user")
685 (QueryString "bitemyapp")
686 (CutoffFrequency 0.0001)
687 Or Or Nothing Nothing Nothing Nothing
688 let search = mkSearch (Just query) Nothing
689 myTweet <- searchTweet search
690 liftIO $
691 myTweet `shouldBe` Right exampleTweet
694 describe "sorting" $ do
695 it "returns documents in the right order" $ withTestEnv $ do
696 _ <- insertData
697 _ <- insertOther
698 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
699 let search = Search Nothing
700 (Just IdentityFilter) (Just [sortSpec]) Nothing Nothing
701 False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
702 result <- searchTweets search
703 let myTweet = grabFirst result
704 liftIO $
705 myTweet `shouldBe` Right otherTweet
708 describe "filtering API" $ do
709 it "returns document for composed boolmatch and identity" $ withTestEnv $ do
710 _ <- insertData
711 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
712 <&&> IdentityFilter
713 let search = mkSearch Nothing (Just queryFilter)
714 myTweet <- searchTweet search
715 liftIO $
716 myTweet `shouldBe` Right exampleTweet
718 it "returns document for term filter" $ withTestEnv $ do
719 _ <- insertData
720 let termFilter = TermFilter (Term "user" "bitemyapp") False
721 let search = mkSearch Nothing (Just termFilter)
722 myTweet <- searchTweet search
723 liftIO $
724 myTweet `shouldBe` Right exampleTweet
726 it "returns document for existential filter" $ withTestEnv $ do
727 _ <- insertData
728 let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
729 myTweet <- searchTweet search
730 liftIO $
731 myTweet `shouldBe` Right exampleTweet
733 it "returns document for geo boundingbox filter" $ withTestEnv $ do
734 _ <- insertData
735 let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
736 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
737 let geoFilter = GeoBoundingBoxFilter bbConstraint
738 let search = mkSearch Nothing (Just geoFilter)
739 myTweet <- searchTweet search
740 liftIO $
741 myTweet `shouldBe` Right exampleTweet
743 it "doesn't return document for nonsensical boundingbox filter" $ withTestEnv $ do
744 _ <- insertData
745 let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
746 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
747 let geoFilter = GeoBoundingBoxFilter bbConstraint
748 let search = mkSearch Nothing (Just geoFilter)
749 searchExpectNoResults search
751 it "returns document for geo distance filter" $ withTestEnv $ do
752 _ <- insertData
753 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
754 let distance = Distance 10.0 Miles
755 let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
756 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
757 let search = mkSearch Nothing (Just geoFilter)
758 myTweet <- searchTweet search
759 liftIO $
760 myTweet `shouldBe` Right exampleTweet
762 it "returns document for geo distance range filter" $ withTestEnv $ do
763 _ <- insertData
764 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
765 let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
766 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
767 let search = mkSearch Nothing (Just geoFilter)
768 myTweet <- searchTweet search
769 liftIO $
770 myTweet `shouldBe` Right exampleTweet
772 it "doesn't return document for wild geo distance range filter" $ withTestEnv $ do
773 _ <- insertData
774 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
775 let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
776 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
777 let search = mkSearch Nothing (Just geoFilter)
778 searchExpectNoResults search
780 it "returns document for geo polygon filter" $ withTestEnv $ do
781 _ <- insertData
782 let points = [LatLon 40.0 (-70.00),
783 LatLon 40.0 (-72.00),
784 LatLon 41.0 (-70.00),
785 LatLon 41.0 (-72.00)]
786 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
787 let search = mkSearch Nothing (Just geoFilter)
788 myTweet <- searchTweet search
789 liftIO $
790 myTweet `shouldBe` Right exampleTweet
792 it "doesn't return document for bad geo polygon filter" $ withTestEnv $ do
793 _ <- insertData
794 let points = [LatLon 40.0 (-70.00),
795 LatLon 40.0 (-71.00),
796 LatLon 41.0 (-70.00),
797 LatLon 41.0 (-71.00)]
798 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
799 let search = mkSearch Nothing (Just geoFilter)
800 searchExpectNoResults search
802 it "returns document for ids filter" $ withTestEnv $ do
803 _ <- insertData
804 let filter = IdsFilter (MappingName "tweet") [DocId "1"]
805 let search = mkSearch Nothing (Just filter)
806 myTweet <- searchTweet search
807 liftIO $
808 myTweet `shouldBe` Right exampleTweet
810 it "returns document for Double range filter" $ withTestEnv $ do
811 _ <- insertData
812 let filter = RangeFilter (FieldName "age")
813 (RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))
814 RangeExecutionIndex False
815 let search = mkSearch Nothing (Just filter)
816 myTweet <- searchTweet search
817 liftIO $
818 myTweet `shouldBe` Right exampleTweet
820 it "returns document for UTCTime date filter" $ withTestEnv $ do
821 _ <- insertData
822 let filter = RangeFilter (FieldName "postDate")
823 (RangeDateGtLt
824 (GreaterThanD (UTCTime
825 (ModifiedJulianDay 54000)
826 (secondsToDiffTime 0)))
827 (LessThanD (UTCTime
828 (ModifiedJulianDay 55000)
829 (secondsToDiffTime 11))))
830 RangeExecutionIndex False
831 let search = mkSearch Nothing (Just filter)
832 myTweet <- searchTweet search
833 liftIO $
834 myTweet `shouldBe` Right exampleTweet
836 it "returns document for regexp filter" $ withTestEnv $ do
837 _ <- insertData
838 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
839 AllRegexpFlags (CacheName "test") False (CacheKey "key")
840 let search = mkSearch Nothing (Just filter)
841 myTweet <- searchTweet search
842 liftIO $
843 myTweet `shouldBe` Right exampleTweet
845 it "doesn't return document for non-matching regexp filter" $ withTestEnv $ do
846 _ <- insertData
847 let filter = RegexpFilter (FieldName "user")
848 (Regexp "boy") AllRegexpFlags
849 (CacheName "test") False (CacheKey "key")
850 let search = mkSearch Nothing (Just filter)
851 searchExpectNoResults search
853 it "returns document for query filter, uncached" $ withTestEnv $ do
854 _ <- insertData
855 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) True
856 search = mkSearch Nothing (Just filter)
857 myTweet <- searchTweet search
858 liftIO $ myTweet `shouldBe` Right exampleTweet
860 it "returns document for query filter, cached" $ withTestEnv $ do
861 _ <- insertData
862 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) False
863 search = mkSearch Nothing (Just filter)
864 myTweet <- searchTweet search
865 liftIO $ myTweet `shouldBe` Right exampleTweet
867 describe "Aggregation API" $ do
868 it "returns term aggregation results" $ withTestEnv $ do
869 _ <- insertData
870 let terms = TermsAgg $ mkTermsAggregation "user"
871 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
872 searchExpectAggs search
873 searchValidBucketAgg search "users" toTerms
875 it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
876 _ <- insertData
877 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
878 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
879 searchExpectAggs search
880 searchValidBucketAgg search "users" toTerms
882 it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
883 _ <- insertData
884 searchTermsAggHint [Map, Ordinals]
886 it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do
887 _ <- insertData
888 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
890 it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
891 _ <- insertData
892 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
895 it "can execute value_count aggregations" $ withTestEnv $ do
896 _ <- insertData
897 _ <- insertOther
898 let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>
899 mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))
900 let search = mkAggregateSearch Nothing ags
901 let docCountPair k n = (k, object ["value" .= Number n])
902 res <- searchTweets search
903 liftIO $
904 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2
905 , docCountPair "bogus_count" 0
906 ]))
908 it "can execute filter aggregations" $ withTestEnv $ do
909 _ <- insertData
910 _ <- insertOther
911 let ags = mkAggregations "bitemyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "bitemyapp") defaultCache) Nothing)) <>
912 mkAggregations "notmyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "notmyapp") defaultCache) Nothing))
913 let search = mkAggregateSearch Nothing ags
914 let docCountPair k n = (k, object ["doc_count" .= Number n])
915 res <- searchTweets search
916 liftIO $
917 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "bitemyapps" 1
918 , docCountPair "notmyapps" 1
919 ]))
921 it "returns date histogram aggregation results" $ withTestEnv $ do
922 _ <- insertData
923 let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
924 let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
925 searchExpectAggs search
926 searchValidBucketAgg search "byDate" toDateHistogram
928 it "returns date histogram using fractional date" $ withTestEnv $ do
929 _ <- insertData
930 let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]
931 let fractionals = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]
932 let intervals = periods ++ fractionals
933 let histogram = mkDateHistogram (FieldName "postDate")
934 let search interval = mkAggregateSearch Nothing $ mkAggregations "byDate" $ DateHistogramAgg (histogram interval)
935 let expect interval = searchExpectAggs (search interval)
936 let valid interval = searchValidBucketAgg (search interval) "byDate" toDateHistogram
937 forM_ intervals expect
938 forM_ intervals valid
940 describe "Highlights API" $ do
942 it "returns highlight from query when there should be one" $ withTestEnv $ do
943 _ <- insertData
944 _ <- insertOther
945 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
946 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
948 let search = mkHighlightSearch (Just query) testHighlight
949 myHighlight <- searchTweetHighlight search
950 liftIO $
951 myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
953 it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
954 _ <- insertData
955 _ <- insertOther
956 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
957 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "user") Nothing]
959 let search = mkHighlightSearch (Just query) testHighlight
960 myHighlight <- searchTweetHighlight search
961 liftIO $
962 myHighlight `shouldBe` Right Nothing
964 describe "Source filtering" $ do
966 it "doesn't include source when sources are disabled" $ withTestEnv $ do
967 searchExpectSource
968 NoSource
969 (Left (EsError 500 "Source was missing"))
971 it "includes a source" $ withTestEnv $ do
972 searchExpectSource
973 (SourcePatterns (PopPattern (Pattern "message")))
974 (Right (Object (HM.fromList [("message", String "Use haskell!")])))
976 it "includes sources" $ withTestEnv $ do
977 searchExpectSource
978 (SourcePatterns (PopPatterns [Pattern "user", Pattern "message"]))
979 (Right (Object (HM.fromList [("user",String "bitemyapp"),("message", String "Use haskell!")])))
981 it "includes source patterns" $ withTestEnv $ do
982 searchExpectSource
983 (SourcePatterns (PopPattern (Pattern "*ge")))
984 (Right (Object (HM.fromList [("age", Number 10000),("message", String "Use haskell!")])))
986 it "excludes source patterns" $ withTestEnv $ do
987 searchExpectSource
988 (SourceIncludeExclude (Include []) (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate"]))
989 (Right (Object (HM.fromList [("user",String "bitemyapp")])))
991 describe "ToJSON RegexpFlags" $ do
992 it "generates the correct JSON for AllRegexpFlags" $
993 toJSON AllRegexpFlags `shouldBe` String "ALL"
995 it "generates the correct JSON for NoRegexpFlags" $
996 toJSON NoRegexpFlags `shouldBe` String "NONE"
998 it "generates the correct JSON for SomeRegexpFlags" $
999 let flags = AnyString :| [ Automaton
1000 , Complement
1001 , Empty
1002 , Intersection
1003 , Interval ]
1004 in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
1006 prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
1007 let String str = toJSON flags
1008 flagStrs = T.splitOn "|" str
1009 in noDuplicates flagStrs
1011 describe "omitNulls" $ do
1012 it "checks that omitNulls drops list elements when it should" $
1013 let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))
1014 , "test2" .= (toJSON ("some value" :: Text))]
1015 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1017 it "checks that omitNulls doesn't drop list elements when it shouldn't" $
1018 let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))
1019 , "test2" .= (toJSON ("some value" :: Text))]
1020 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))
1021 , ("test2", String "some value")])
1022 it "checks that omitNulls drops non list elements when it should" $
1023 let dropped = omitNulls $ [ "test1" .= (toJSON Null)
1024 , "test2" .= (toJSON ("some value" :: Text))]
1025 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1026 it "checks that omitNulls doesn't drop non list elements when it shouldn't" $
1027 let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
1028 , "test2" .= (toJSON ("some value" :: Text))]
1029 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
1030 , ("test2", String "some value")])
1031 describe "Monoid (SearchHits a)" $ do
1032 prop "abides the monoid laws" $ eq $
1033 prop_Monoid (T :: T (SearchHits ()))
1035 describe "mkDocVersion" $ do
1036 prop "can never construct an out of range docVersion" $ \i ->
1037 let res = mkDocVersion i
1038 in case res of
1039 Nothing -> property True
1040 Just dv -> (dv >= minBound) .&&.
1041 (dv <= maxBound) .&&.
1042 docVersionNumber dv === i
1044 describe "Enum DocVersion" $ do
1045 it "follows the laws of Enum, Bounded" $ do
1046 evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall
1047 evaluate (pred minBound :: DocVersion) `shouldThrow` anyErrorCall
1048 evaluate (toEnum 0 :: DocVersion) `shouldThrow` anyErrorCall
1049 evaluate (toEnum 9200000000000000001 :: DocVersion) `shouldThrow` anyErrorCall
1050 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1051 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1052 enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]
1054 describe "scan&scroll API" $ do
1055 it "returns documents using the scan&scroll API" $ withTestEnv $ do
1056 _ <- insertData
1057 _ <- insertOther
1058 let search = (mkSearch (Just $ MatchAllQuery Nothing) Nothing) { size = (Size 1) }
1059 regular_search <- searchTweet search
1060 scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet]
1061 let scan_search = map hitSource scan_search'
1062 liftIO $
1063 regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored
1064 liftIO $
1065 scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]
1067 describe "index aliases" $ do
1068 it "handles the simple case of aliasing an existing index" $ do
1069 let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1070 let create = IndexAliasCreate Nothing Nothing
1071 let action = AddAlias alias create
1073 withTestEnv $ do
1074 resetIndex
1075 resp <- updateIndexAliases (action :| [])
1076 liftIO $ NHTS.statusCode (responseStatus resp) `shouldBe` 200
1077 let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1078 (do aliases <- withTestEnv getIndexAliases
1079 let expected = IndexAliasSummary alias create
1080 case aliases of
1081 Right (IndexAliasesSummary summs) ->
1082 L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1083 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1085 it "handles an alias with routing and a filter" $ do
1086 let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1087 let sar = SearchAliasRouting (RoutingValue "search val" :| [])
1088 let iar = IndexAliasRouting (RoutingValue "index val")
1089 let routing = GranularAliasRouting (Just sar) (Just iar)
1090 let filter = LimitFilter 42
1091 let create = IndexAliasCreate (Just routing) (Just filter)
1092 let action = AddAlias alias create
1094 withTestEnv $ do
1095 resetIndex
1096 resp <- updateIndexAliases (action :| [])
1097 liftIO $ NHTS.statusCode (responseStatus resp) `shouldBe` 200
1098 let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1099 (do aliases <- withTestEnv getIndexAliases
1100 let expected = IndexAliasSummary alias create
1101 case aliases of
1102 Right (IndexAliasesSummary summs) ->
1103 L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1104 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1106 describe "JSON instances" $ do
1107 propJSON (Proxy :: Proxy Version)
1108 propJSON (Proxy :: Proxy IndexName)
1109 propJSON (Proxy :: Proxy MappingName)
1110 propJSON (Proxy :: Proxy DocId)
1111 propJSON (Proxy :: Proxy IndexAliasRouting)
1112 propJSON (Proxy :: Proxy RoutingValue)
1113 propJSON (Proxy :: Proxy ShardCount)
1114 propJSON (Proxy :: Proxy ReplicaCount)
1115 propJSON (Proxy :: Proxy TemplateName)
1116 propJSON (Proxy :: Proxy TemplatePattern)
1117 propJSON (Proxy :: Proxy QueryString)
1118 propJSON (Proxy :: Proxy FieldName)
1119 propJSON (Proxy :: Proxy CacheName)
1120 propJSON (Proxy :: Proxy CacheKey)
1121 propJSON (Proxy :: Proxy Existence)
1122 propJSON (Proxy :: Proxy CutoffFrequency)
1123 propJSON (Proxy :: Proxy Analyzer)
1124 propJSON (Proxy :: Proxy MaxExpansions)
1125 propJSON (Proxy :: Proxy Lenient)
1126 propJSON (Proxy :: Proxy Tiebreaker)
1127 propJSON (Proxy :: Proxy Boost)
1128 propJSON (Proxy :: Proxy BoostTerms)
1129 propJSON (Proxy :: Proxy MaxExpansions)
1130 propJSON (Proxy :: Proxy MinimumMatch)
1131 propJSON (Proxy :: Proxy DisableCoord)
1132 propJSON (Proxy :: Proxy IgnoreTermFrequency)
1133 propJSON (Proxy :: Proxy MinimumTermFrequency)
1134 propJSON (Proxy :: Proxy MaxQueryTerms)
1135 propJSON (Proxy :: Proxy Fuzziness)
1136 propJSON (Proxy :: Proxy PrefixLength)
1137 propJSON (Proxy :: Proxy TypeName)
1138 propJSON (Proxy :: Proxy PercentMatch)
1139 propJSON (Proxy :: Proxy StopWord)
1140 propJSON (Proxy :: Proxy QueryPath)
1141 propJSON (Proxy :: Proxy AllowLeadingWildcard)
1142 propJSON (Proxy :: Proxy LowercaseExpanded)
1143 propJSON (Proxy :: Proxy EnablePositionIncrements)
1144 propJSON (Proxy :: Proxy AnalyzeWildcard)
1145 propJSON (Proxy :: Proxy GeneratePhraseQueries)
1146 propJSON (Proxy :: Proxy Locale)
1147 propJSON (Proxy :: Proxy MaxWordLength)
1148 propJSON (Proxy :: Proxy MinWordLength)
1149 propJSON (Proxy :: Proxy PhraseSlop)
1150 propJSON (Proxy :: Proxy MinDocFrequency)
1151 propJSON (Proxy :: Proxy MaxDocFrequency)
1152 propJSON (Proxy :: Proxy Filter)
1153 propJSON (Proxy :: Proxy Query)
1154 propJSON (Proxy :: Proxy SimpleQueryStringQuery)
1155 propJSON (Proxy :: Proxy FieldOrFields)
1156 propJSON (Proxy :: Proxy SimpleQueryFlag)
1157 propJSON (Proxy :: Proxy RegexpQuery)
1158 propJSON (Proxy :: Proxy QueryStringQuery)
1159 propJSON (Proxy :: Proxy RangeQuery)
1160 propJSON (Proxy :: Proxy PrefixQuery)
1161 propJSON (Proxy :: Proxy NestedQuery)
1162 propJSON (Proxy :: Proxy MoreLikeThisFieldQuery)
1163 propJSON (Proxy :: Proxy MoreLikeThisQuery)
1164 propJSON (Proxy :: Proxy IndicesQuery)
1165 propJSON (Proxy :: Proxy HasParentQuery)
1166 propJSON (Proxy :: Proxy HasChildQuery)
1167 propJSON (Proxy :: Proxy FuzzyQuery)
1168 propJSON (Proxy :: Proxy FuzzyLikeFieldQuery)
1169 propJSON (Proxy :: Proxy FuzzyLikeThisQuery)
1170 propJSON (Proxy :: Proxy FilteredQuery)
1171 propJSON (Proxy :: Proxy DisMaxQuery)
1172 propJSON (Proxy :: Proxy CommonTermsQuery)
1173 propJSON (Proxy :: Proxy CommonMinimumMatch)
1174 propJSON (Proxy :: Proxy BoostingQuery)
1175 propJSON (Proxy :: Proxy BoolQuery)
1176 propJSON (Proxy :: Proxy MatchQuery)
1177 propJSON (Proxy :: Proxy MultiMatchQueryType)
1178 propJSON (Proxy :: Proxy BooleanOperator)
1179 propJSON (Proxy :: Proxy ZeroTermsQuery)
1180 propJSON (Proxy :: Proxy MatchQueryType)
1181 propJSON (Proxy :: Proxy AliasRouting)
1182 propJSON (Proxy :: Proxy IndexAliasCreate)
1183 propJSON (Proxy :: Proxy SearchAliasRouting)
1184 propJSON (Proxy :: Proxy ScoreType)
1185 propJSON (Proxy :: Proxy Distance)
1186 propJSON (Proxy :: Proxy DistanceUnit)
1187 propJSON (Proxy :: Proxy DistanceType)
1188 propJSON (Proxy :: Proxy OptimizeBbox)
1189 propJSON (Proxy :: Proxy GeoBoundingBoxConstraint)
1190 propJSON (Proxy :: Proxy GeoFilterType)
1191 propJSON (Proxy :: Proxy GeoBoundingBox)
1192 propJSON (Proxy :: Proxy LatLon)
1193 propJSON (Proxy :: Proxy RangeExecution)
1194 prop "RegexpFlags FromJSON/ToJSON roundtrips, removing dups " $ \rfs ->
1195 let expected = case rfs of
1196 SomeRegexpFlags fs -> SomeRegexpFlags (NE.fromList (nub (NE.toList fs)))
1197 x -> x
1198 in parseEither parseJSON (toJSON rfs) === Right expected
1199 propJSON (Proxy :: Proxy BoolMatch)
1200 propJSON (Proxy :: Proxy Term)
1201 propJSON (Proxy :: Proxy MultiMatchQuery)