git.iko.soy/typeable/bloodhound
on aeson-0.10 help sign in
typeable/bloodhound/tests/tests.hs
861 lines 36 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 qualified Data.Maybe as MY
18import Data.Monoid
19import Data.Text (Text)
20import qualified Data.Text as T
21import Data.Time.Calendar (Day (..))
22import Data.Time.Clock (UTCTime (..),
23 secondsToDiffTime)
24import qualified Data.Vector as V
25import Database.Bloodhound
26import GHC.Generics (Generic)
27import Network.HTTP.Client
28import qualified Network.HTTP.Types.Status as NHTS
29import Prelude hiding (filter)
30import Test.Hspec
31import Test.QuickCheck.Property.Monoid (T (..), eq, prop_Monoid)
33import Test.Hspec.QuickCheck (prop)
34import Test.QuickCheck
36testServer :: Server
37testServer = Server "http://localhost:9200"
38testIndex :: IndexName
39testIndex = IndexName "bloodhound-tests-twitter-1"
40testMapping :: MappingName
41testMapping = MappingName "tweet"
43withTestEnv :: BH IO a -> IO a
44withTestEnv = withBH defaultManagerSettings testServer
46validateStatus :: Response body -> Int -> Expectation
47validateStatus resp expected =
48 (NHTS.statusCode $ responseStatus resp)
49 `shouldBe` (expected :: Int)
51createExampleIndex :: BH IO Reply
52createExampleIndex = createIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) testIndex
53deleteExampleIndex :: BH IO Reply
54deleteExampleIndex = deleteIndex testIndex
56data ServerVersion = ServerVersion Int Int Int deriving (Show, Eq, Ord)
58es14 :: ServerVersion
59es14 = ServerVersion 1 4 0
61es13 :: ServerVersion
62es13 = ServerVersion 1 3 0
64es12 :: ServerVersion
65es12 = ServerVersion 1 2 0
67es11 :: ServerVersion
68es11 = ServerVersion 1 1 0
70es10 :: ServerVersion
71es10 = ServerVersion 1 0 0
73serverBranch :: ServerVersion -> ServerVersion
74serverBranch (ServerVersion majorVer minorVer patchVer) =
75 ServerVersion majorVer minorVer patchVer
77mkServerVersion :: [Int] -> Maybe ServerVersion
78mkServerVersion [majorVer, minorVer, patchVer] =
79 Just (ServerVersion majorVer minorVer patchVer)
80mkServerVersion _ = Nothing
82getServerVersion :: IO (Maybe ServerVersion)
83getServerVersion = liftM extractVersion (withTestEnv getStatus)
84 where
85 version' = T.splitOn "." . number . version
86 toInt = read . T.unpack
87 parseVersion v = map toInt (version' v)
88 extractVersion = join . liftM (mkServerVersion . parseVersion)
90testServerBranch :: IO (Maybe ServerVersion)
91testServerBranch = getServerVersion >>= \v -> return $ liftM serverBranch v
93atleast :: ServerVersion -> IO Bool
94atleast v = testServerBranch >>= \x -> return $ x >= Just (serverBranch v)
96atmost :: ServerVersion -> IO Bool
97atmost v = testServerBranch >>= \x -> return $ x <= Just (serverBranch v)
99is :: ServerVersion -> IO Bool
100is v = testServerBranch >>= \x -> return $ x == Just (serverBranch v)
102when' :: Monad m => m Bool -> m () -> m ()
103when' b f = b >>= \x -> when x f
105data Location = Location { lat :: Double
106 , lon :: Double } deriving (Eq, Generic, Show)
108data Tweet = Tweet { user :: Text
109 , postDate :: UTCTime
110 , message :: Text
111 , age :: Int
112 , location :: Location }
113 deriving (Eq, Generic, Show)
115instance ToJSON Tweet
116instance FromJSON Tweet
117instance ToJSON Location
118instance FromJSON Location
120data ParentMapping = ParentMapping deriving (Eq, Show)
122instance ToJSON ParentMapping where
123 toJSON ParentMapping =
124 object ["parent" .= Null ]
126data ChildMapping = ChildMapping deriving (Eq, Show)
128instance ToJSON ChildMapping where
129 toJSON ChildMapping =
130 object ["child" .=
131 object ["_parent" .= object ["type" .= ("parent" :: Text)]]
132 ]
134data TweetMapping = TweetMapping deriving (Eq, Show)
136instance ToJSON TweetMapping where
137 toJSON TweetMapping =
138 object ["tweet" .=
139 object ["properties" .=
140 object [ "user" .= object ["type" .= ("string" :: Text)]
141 -- Serializing the date as a date is breaking other tests, mysteriously.
142 -- , "postDate" .= object [ "type" .= ("date" :: Text)
143 -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
144 , "message" .= object ["type" .= ("string" :: Text)]
145 , "age" .= object ["type" .= ("integer" :: Text)]
146 , "location" .= object ["type" .= ("geo_point" :: Text)]
147 ]]]
149exampleTweet :: Tweet
150exampleTweet = Tweet { user = "bitemyapp"
151 , postDate = UTCTime
152 (ModifiedJulianDay 55000)
153 (secondsToDiffTime 10)
154 , message = "Use haskell!"
155 , age = 10000
156 , location = Location 40.12 (-71.34) }
158otherTweet :: Tweet
159otherTweet = Tweet { user = "notmyapp"
160 , postDate = UTCTime
161 (ModifiedJulianDay 55000)
162 (secondsToDiffTime 11)
163 , message = "Use haskell!"
164 , age = 1000
165 , location = Location 40.12 (-71.34) }
167resetIndex :: BH IO ()
168resetIndex = do
169 _ <- deleteExampleIndex
170 _ <- createExampleIndex
171 _ <- putMapping testIndex testMapping TweetMapping
172 return ()
174insertData :: BH IO Reply
175insertData = do
176 resetIndex
177 insertData' defaultIndexDocumentSettings
179insertData' :: IndexDocumentSettings -> BH IO Reply
180insertData' ids = do
181 r <- indexDocument testIndex testMapping ids exampleTweet (DocId "1")
182 _ <- refreshIndex testIndex
183 return r
185insertOther :: BH IO ()
186insertOther = do
187 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings otherTweet (DocId "2")
188 _ <- refreshIndex testIndex
189 return ()
191insertWithSpaceInId :: BH IO ()
192insertWithSpaceInId = do
193 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "Hello World")
194 _ <- refreshIndex testIndex
195 return ()
197searchTweet :: Search -> BH IO (Either String Tweet)
198searchTweet search = do
199 result <- searchTweets search
200 let myTweet :: Either String Tweet
201 myTweet = grabFirst result
202 return myTweet
204searchTweets :: Search -> BH IO (Either String (SearchResult Tweet))
205searchTweets search = eitherDecode . responseBody <$> searchByIndex testIndex search
207searchExpectNoResults :: Search -> BH IO ()
208searchExpectNoResults search = do
209 result <- searchTweets search
210 let emptyHits = fmap (hits . searchHits) result
211 liftIO $
212 emptyHits `shouldBe` Right []
214searchExpectAggs :: Search -> BH IO ()
215searchExpectAggs search = do
216 reply <- searchAll search
217 let isEmpty x = return (M.null x)
218 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
219 liftIO $
220 (result >>= aggregations >>= isEmpty) `shouldBe` Just False
222searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) =>
223 Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> BH IO ()
224searchValidBucketAgg search aggKey extractor = do
225 reply <- searchAll search
226 let bucketDocs = docCount . head . buckets
227 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
228 let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)
229 liftIO $
230 count `shouldBe` Just 1
232searchTermsAggHint :: [ExecutionHint] -> BH IO ()
233searchTermsAggHint hints = do
234 let terms hint = TermsAgg $ (mkTermsAggregation "user") { termExecutionHint = Just hint }
235 let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint
236 forM_ hints $ searchExpectAggs . search
237 forM_ hints (\x -> searchValidBucketAgg (search x) "users" toTerms)
239searchTweetHighlight :: Search -> BH IO (Either String (Maybe HitHighlight))
240searchTweetHighlight search = do
241 result <- searchTweets search
242 let myHighlight = fmap (hitHighlight . head . hits . searchHits) result
243 return myHighlight
245searchExpectSource :: Source -> Either String Value -> BH IO ()
246searchExpectSource src expected = do
247 _ <- insertData
248 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
249 let search = (mkSearch (Just query) Nothing) { source = Just src }
250 reply <- searchAll search
251 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Value)
252 let value = grabFirst result
253 liftIO $
254 value `shouldBe` expected
256data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
257instance FromJSON BulkTest
258instance ToJSON BulkTest
260noDuplicates :: Eq a => [a] -> Bool
261noDuplicates xs = nub xs == xs
263instance Arbitrary RegexpFlags where
264 arbitrary = oneof [ pure AllRegexpFlags
265 , pure NoRegexpFlags
266 , SomeRegexpFlags <$> arbitrary
267 ]
269instance Arbitrary a => Arbitrary (NonEmpty a) where
270 arbitrary = liftA2 (:|) arbitrary arbitrary
272instance Arbitrary RegexpFlag where
273 arbitrary = oneof [ pure AnyString
274 , pure Automaton
275 , pure Complement
276 , pure Empty
277 , pure Intersection
278 , pure Interval
279 ]
281arbitraryScore :: Gen Score
282arbitraryScore = fmap getPositive <$> arbitrary
284instance Arbitrary Text where
285 arbitrary = T.pack <$> arbitrary
287instance (Arbitrary k, Arbitrary v, Ord k) => Arbitrary (M.Map k v) where
288 arbitrary = M.fromList <$> arbitrary
290instance Arbitrary IndexName where
291 arbitrary = IndexName <$> arbitrary
293instance Arbitrary MappingName where
294 arbitrary = MappingName <$> arbitrary
296instance Arbitrary DocId where
297 arbitrary = DocId <$> arbitrary
299instance Arbitrary a => Arbitrary (Hit a) where
300 arbitrary = Hit <$> arbitrary
301 <*> arbitrary
302 <*> arbitrary
303 <*> arbitraryScore
304 <*> arbitrary
305 <*> arbitrary
308instance Arbitrary a => Arbitrary (SearchHits a) where
309 arbitrary = sized $ \n -> resize (n `div` 2) $ do
310 tot <- getPositive <$> arbitrary
311 score <- arbitraryScore
312 hs <- arbitrary
313 return $ SearchHits tot score hs
315getSource :: EsResult a -> Maybe a
316getSource = fmap _source . foundResult
318-- grabFirst :: Either String (SearchResult a) -> Either String a
319grabFirst r =
320 case fmap (hitSource . head . hits . searchHits) r of
321 (Left e) -> Left e
322 (Right Nothing) -> Left "Source was missing"
323 (Right (Just x)) -> Right x
325main :: IO ()
326main = hspec $ do
328 describe "index create/delete API" $ do
329 it "creates and then deletes the requested index" $ withTestEnv $ do
330 -- priming state.
331 _ <- deleteExampleIndex
332 resp <- createExampleIndex
333 deleteResp <- deleteExampleIndex
334 liftIO $ do
335 validateStatus resp 200
336 validateStatus deleteResp 200
339 describe "document API" $ do
340 it "indexes, gets, and then deletes the generated document" $ withTestEnv $ do
341 _ <- insertData
342 docInserted <- getDocument testIndex testMapping (DocId "1")
343 let newTweet = eitherDecode
344 (responseBody docInserted) :: Either String (EsResult Tweet)
345 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))
347 it "indexes, gets, and then deletes the generated document with a DocId containing a space" $ withTestEnv $ do
348 _ <- insertWithSpaceInId
349 docInserted <- getDocument testIndex testMapping (DocId "Hello World")
350 let newTweet = eitherDecode
351 (responseBody docInserted) :: Either String (EsResult Tweet)
352 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))
354 it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do
355 doc <- getDocument testIndex testMapping (DocId "bogus")
356 let noTweet = eitherDecode
357 (responseBody doc) :: Either String (EsResult Tweet)
358 liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing
360 it "can use optimistic concurrency control" $ withTestEnv $ do
361 let ev = ExternalDocVersion minBound
362 let cfg = defaultIndexDocumentSettings { idsVersionControl = ExternalGT ev }
363 resetIndex
364 res <- insertData' cfg
365 liftIO $ isCreated res `shouldBe` True
366 res' <- insertData' cfg
367 liftIO $ isVersionConflict res' `shouldBe` True
369 it "indexes two documents in a parent/child relationship and checks that the child exists" $ withTestEnv $ do
370 resetIndex
371 _ <- putMapping testIndex (MappingName "parent") ParentMapping
372 _ <- putMapping testIndex (MappingName "child") ChildMapping
373 _ <- indexDocument testIndex (MappingName "parent") defaultIndexDocumentSettings exampleTweet (DocId "1")
374 let parent = (Just . DocumentParent . DocId) "1"
375 ids = IndexDocumentSettings NoVersionControl parent
376 _ <- indexDocument testIndex (MappingName "child") ids otherTweet (DocId "2")
377 _ <- refreshIndex testIndex
378 exists <- documentExists testIndex (MappingName "child") parent (DocId "2")
379 liftIO $ exists `shouldBe` True
381 describe "template API" $ do
382 it "can create a template" $ withTestEnv $ do
383 let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
384 resp <- putTemplate idxTpl (TemplateName "tweet-tpl")
385 liftIO $ validateStatus resp 200
387 it "can detect if a template exists" $ withTestEnv $ do
388 exists <- templateExists (TemplateName "tweet-tpl")
389 liftIO $ exists `shouldBe` True
391 it "can delete a template" $ withTestEnv $ do
392 resp <- deleteTemplate (TemplateName "tweet-tpl")
393 liftIO $ validateStatus resp 200
395 it "can detect if a template doesn't exist" $ withTestEnv $ do
396 exists <- templateExists (TemplateName "tweet-tpl")
397 liftIO $ exists `shouldBe` False
399 describe "bulk API" $ do
400 it "inserts all documents we request" $ withTestEnv $ do
401 _ <- insertData
402 let firstTest = BulkTest "blah"
403 let secondTest = BulkTest "bloo"
404 let firstDoc = BulkIndex testIndex
405 testMapping (DocId "2") (toJSON firstTest)
406 let secondDoc = BulkCreate testIndex
407 testMapping (DocId "3") (toJSON secondTest)
408 let stream = V.fromList [firstDoc, secondDoc]
409 _ <- bulk stream
410 _ <- refreshIndex testIndex
411 fDoc <- getDocument testIndex testMapping (DocId "2")
412 sDoc <- getDocument testIndex testMapping (DocId "3")
413 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
414 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
415 liftIO $ do
416 fmap getSource maybeFirst `shouldBe` Right (Just firstTest)
417 fmap getSource maybeSecond `shouldBe` Right (Just secondTest)
420 describe "query API" $ do
421 it "returns document for term query and identity filter" $ withTestEnv $ do
422 _ <- insertData
423 let query = TermQuery (Term "user" "bitemyapp") Nothing
424 let filter = IdentityFilter <&&> IdentityFilter
425 let search = mkSearch (Just query) (Just filter)
426 myTweet <- searchTweet search
427 liftIO $
428 myTweet `shouldBe` Right exampleTweet
430 it "returns document for terms query and identity filter" $ withTestEnv $ do
431 _ <- insertData
432 let query = TermsQuery (NE.fromList [(Term "user" "bitemyapp")])
433 let filter = IdentityFilter <&&> IdentityFilter
434 let search = mkSearch (Just query) (Just filter)
435 myTweet <- searchTweet search
436 liftIO $
437 myTweet `shouldBe` Right exampleTweet
439 it "returns document for match query" $ withTestEnv $ do
440 _ <- insertData
441 let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
442 let search = mkSearch (Just query) Nothing
443 myTweet <- searchTweet search
444 liftIO $
445 myTweet `shouldBe` Right exampleTweet
447 it "returns document for multi-match query" $ withTestEnv $ do
448 _ <- insertData
449 let flds = [FieldName "user", FieldName "message"]
450 let query = QueryMultiMatchQuery $ mkMultiMatchQuery flds (QueryString "bitemyapp")
451 let search = mkSearch (Just query) Nothing
452 myTweet <- searchTweet search
453 liftIO $
454 myTweet `shouldBe` Right exampleTweet
456 it "returns document for bool query" $ withTestEnv $ do
457 _ <- insertData
458 let innerQuery = QueryMatchQuery $
459 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
460 let query = QueryBoolQuery $
461 mkBoolQuery [innerQuery] [] []
462 let search = mkSearch (Just query) Nothing
463 myTweet <- searchTweet search
464 liftIO $
465 myTweet `shouldBe` Right exampleTweet
467 it "returns document for boosting query" $ withTestEnv $ do
468 _ <- insertData
469 let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
470 let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
471 let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
472 let search = mkSearch (Just query) Nothing
473 myTweet <- searchTweet search
474 liftIO $
475 myTweet `shouldBe` Right exampleTweet
477 it "returns document for common terms query" $ withTestEnv $ do
478 _ <- insertData
479 let query = QueryCommonTermsQuery $
480 CommonTermsQuery (FieldName "user")
481 (QueryString "bitemyapp")
482 (CutoffFrequency 0.0001)
483 Or Or Nothing Nothing Nothing Nothing
484 let search = mkSearch (Just query) Nothing
485 myTweet <- searchTweet search
486 liftIO $
487 myTweet `shouldBe` Right exampleTweet
490 describe "sorting" $ do
491 it "returns documents in the right order" $ withTestEnv $ do
492 _ <- insertData
493 _ <- insertOther
494 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
495 let search = Search Nothing
496 (Just IdentityFilter) (Just [sortSpec]) Nothing Nothing
497 False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
498 result <- searchTweets search
499 let myTweet = grabFirst result
500 liftIO $
501 myTweet `shouldBe` Right otherTweet
504 describe "filtering API" $ do
505 it "returns document for composed boolmatch and identity" $ withTestEnv $ do
506 _ <- insertData
507 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
508 <&&> IdentityFilter
509 let search = mkSearch Nothing (Just queryFilter)
510 myTweet <- searchTweet search
511 liftIO $
512 myTweet `shouldBe` Right exampleTweet
514 it "returns document for term filter" $ withTestEnv $ do
515 _ <- insertData
516 let termFilter = TermFilter (Term "user" "bitemyapp") False
517 let search = mkSearch Nothing (Just termFilter)
518 myTweet <- searchTweet search
519 liftIO $
520 myTweet `shouldBe` Right exampleTweet
522 it "returns document for existential filter" $ withTestEnv $ do
523 _ <- insertData
524 let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
525 myTweet <- searchTweet search
526 liftIO $
527 myTweet `shouldBe` Right exampleTweet
529 it "returns document for geo boundingbox filter" $ withTestEnv $ do
530 _ <- insertData
531 let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
532 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
533 let geoFilter = GeoBoundingBoxFilter bbConstraint
534 let search = mkSearch Nothing (Just geoFilter)
535 myTweet <- searchTweet search
536 liftIO $
537 myTweet `shouldBe` Right exampleTweet
539 it "doesn't return document for nonsensical boundingbox filter" $ withTestEnv $ do
540 _ <- insertData
541 let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
542 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
543 let geoFilter = GeoBoundingBoxFilter bbConstraint
544 let search = mkSearch Nothing (Just geoFilter)
545 searchExpectNoResults search
547 it "returns document for geo distance filter" $ withTestEnv $ do
548 _ <- insertData
549 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
550 let distance = Distance 10.0 Miles
551 let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
552 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
553 let search = mkSearch Nothing (Just geoFilter)
554 myTweet <- searchTweet search
555 liftIO $
556 myTweet `shouldBe` Right exampleTweet
558 it "returns document for geo distance range filter" $ withTestEnv $ do
559 _ <- insertData
560 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
561 let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
562 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
563 let search = mkSearch Nothing (Just geoFilter)
564 myTweet <- searchTweet search
565 liftIO $
566 myTweet `shouldBe` Right exampleTweet
568 it "doesn't return document for wild geo distance range filter" $ withTestEnv $ do
569 _ <- insertData
570 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
571 let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
572 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
573 let search = mkSearch Nothing (Just geoFilter)
574 searchExpectNoResults search
576 it "returns document for geo polygon filter" $ withTestEnv $ do
577 _ <- insertData
578 let points = [LatLon 40.0 (-70.00),
579 LatLon 40.0 (-72.00),
580 LatLon 41.0 (-70.00),
581 LatLon 41.0 (-72.00)]
582 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
583 let search = mkSearch Nothing (Just geoFilter)
584 myTweet <- searchTweet search
585 liftIO $
586 myTweet `shouldBe` Right exampleTweet
588 it "doesn't return document for bad geo polygon filter" $ withTestEnv $ do
589 _ <- insertData
590 let points = [LatLon 40.0 (-70.00),
591 LatLon 40.0 (-71.00),
592 LatLon 41.0 (-70.00),
593 LatLon 41.0 (-71.00)]
594 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
595 let search = mkSearch Nothing (Just geoFilter)
596 searchExpectNoResults search
598 it "returns document for ids filter" $ withTestEnv $ do
599 _ <- insertData
600 let filter = IdsFilter (MappingName "tweet") [DocId "1"]
601 let search = mkSearch Nothing (Just filter)
602 myTweet <- searchTweet search
603 liftIO $
604 myTweet `shouldBe` Right exampleTweet
606 it "returns document for Double range filter" $ withTestEnv $ do
607 _ <- insertData
608 let filter = RangeFilter (FieldName "age")
609 (RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))
610 RangeExecutionIndex False
611 let search = mkSearch Nothing (Just filter)
612 myTweet <- searchTweet search
613 liftIO $
614 myTweet `shouldBe` Right exampleTweet
616 it "returns document for UTCTime date filter" $ withTestEnv $ do
617 _ <- insertData
618 let filter = RangeFilter (FieldName "postDate")
619 (RangeDateGtLt
620 (GreaterThanD (UTCTime
621 (ModifiedJulianDay 54000)
622 (secondsToDiffTime 0)))
623 (LessThanD (UTCTime
624 (ModifiedJulianDay 55000)
625 (secondsToDiffTime 11))))
626 RangeExecutionIndex False
627 let search = mkSearch Nothing (Just filter)
628 myTweet <- searchTweet search
629 liftIO $
630 myTweet `shouldBe` Right exampleTweet
632 it "returns document for regexp filter" $ withTestEnv $ do
633 _ <- insertData
634 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
635 AllRegexpFlags (CacheName "test") False (CacheKey "key")
636 let search = mkSearch Nothing (Just filter)
637 myTweet <- searchTweet search
638 liftIO $
639 myTweet `shouldBe` Right exampleTweet
641 it "doesn't return document for non-matching regexp filter" $ withTestEnv $ do
642 _ <- insertData
643 let filter = RegexpFilter (FieldName "user")
644 (Regexp "boy") AllRegexpFlags
645 (CacheName "test") False (CacheKey "key")
646 let search = mkSearch Nothing (Just filter)
647 searchExpectNoResults search
649 it "returns document for query filter, uncached" $ withTestEnv $ do
650 _ <- insertData
651 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) True
652 search = mkSearch Nothing (Just filter)
653 myTweet <- searchTweet search
654 liftIO $ myTweet `shouldBe` Right exampleTweet
656 it "returns document for query filter, cached" $ withTestEnv $ do
657 _ <- insertData
658 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) False
659 search = mkSearch Nothing (Just filter)
660 myTweet <- searchTweet search
661 liftIO $ myTweet `shouldBe` Right exampleTweet
663 describe "Aggregation API" $ do
664 it "returns term aggregation results" $ withTestEnv $ do
665 _ <- insertData
666 let terms = TermsAgg $ mkTermsAggregation "user"
667 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
668 searchExpectAggs search
669 searchValidBucketAgg search "users" toTerms
671 it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
672 _ <- insertData
673 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
674 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
675 searchExpectAggs search
676 searchValidBucketAgg search "users" toTerms
678 it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
679 _ <- insertData
680 searchTermsAggHint [Map, Ordinals]
682 it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do
683 _ <- insertData
684 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
686 it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
687 _ <- insertData
688 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
691 it "can execute value_count aggregations" $ withTestEnv $ do
692 _ <- insertData
693 _ <- insertOther
694 let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>
695 mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))
696 let search = mkAggregateSearch Nothing ags
697 let docCountPair k n = (k, object ["value" .= Number n])
698 res <- searchTweets search
699 liftIO $
700 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2
701 , docCountPair "bogus_count" 0
702 ]))
704 it "can execute filter aggregations" $ withTestEnv $ do
705 _ <- insertData
706 _ <- insertOther
707 let ags = mkAggregations "bitemyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "bitemyapp") defaultCache) Nothing)) <>
708 mkAggregations "notmyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "notmyapp") defaultCache) Nothing))
709 let search = mkAggregateSearch Nothing ags
710 let docCountPair k n = (k, object ["doc_count" .= Number n])
711 res <- searchTweets search
712 liftIO $
713 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "bitemyapps" 1
714 , docCountPair "notmyapps" 1
715 ]))
717 it "returns date histogram aggregation results" $ withTestEnv $ do
718 _ <- insertData
719 let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
720 let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
721 searchExpectAggs search
722 searchValidBucketAgg search "byDate" toDateHistogram
724 it "returns date histogram using fractional date" $ withTestEnv $ do
725 _ <- insertData
726 let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]
727 let fractionals = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]
728 let intervals = periods ++ fractionals
729 let histogram = mkDateHistogram (FieldName "postDate")
730 let search interval = mkAggregateSearch Nothing $ mkAggregations "byDate" $ DateHistogramAgg (histogram interval)
731 let expect interval = searchExpectAggs (search interval)
732 let valid interval = searchValidBucketAgg (search interval) "byDate" toDateHistogram
733 forM_ intervals expect
734 forM_ intervals valid
736 describe "Highlights API" $ do
738 it "returns highlight from query when there should be one" $ withTestEnv $ do
739 _ <- insertData
740 _ <- insertOther
741 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
742 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
744 let search = mkHighlightSearch (Just query) testHighlight
745 myHighlight <- searchTweetHighlight search
746 liftIO $
747 myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
749 it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
750 _ <- insertData
751 _ <- insertOther
752 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
753 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "user") Nothing]
755 let search = mkHighlightSearch (Just query) testHighlight
756 myHighlight <- searchTweetHighlight search
757 liftIO $
758 myHighlight `shouldBe` Right Nothing
760 describe "Source filtering" $ do
762 it "doesn't include source when sources are disabled" $ withTestEnv $ do
763 searchExpectSource
764 NoSource
765 (Left "Source was missing")
767 it "includes a source" $ withTestEnv $ do
768 searchExpectSource
769 (SourcePatterns (PopPattern (Pattern "message")))
770 (Right (Object (HM.fromList [("message", String "Use haskell!")])))
772 it "includes sources" $ withTestEnv $ do
773 searchExpectSource
774 (SourcePatterns (PopPatterns [Pattern "user", Pattern "message"]))
775 (Right (Object (HM.fromList [("user",String "bitemyapp"),("message", String "Use haskell!")])))
777 it "includes source patterns" $ withTestEnv $ do
778 searchExpectSource
779 (SourcePatterns (PopPattern (Pattern "*ge")))
780 (Right (Object (HM.fromList [("age", Number 10000),("message", String "Use haskell!")])))
782 it "excludes source patterns" $ withTestEnv $ do
783 searchExpectSource
784 (SourceIncludeExclude (Include []) (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate"]))
785 (Right (Object (HM.fromList [("user",String "bitemyapp")])))
787 describe "ToJSON RegexpFlags" $ do
788 it "generates the correct JSON for AllRegexpFlags" $
789 toJSON AllRegexpFlags `shouldBe` String "ALL"
791 it "generates the correct JSON for NoRegexpFlags" $
792 toJSON NoRegexpFlags `shouldBe` String "NONE"
794 it "generates the correct JSON for SomeRegexpFlags" $
795 let flags = AnyString :| [ Automaton
796 , Complement
797 , Empty
798 , Intersection
799 , Interval ]
800 in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
802 prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
803 let String str = toJSON flags
804 flagStrs = T.splitOn "|" str
805 in noDuplicates flagStrs
807 describe "omitNulls" $ do
808 it "checks that omitNulls drops list elements when it should" $
809 let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))
810 , "test2" .= (toJSON ("some value" :: Text))]
811 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
813 it "checks that omitNulls doesn't drop list elements when it shouldn't" $
814 let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))
815 , "test2" .= (toJSON ("some value" :: Text))]
816 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))
817 , ("test2", String "some value")])
818 it "checks that omitNulls drops non list elements when it should" $
819 let dropped = omitNulls $ [ "test1" .= (toJSON Null)
820 , "test2" .= (toJSON ("some value" :: Text))]
821 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
822 it "checks that omitNulls doesn't drop non list elements when it shouldn't" $
823 let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
824 , "test2" .= (toJSON ("some value" :: Text))]
825 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
826 , ("test2", String "some value")])
827 describe "Monoid (SearchHits a)" $ do
828 prop "abides the monoid laws" $ eq $
829 prop_Monoid (T :: T (SearchHits ()))
831 describe "mkDocVersion" $ do
832 prop "can never construct an out of range docVersion" $ \i ->
833 let res = mkDocVersion i
834 in case res of
835 Nothing -> property True
836 Just dv -> (dv >= minBound) .&&.
837 (dv <= maxBound) .&&.
838 docVersionNumber dv === i
840 describe "Enum DocVersion" $ do
841 it "follows the laws of Enum, Bounded" $ do
842 evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall
843 evaluate (pred minBound :: DocVersion) `shouldThrow` anyErrorCall
844 evaluate (toEnum 0 :: DocVersion) `shouldThrow` anyErrorCall
845 evaluate (toEnum 9200000000000000001 :: DocVersion) `shouldThrow` anyErrorCall
846 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
847 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
848 enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]
850 describe "scan&scroll API" $ do
851 it "returns documents using the scan&scroll API" $ withTestEnv $ do
852 _ <- insertData
853 _ <- insertOther
854 let search = (mkSearch (Just $ MatchAllQuery Nothing) Nothing) { size = (Size 1) }
855 regular_search <- searchTweet search
856 scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet]
857 let scan_search = map hitSource scan_search'
858 liftIO $
859 regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored
860 liftIO $
861 scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]