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