git.iko.soy/typeable/bloodhound
on 42500b1 help sign in
typeable/bloodhound/tests/tests.hs
698 lines 29 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
547 it "returns document for regexp filter" $ withTestEnv $ do
548 _ <- insertData
549 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
550 AllRegexpFlags (CacheName "test") False (CacheKey "key")
551 let search = mkSearch Nothing (Just filter)
552 myTweet <- searchTweet search
553 liftIO $
554 myTweet `shouldBe` Right exampleTweet
556 it "doesn't return document for non-matching regexp filter" $ withTestEnv $ do
557 _ <- insertData
558 let filter = RegexpFilter (FieldName "user")
559 (Regexp "boy") AllRegexpFlags
560 (CacheName "test") False (CacheKey "key")
561 let search = mkSearch Nothing (Just filter)
562 searchExpectNoResults search
564 describe "Aggregation API" $ do
565 it "returns term aggregation results" $ withTestEnv $ do
566 _ <- insertData
567 let terms = TermsAgg $ mkTermsAggregation "user"
568 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
569 searchExpectAggs search
570 searchValidBucketAgg search "users" toTerms
572 it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
573 _ <- insertData
574 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
575 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
576 searchExpectAggs search
577 searchValidBucketAgg search "users" toTerms
579 it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
580 _ <- insertData
581 searchTermsAggHint [Map, Ordinals]
583 it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do
584 _ <- insertData
585 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
587 it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
588 _ <- insertData
589 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
591 -- Interaction of date serialization and date histogram aggregation is broken.
592 -- it "returns date histogram aggregation results" $ withTestEnv $ do
593 -- _ <- insertData
594 -- let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
595 -- let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
596 -- searchExpectAggs search
597 -- searchValidBucketAgg search "byDate" toDateHistogram
599 -- it "returns date histogram using fractional date" $ withTestEnv $ do
600 -- _ <- insertData
601 -- let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]
602 -- let fractionals = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]
603 -- let intervals = periods ++ fractionals
604 -- let histogram = mkDateHistogram (FieldName "postDate")
605 -- let search interval = mkAggregateSearch Nothing $ mkAggregations "byDate" $ DateHistogramAgg (histogram interval)
606 -- let expect interval = searchExpectAggs (search interval)
607 -- let valid interval = searchValidBucketAgg (search interval) "byDate" toDateHistogram
608 -- forM_ intervals expect
609 -- forM_ intervals valid
611 describe "Highlights API" $ do
613 it "returns highlight from query when there should be one" $ withTestEnv $ do
614 _ <- insertData
615 _ <- insertOther
616 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
617 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
619 let search = mkHighlightSearch (Just query) testHighlight
620 myHighlight <- searchTweetHighlight search
621 liftIO $
622 myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
624 it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
625 _ <- insertData
626 _ <- insertOther
627 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
628 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "user") Nothing]
630 let search = mkHighlightSearch (Just query) testHighlight
631 myHighlight <- searchTweetHighlight search
632 liftIO $
633 myHighlight `shouldBe` Right Nothing
637 describe "ToJSON RegexpFlags" $ do
638 it "generates the correct JSON for AllRegexpFlags" $
639 toJSON AllRegexpFlags `shouldBe` String "ALL"
641 it "generates the correct JSON for NoRegexpFlags" $
642 toJSON NoRegexpFlags `shouldBe` String "NONE"
644 it "generates the correct JSON for SomeRegexpFlags" $
645 let flags = AnyString :| [ Automaton
646 , Complement
647 , Empty
648 , Intersection
649 , Interval ]
650 in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
652 prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
653 let String str = toJSON flags
654 flagStrs = T.splitOn "|" str
655 in noDuplicates flagStrs
657 describe "omitNulls" $ do
658 it "checks that omitNulls drops list elements when it should" $
659 let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))
660 , "test2" .= (toJSON ("some value" :: Text))]
661 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
663 it "checks that omitNulls doesn't drop list elements when it shouldn't" $
664 let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))
665 , "test2" .= (toJSON ("some value" :: Text))]
666 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))
667 , ("test2", String "some value")])
668 it "checks that omitNulls drops non list elements when it should" $
669 let dropped = omitNulls $ [ "test1" .= (toJSON Null)
670 , "test2" .= (toJSON ("some value" :: Text))]
671 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
672 it "checks that omitNulls doesn't drop non list elements when it shouldn't" $
673 let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
674 , "test2" .= (toJSON ("some value" :: Text))]
675 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
676 , ("test2", String "some value")])
677 describe "Monoid (SearchHits a)" $ do
678 prop "abides the monoid laws" $ eq $
679 prop_Monoid (T :: T (SearchHits ()))
681 describe "mkDocVersion" $ do
682 prop "can never construct an out of range docVersion" $ \i ->
683 let res = mkDocVersion i
684 in case res of
685 Nothing -> property True
686 Just dv -> (dv >= minBound) .&&.
687 (dv <= maxBound) .&&.
688 docVersionNumber dv === i
690 describe "Enum DocVersion" $ do
691 it "follows the laws of Enum, Bounded" $ do
692 evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall
693 evaluate (pred minBound :: DocVersion) `shouldThrow` anyErrorCall
694 evaluate (toEnum 0 :: DocVersion) `shouldThrow` anyErrorCall
695 evaluate (toEnum 9200000000000000001 :: DocVersion) `shouldThrow` anyErrorCall
696 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
697 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
698 enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]