git.iko.soy/typeable/bloodhound
on 14dbffa help sign in
typeable/bloodhound/tests/tests.hs
711 lines 30 kB history raw
1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4{-# OPTIONS_GHC -fno-warn-orphans #-}
5module Main where
7import Control.Applicative
8import Control.Exception
9import Control.Monad
10import Control.Monad.Reader
11import Data.Aeson
12import qualified Data.HashMap.Strict as HM
13import Data.List (nub)
14import Data.List.NonEmpty (NonEmpty (..))
15import qualified Data.List.NonEmpty as NE
16import qualified Data.Map.Strict as M
17import Data.Text (Text)
18import qualified Data.Text as T
19import Data.Time.Calendar (Day (..))
20import Data.Time.Clock (UTCTime (..),
21 secondsToDiffTime)
22import qualified Data.Vector as V
23import Database.Bloodhound
24import GHC.Generics (Generic)
25import Network.HTTP.Client
26import qualified Network.HTTP.Types.Status as NHTS
27import Prelude hiding (filter)
28import Test.Hspec
29import Test.QuickCheck.Property.Monoid (prop_Monoid, eq, T(..))
31import Test.Hspec.QuickCheck (prop)
32import Test.QuickCheck
34testServer :: Server
35testServer = Server "http://localhost:9200"
36testIndex :: IndexName
37testIndex = IndexName "bloodhound-tests-twitter-1"
38testMapping :: MappingName
39testMapping = MappingName "tweet"
41withTestEnv :: BH IO a -> IO a
42withTestEnv = withBH defaultManagerSettings testServer
44validateStatus :: Response body -> Int -> Expectation
45validateStatus resp expected =
46 (NHTS.statusCode $ responseStatus resp)
47 `shouldBe` (expected :: Int)
49createExampleIndex :: BH IO Reply
50createExampleIndex = createIndex defaultIndexSettings testIndex
51deleteExampleIndex :: BH IO Reply
52deleteExampleIndex = deleteIndex testIndex
54data ServerVersion = ServerVersion Int Int Int deriving (Show, Eq, Ord)
56es14 :: ServerVersion
57es14 = ServerVersion 1 4 0
59es13 :: ServerVersion
60es13 = ServerVersion 1 3 0
62es12 :: ServerVersion
63es12 = ServerVersion 1 2 0
65es11 :: ServerVersion
66es11 = ServerVersion 1 1 0
68es10 :: ServerVersion
69es10 = ServerVersion 1 0 0
71serverBranch :: ServerVersion -> ServerVersion
72serverBranch (ServerVersion majorVer minorVer patchVer) =
73 ServerVersion majorVer minorVer patchVer
75mkServerVersion :: [Int] -> Maybe ServerVersion
76mkServerVersion [majorVer, minorVer, patchVer] =
77 Just (ServerVersion majorVer minorVer patchVer)
78mkServerVersion _ = Nothing
80getServerVersion :: IO (Maybe ServerVersion)
81getServerVersion = liftM extractVersion (withTestEnv getStatus)
82 where
83 version' = T.splitOn "." . number . version
84 toInt = read . T.unpack
85 parseVersion v = map toInt (version' v)
86 extractVersion = join . liftM (mkServerVersion . parseVersion)
88testServerBranch :: IO (Maybe ServerVersion)
89testServerBranch = getServerVersion >>= \v -> return $ liftM serverBranch v
91atleast :: ServerVersion -> IO Bool
92atleast v = testServerBranch >>= \x -> return $ x >= Just (serverBranch v)
94atmost :: ServerVersion -> IO Bool
95atmost v = testServerBranch >>= \x -> return $ x <= Just (serverBranch v)
97is :: ServerVersion -> IO Bool
98is v = testServerBranch >>= \x -> return $ x == Just (serverBranch v)
100when' :: Monad m => m Bool -> m () -> m ()
101when' b f = b >>= \x -> when x f
103data Location = Location { lat :: Double
104 , lon :: Double } deriving (Eq, Generic, Show)
106data Tweet = Tweet { user :: Text
107 , postDate :: UTCTime
108 , message :: Text
109 , age :: Int
110 , location :: Location }
111 deriving (Eq, Generic, Show)
113instance ToJSON Tweet
114instance FromJSON Tweet
115instance ToJSON Location
116instance FromJSON Location
118data TweetMapping = TweetMapping deriving (Eq, Show)
120instance ToJSON TweetMapping where
121 toJSON TweetMapping =
122 object ["tweet" .=
123 object ["properties" .=
124 object [ "user" .= object ["type" .= ("string" :: Text)]
125 -- Serializing the date as a date is breaking other tests, mysteriously.
126 -- , "postDate" .= object [ "type" .= ("date" :: Text)
127 -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
128 , "message" .= object ["type" .= ("string" :: Text)]
129 , "age" .= object ["type" .= ("integer" :: Text)]
130 , "location" .= object ["type" .= ("geo_point" :: Text)]
131 ]]]
133exampleTweet :: Tweet
134exampleTweet = Tweet { user = "bitemyapp"
135 , postDate = UTCTime
136 (ModifiedJulianDay 55000)
137 (secondsToDiffTime 10)
138 , message = "Use haskell!"
139 , age = 10000
140 , location = Location 40.12 (-71.34) }
142otherTweet :: Tweet
143otherTweet = Tweet { user = "notmyapp"
144 , postDate = UTCTime
145 (ModifiedJulianDay 55000)
146 (secondsToDiffTime 11)
147 , message = "Use haskell!"
148 , age = 1000
149 , location = Location 40.12 (-71.34) }
151resetIndex :: BH IO ()
152resetIndex = do
153 _ <- deleteExampleIndex
154 _ <- createExampleIndex
155 _ <- putMapping testIndex testMapping TweetMapping
156 return ()
158insertData :: BH IO Reply
159insertData = do
160 resetIndex
161 insertData' defaultIndexDocumentSettings
163insertData' :: IndexDocumentSettings -> BH IO Reply
164insertData' ids = do
165 r <- indexDocument testIndex testMapping ids exampleTweet (DocId "1")
166 _ <- refreshIndex testIndex
167 return r
169insertOther :: BH IO ()
170insertOther = do
171 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings otherTweet (DocId "2")
172 _ <- refreshIndex testIndex
173 return ()
175searchTweet :: Search -> BH IO (Either String Tweet)
176searchTweet search = do
177 reply <- searchByIndex testIndex search
178 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
179 let myTweet = fmap (hitSource . head . hits . searchHits) result
180 return myTweet
182searchExpectNoResults :: Search -> BH IO ()
183searchExpectNoResults search = do
184 reply <- searchByIndex testIndex search
185 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
186 let emptyHits = fmap (hits . searchHits) result
187 liftIO $
188 emptyHits `shouldBe` Right []
190searchExpectAggs :: Search -> BH IO ()
191searchExpectAggs search = do
192 reply <- searchAll search
193 let isEmpty x = return (M.null x)
194 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
195 liftIO $
196 (result >>= aggregations >>= isEmpty) `shouldBe` Just False
198searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) =>
199 Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> BH IO ()
200searchValidBucketAgg search aggKey extractor = do
201 reply <- searchAll search
202 let bucketDocs = docCount . head . buckets
203 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
204 let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)
205 liftIO $
206 count `shouldBe` Just 1
208searchTermsAggHint :: [ExecutionHint] -> BH IO ()
209searchTermsAggHint hints = do
210 let terms hint = TermsAgg $ (mkTermsAggregation "user") { termExecutionHint = Just hint }
211 let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint
212 forM_ hints $ searchExpectAggs . search
213 forM_ hints (\x -> searchValidBucketAgg (search x) "users" toTerms)
215searchTweetHighlight :: Search -> BH IO (Either String (Maybe HitHighlight))
216searchTweetHighlight search = do
217 reply <- searchByIndex testIndex search
218 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
219 let myHighlight = fmap (hitHighlight . head . hits . searchHits) result
220 return myHighlight
222data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
223instance FromJSON BulkTest
224instance ToJSON BulkTest
226noDuplicates :: Eq a => [a] -> Bool
227noDuplicates xs = nub xs == xs
229instance Arbitrary RegexpFlags where
230 arbitrary = oneof [ pure AllRegexpFlags
231 , pure NoRegexpFlags
232 , SomeRegexpFlags <$> arbitrary
233 ]
235instance Arbitrary a => Arbitrary (NonEmpty a) where
236 arbitrary = liftA2 (:|) arbitrary arbitrary
238instance Arbitrary RegexpFlag where
239 arbitrary = oneof [ pure AnyString
240 , pure Automaton
241 , pure Complement
242 , pure Empty
243 , pure Intersection
244 , pure Interval
245 ]
247arbitraryScore :: Gen Score
248arbitraryScore = fmap getPositive <$> arbitrary
250instance Arbitrary Text where
251 arbitrary = T.pack <$> arbitrary
253instance (Arbitrary k, Arbitrary v, Ord k) => Arbitrary (M.Map k v) where
254 arbitrary = M.fromList <$> arbitrary
256instance Arbitrary IndexName where
257 arbitrary = IndexName <$> arbitrary
259instance Arbitrary MappingName where
260 arbitrary = MappingName <$> arbitrary
262instance Arbitrary DocId where
263 arbitrary = DocId <$> arbitrary
265instance Arbitrary a => Arbitrary (Hit a) where
266 arbitrary = Hit <$> arbitrary
267 <*> arbitrary
268 <*> arbitrary
269 <*> arbitraryScore
270 <*> arbitrary
271 <*> arbitrary
274instance Arbitrary a => Arbitrary (SearchHits a) where
275 arbitrary = sized $ \n -> resize (n `div` 2) $ do
276 tot <- getPositive <$> arbitrary
277 score <- arbitraryScore
278 hs <- arbitrary
279 return $ SearchHits tot score hs
281main :: IO ()
282main = hspec $ do
284 describe "index create/delete API" $ do
285 it "creates and then deletes the requested index" $ withTestEnv $ do
286 -- priming state.
287 _ <- deleteExampleIndex
288 resp <- createExampleIndex
289 deleteResp <- deleteExampleIndex
290 liftIO $ do
291 validateStatus resp 200
292 validateStatus deleteResp 200
295 describe "document API" $ do
296 it "indexes, gets, and then deletes the generated document" $ withTestEnv $ do
297 _ <- insertData
298 docInserted <- getDocument testIndex testMapping (DocId "1")
299 let newTweet = eitherDecode
300 (responseBody docInserted) :: Either String (EsResult Tweet)
301 liftIO $ (fmap _source newTweet `shouldBe` Right exampleTweet)
303 it "can use optimistic concurrency control" $ withTestEnv $ do
304 let ev = ExternalDocVersion minBound
305 let cfg = defaultIndexDocumentSettings { idsVersionControl = ExternalGT ev }
306 resetIndex
307 res <- insertData' cfg
308 liftIO $ isCreated res `shouldBe` True
309 res' <- insertData' cfg
310 liftIO $ isVersionConflict res' `shouldBe` True
312 describe "bulk API" $ do
313 it "inserts all documents we request" $ withTestEnv $ do
314 _ <- insertData
315 let firstTest = BulkTest "blah"
316 let secondTest = BulkTest "bloo"
317 let firstDoc = BulkIndex testIndex
318 testMapping (DocId "2") (toJSON firstTest)
319 let secondDoc = BulkCreate testIndex
320 testMapping (DocId "3") (toJSON secondTest)
321 let stream = V.fromList [firstDoc, secondDoc]
322 _ <- bulk stream
323 _ <- refreshIndex testIndex
324 fDoc <- getDocument testIndex testMapping (DocId "2")
325 sDoc <- getDocument testIndex testMapping (DocId "3")
326 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
327 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
328 liftIO $ do
329 fmap _source maybeFirst `shouldBe` Right firstTest
330 fmap _source maybeSecond `shouldBe` Right secondTest
333 describe "query API" $ do
334 it "returns document for term query and identity filter" $ withTestEnv $ do
335 _ <- insertData
336 let query = TermQuery (Term "user" "bitemyapp") Nothing
337 let filter = IdentityFilter <&&> IdentityFilter
338 let search = mkSearch (Just query) (Just filter)
339 myTweet <- searchTweet search
340 liftIO $
341 myTweet `shouldBe` Right exampleTweet
343 it "returns document for terms query and identity filter" $ withTestEnv $ do
344 _ <- insertData
345 let query = TermsQuery (NE.fromList [(Term "user" "bitemyapp")])
346 let filter = IdentityFilter <&&> IdentityFilter
347 let search = mkSearch (Just query) (Just filter)
348 myTweet <- searchTweet search
349 liftIO $
350 myTweet `shouldBe` Right exampleTweet
352 it "returns document for match query" $ withTestEnv $ do
353 _ <- insertData
354 let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
355 let search = mkSearch (Just query) Nothing
356 myTweet <- searchTweet search
357 liftIO $
358 myTweet `shouldBe` Right exampleTweet
360 it "returns document for multi-match query" $ withTestEnv $ do
361 _ <- insertData
362 let fields = [FieldName "user", FieldName "message"]
363 let query = QueryMultiMatchQuery $ mkMultiMatchQuery fields (QueryString "bitemyapp")
364 let search = mkSearch (Just query) Nothing
365 myTweet <- searchTweet search
366 liftIO $
367 myTweet `shouldBe` Right exampleTweet
369 it "returns document for bool query" $ withTestEnv $ do
370 _ <- insertData
371 let innerQuery = QueryMatchQuery $
372 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
373 let query = QueryBoolQuery $
374 mkBoolQuery [innerQuery] [] []
375 let search = mkSearch (Just query) Nothing
376 myTweet <- searchTweet search
377 liftIO $
378 myTweet `shouldBe` Right exampleTweet
380 it "returns document for boosting query" $ withTestEnv $ do
381 _ <- insertData
382 let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
383 let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
384 let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
385 let search = mkSearch (Just query) Nothing
386 myTweet <- searchTweet search
387 liftIO $
388 myTweet `shouldBe` Right exampleTweet
390 it "returns document for common terms query" $ withTestEnv $ do
391 _ <- insertData
392 let query = QueryCommonTermsQuery $
393 CommonTermsQuery (FieldName "user")
394 (QueryString "bitemyapp")
395 (CutoffFrequency 0.0001)
396 Or Or Nothing Nothing Nothing Nothing
397 let search = mkSearch (Just query) Nothing
398 myTweet <- searchTweet search
399 liftIO $
400 myTweet `shouldBe` Right exampleTweet
403 describe "sorting" $ do
404 it "returns documents in the right order" $ withTestEnv $ do
405 _ <- insertData
406 _ <- insertOther
407 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
408 let search = Search Nothing
409 (Just IdentityFilter) (Just [sortSpec]) Nothing Nothing
410 False (From 0) (Size 10)
411 reply <- searchByIndex testIndex search
412 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
413 let myTweet = fmap (hitSource . head . hits . searchHits) result
414 liftIO $
415 myTweet `shouldBe` Right otherTweet
418 describe "filtering API" $ do
419 it "returns document for composed boolmatch and identity" $ withTestEnv $ do
420 _ <- insertData
421 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
422 <&&> IdentityFilter
423 let search = mkSearch Nothing (Just queryFilter)
424 myTweet <- searchTweet search
425 liftIO $
426 myTweet `shouldBe` Right exampleTweet
428 it "returns document for term filter" $ withTestEnv $ do
429 _ <- insertData
430 let termFilter = TermFilter (Term "user" "bitemyapp") False
431 let search = mkSearch Nothing (Just termFilter)
432 myTweet <- searchTweet search
433 liftIO $
434 myTweet `shouldBe` Right exampleTweet
436 it "returns document for existential filter" $ withTestEnv $ do
437 _ <- insertData
438 let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
439 myTweet <- searchTweet search
440 liftIO $
441 myTweet `shouldBe` Right exampleTweet
443 it "returns document for geo boundingbox filter" $ withTestEnv $ do
444 _ <- insertData
445 let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
446 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
447 let geoFilter = GeoBoundingBoxFilter bbConstraint
448 let search = mkSearch Nothing (Just geoFilter)
449 myTweet <- searchTweet search
450 liftIO $
451 myTweet `shouldBe` Right exampleTweet
453 it "doesn't return document for nonsensical boundingbox filter" $ withTestEnv $ do
454 _ <- insertData
455 let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
456 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
457 let geoFilter = GeoBoundingBoxFilter bbConstraint
458 let search = mkSearch Nothing (Just geoFilter)
459 searchExpectNoResults search
461 it "returns document for geo distance filter" $ withTestEnv $ do
462 _ <- insertData
463 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
464 let distance = Distance 10.0 Miles
465 let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
466 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
467 let search = mkSearch Nothing (Just geoFilter)
468 myTweet <- searchTweet search
469 liftIO $
470 myTweet `shouldBe` Right exampleTweet
472 it "returns document for geo distance range filter" $ withTestEnv $ do
473 _ <- insertData
474 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
475 let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
476 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
477 let search = mkSearch Nothing (Just geoFilter)
478 myTweet <- searchTweet search
479 liftIO $
480 myTweet `shouldBe` Right exampleTweet
482 it "doesn't return document for wild geo distance range filter" $ withTestEnv $ do
483 _ <- insertData
484 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
485 let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
486 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
487 let search = mkSearch Nothing (Just geoFilter)
488 searchExpectNoResults search
490 it "returns document for geo polygon filter" $ withTestEnv $ do
491 _ <- insertData
492 let points = [LatLon 40.0 (-70.00),
493 LatLon 40.0 (-72.00),
494 LatLon 41.0 (-70.00),
495 LatLon 41.0 (-72.00)]
496 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
497 let search = mkSearch Nothing (Just geoFilter)
498 myTweet <- searchTweet search
499 liftIO $
500 myTweet `shouldBe` Right exampleTweet
502 it "doesn't return document for bad geo polygon filter" $ withTestEnv $ do
503 _ <- insertData
504 let points = [LatLon 40.0 (-70.00),
505 LatLon 40.0 (-71.00),
506 LatLon 41.0 (-70.00),
507 LatLon 41.0 (-71.00)]
508 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
509 let search = mkSearch Nothing (Just geoFilter)
510 searchExpectNoResults search
512 it "returns document for ids filter" $ withTestEnv $ do
513 _ <- insertData
514 let filter = IdsFilter (MappingName "tweet") [DocId "1"]
515 let search = mkSearch Nothing (Just filter)
516 myTweet <- searchTweet search
517 liftIO $
518 myTweet `shouldBe` Right exampleTweet
520 it "returns document for Double range filter" $ withTestEnv $ do
521 _ <- insertData
522 let filter = RangeFilter (FieldName "age")
523 (RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))
524 RangeExecutionIndex False
525 let search = mkSearch Nothing (Just filter)
526 myTweet <- searchTweet search
527 liftIO $
528 myTweet `shouldBe` Right exampleTweet
530 it "returns document for UTCTime date filter" $ withTestEnv $ do
531 _ <- insertData
532 let filter = RangeFilter (FieldName "postDate")
533 (RangeDateGtLt
534 (GreaterThanD (UTCTime
535 (ModifiedJulianDay 54000)
536 (secondsToDiffTime 0)))
537 (LessThanD (UTCTime
538 (ModifiedJulianDay 55000)
539 (secondsToDiffTime 11))))
540 RangeExecutionIndex False
541 let search = mkSearch Nothing (Just filter)
542 myTweet <- searchTweet search
543 liftIO $
544 myTweet `shouldBe` Right exampleTweet
546 it "returns document for regexp filter" $ withTestEnv $ do
547 _ <- insertData
548 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
549 AllRegexpFlags (CacheName "test") False (CacheKey "key")
550 let search = mkSearch Nothing (Just filter)
551 myTweet <- searchTweet search
552 liftIO $
553 myTweet `shouldBe` Right exampleTweet
555 it "doesn't return document for non-matching regexp filter" $ withTestEnv $ do
556 _ <- insertData
557 let filter = RegexpFilter (FieldName "user")
558 (Regexp "boy") AllRegexpFlags
559 (CacheName "test") False (CacheKey "key")
560 let search = mkSearch Nothing (Just filter)
561 searchExpectNoResults search
563 it "returns document for query filter, uncached" $ withTestEnv $ do
564 _ <- insertData
565 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) True
566 search = mkSearch Nothing (Just filter)
567 myTweet <- searchTweet search
568 liftIO $ myTweet `shouldBe` Right exampleTweet
570 it "returns document for query filter, cached" $ withTestEnv $ do
571 _ <- insertData
572 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) False
573 search = mkSearch Nothing (Just filter)
574 myTweet <- searchTweet search
575 liftIO $ myTweet `shouldBe` Right exampleTweet
577 describe "Aggregation API" $ do
578 it "returns term aggregation results" $ withTestEnv $ do
579 _ <- insertData
580 let terms = TermsAgg $ mkTermsAggregation "user"
581 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
582 searchExpectAggs search
583 searchValidBucketAgg search "users" toTerms
585 it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
586 _ <- insertData
587 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
588 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
589 searchExpectAggs search
590 searchValidBucketAgg search "users" toTerms
592 it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
593 _ <- insertData
594 searchTermsAggHint [Map, Ordinals]
596 it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do
597 _ <- insertData
598 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
600 it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
601 _ <- insertData
602 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
604 -- Interaction of date serialization and date histogram aggregation is broken.
605 -- it "returns date histogram aggregation results" $ withTestEnv $ do
606 -- _ <- insertData
607 -- let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
608 -- let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
609 -- searchExpectAggs search
610 -- searchValidBucketAgg search "byDate" toDateHistogram
612 -- it "returns date histogram using fractional date" $ withTestEnv $ do
613 -- _ <- insertData
614 -- let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]
615 -- let fractionals = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]
616 -- let intervals = periods ++ fractionals
617 -- let histogram = mkDateHistogram (FieldName "postDate")
618 -- let search interval = mkAggregateSearch Nothing $ mkAggregations "byDate" $ DateHistogramAgg (histogram interval)
619 -- let expect interval = searchExpectAggs (search interval)
620 -- let valid interval = searchValidBucketAgg (search interval) "byDate" toDateHistogram
621 -- forM_ intervals expect
622 -- forM_ intervals valid
624 describe "Highlights API" $ do
626 it "returns highlight from query when there should be one" $ withTestEnv $ do
627 _ <- insertData
628 _ <- insertOther
629 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
630 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
632 let search = mkHighlightSearch (Just query) testHighlight
633 myHighlight <- searchTweetHighlight search
634 liftIO $
635 myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
637 it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
638 _ <- insertData
639 _ <- insertOther
640 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
641 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "user") Nothing]
643 let search = mkHighlightSearch (Just query) testHighlight
644 myHighlight <- searchTweetHighlight search
645 liftIO $
646 myHighlight `shouldBe` Right Nothing
650 describe "ToJSON RegexpFlags" $ do
651 it "generates the correct JSON for AllRegexpFlags" $
652 toJSON AllRegexpFlags `shouldBe` String "ALL"
654 it "generates the correct JSON for NoRegexpFlags" $
655 toJSON NoRegexpFlags `shouldBe` String "NONE"
657 it "generates the correct JSON for SomeRegexpFlags" $
658 let flags = AnyString :| [ Automaton
659 , Complement
660 , Empty
661 , Intersection
662 , Interval ]
663 in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
665 prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
666 let String str = toJSON flags
667 flagStrs = T.splitOn "|" str
668 in noDuplicates flagStrs
670 describe "omitNulls" $ do
671 it "checks that omitNulls drops list elements when it should" $
672 let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))
673 , "test2" .= (toJSON ("some value" :: Text))]
674 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
676 it "checks that omitNulls doesn't drop list elements when it shouldn't" $
677 let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))
678 , "test2" .= (toJSON ("some value" :: Text))]
679 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))
680 , ("test2", String "some value")])
681 it "checks that omitNulls drops non list elements when it should" $
682 let dropped = omitNulls $ [ "test1" .= (toJSON Null)
683 , "test2" .= (toJSON ("some value" :: Text))]
684 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
685 it "checks that omitNulls doesn't drop non list elements when it shouldn't" $
686 let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
687 , "test2" .= (toJSON ("some value" :: Text))]
688 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
689 , ("test2", String "some value")])
690 describe "Monoid (SearchHits a)" $ do
691 prop "abides the monoid laws" $ eq $
692 prop_Monoid (T :: T (SearchHits ()))
694 describe "mkDocVersion" $ do
695 prop "can never construct an out of range docVersion" $ \i ->
696 let res = mkDocVersion i
697 in case res of
698 Nothing -> property True
699 Just dv -> (dv >= minBound) .&&.
700 (dv <= maxBound) .&&.
701 docVersionNumber dv === i
703 describe "Enum DocVersion" $ do
704 it "follows the laws of Enum, Bounded" $ do
705 evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall
706 evaluate (pred minBound :: DocVersion) `shouldThrow` anyErrorCall
707 evaluate (toEnum 0 :: DocVersion) `shouldThrow` anyErrorCall
708 evaluate (toEnum 9200000000000000001 :: DocVersion) `shouldThrow` anyErrorCall
709 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
710 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
711 enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]