git.iko.soy/typeable/bloodhound
on 5395a0b help sign in
typeable/bloodhound/tests/tests.hs
1489 lines 64 kB history raw
1{-# LANGUAGE DefaultSignatures #-}
2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5{-# LANGUAGE OverloadedStrings #-}
6{-# LANGUAGE ScopedTypeVariables #-}
7{-# LANGUAGE TemplateHaskell #-}
8{-# LANGUAGE TypeOperators #-}
9{-# OPTIONS_GHC -fno-warn-orphans #-}
10module Main where
12import Control.Applicative
13import Control.Error
14import Control.Exception
15import Control.Monad
16import Control.Monad.Reader
17import Data.Aeson
18import Data.Aeson.Types (parseEither)
19import qualified Data.ByteString.Lazy.Char8 as BL8
20import Data.DeriveTH
21import qualified Data.HashMap.Strict as HM
22import Data.List (nub)
23import qualified Data.List as L
24import Data.List.NonEmpty (NonEmpty (..))
25import qualified Data.List.NonEmpty as NE
26import qualified Data.Map.Strict as M
27import Data.Monoid
28import Data.Proxy
29import Data.Text (Text)
30import qualified Data.Text as T
31import Data.Time.Calendar (Day (..), fromGregorian)
32import Data.Time.Clock (NominalDiffTime, UTCTime (..),
33 secondsToDiffTime)
34import Data.Typeable
35import qualified Data.Vector as V
36import Database.Bloodhound
37import GHC.Generics as G
38import Network.HTTP.Client hiding (Proxy)
39import qualified Network.HTTP.Types.Status as NHTS
40import Prelude hiding (filter)
41import Test.Hspec
42import Test.QuickCheck.Property.Monoid (T (..), eq, prop_Monoid)
44import Test.Hspec.QuickCheck (prop)
45import Test.QuickCheck
47testServer :: Server
48testServer = Server "http://localhost:9200"
49testIndex :: IndexName
50testIndex = IndexName "bloodhound-tests-twitter-1"
51testMapping :: MappingName
52testMapping = MappingName "tweet"
54withTestEnv :: BH IO a -> IO a
55withTestEnv = withBH defaultManagerSettings testServer
57validateStatus :: Response body -> Int -> Expectation
58validateStatus resp expected =
59 (NHTS.statusCode $ responseStatus resp)
60 `shouldBe` (expected :: Int)
62createExampleIndex :: BH IO Reply
63createExampleIndex = createIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) testIndex
64deleteExampleIndex :: BH IO Reply
65deleteExampleIndex = deleteIndex testIndex
67data ServerVersion = ServerVersion Int Int Int deriving (Show, Eq, Ord)
69es14 :: ServerVersion
70es14 = ServerVersion 1 4 0
72es13 :: ServerVersion
73es13 = ServerVersion 1 3 0
75es12 :: ServerVersion
76es12 = ServerVersion 1 2 0
78es11 :: ServerVersion
79es11 = ServerVersion 1 1 0
81es10 :: ServerVersion
82es10 = ServerVersion 1 0 0
84serverBranch :: ServerVersion -> ServerVersion
85serverBranch (ServerVersion majorVer minorVer patchVer) =
86 ServerVersion majorVer minorVer patchVer
88mkServerVersion :: [Int] -> Maybe ServerVersion
89mkServerVersion [majorVer, minorVer, patchVer] =
90 Just (ServerVersion majorVer minorVer patchVer)
91mkServerVersion _ = Nothing
93getServerVersion :: IO (Maybe ServerVersion)
94getServerVersion = liftM extractVersion (withTestEnv getStatus)
95 where
96 version' = T.splitOn "." . number . version
97 toInt = read . T.unpack
98 parseVersion v = map toInt (version' v)
99 extractVersion = join . liftM (mkServerVersion . parseVersion)
101testServerBranch :: IO (Maybe ServerVersion)
102testServerBranch = getServerVersion >>= \v -> return $ liftM serverBranch v
104atleast :: ServerVersion -> IO Bool
105atleast v = testServerBranch >>= \x -> return $ x >= Just (serverBranch v)
107atmost :: ServerVersion -> IO Bool
108atmost v = testServerBranch >>= \x -> return $ x <= Just (serverBranch v)
110is :: ServerVersion -> IO Bool
111is v = testServerBranch >>= \x -> return $ x == Just (serverBranch v)
113when' :: Monad m => m Bool -> m () -> m ()
114when' b f = b >>= \x -> when x f
116(==~) :: (ApproxEq a, Show a) => a -> a -> Property
117a ==~ b = counterexample (show a ++ " !=~ " ++ show b) (a =~ b)
119propJSON :: forall a. (Arbitrary a, ToJSON a, FromJSON a, Show a, ApproxEq a, Typeable a) => Proxy a -> Spec
120propJSON _ = prop testName $ \(a :: a) ->
121 let jsonStr = "via " <> BL8.unpack (encode a)
122 in counterexample jsonStr (parseEither parseJSON (toJSON a) ==~ Right a)
123 where testName = show ty <> " FromJSON/ToJSON roundtrips"
124 ty = typeOf (undefined :: a)
126data Location = Location { lat :: Double
127 , lon :: Double } deriving (Eq, Generic, Show)
129data Tweet = Tweet { user :: Text
130 , postDate :: UTCTime
131 , message :: Text
132 , age :: Int
133 , location :: Location }
134 deriving (Eq, Generic, Show)
136instance ToJSON Tweet where
137 toJSON = genericToJSON defaultOptions
138instance FromJSON Tweet where
139 parseJSON = genericParseJSON defaultOptions
140instance ToJSON Location where
141 toJSON = genericToJSON defaultOptions
142instance FromJSON Location where
143 parseJSON = genericParseJSON defaultOptions
145data ParentMapping = ParentMapping deriving (Eq, Show)
147instance ToJSON ParentMapping where
148 toJSON ParentMapping =
149 object ["parent" .= Null ]
151data ChildMapping = ChildMapping deriving (Eq, Show)
153instance ToJSON ChildMapping where
154 toJSON ChildMapping =
155 object ["child" .=
156 object ["_parent" .= object ["type" .= ("parent" :: Text)]]
157 ]
159data TweetMapping = TweetMapping deriving (Eq, Show)
161instance ToJSON TweetMapping where
162 toJSON TweetMapping =
163 object ["tweet" .=
164 object ["properties" .=
165 object [ "user" .= object ["type" .= ("string" :: Text)]
166 -- Serializing the date as a date is breaking other tests, mysteriously.
167 -- , "postDate" .= object [ "type" .= ("date" :: Text)
168 -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
169 , "message" .= object ["type" .= ("string" :: Text)]
170 , "age" .= object ["type" .= ("integer" :: Text)]
171 , "location" .= object ["type" .= ("geo_point" :: Text)]
172 ]]]
174exampleTweet :: Tweet
175exampleTweet = Tweet { user = "bitemyapp"
176 , postDate = UTCTime
177 (ModifiedJulianDay 55000)
178 (secondsToDiffTime 10)
179 , message = "Use haskell!"
180 , age = 10000
181 , location = Location 40.12 (-71.34) }
183otherTweet :: Tweet
184otherTweet = Tweet { user = "notmyapp"
185 , postDate = UTCTime
186 (ModifiedJulianDay 55000)
187 (secondsToDiffTime 11)
188 , message = "Use haskell!"
189 , age = 1000
190 , location = Location 40.12 (-71.34) }
192resetIndex :: BH IO ()
193resetIndex = do
194 _ <- deleteExampleIndex
195 _ <- createExampleIndex
196 _ <- putMapping testIndex testMapping TweetMapping
197 return ()
199insertData :: BH IO Reply
200insertData = do
201 resetIndex
202 insertData' defaultIndexDocumentSettings
204insertData' :: IndexDocumentSettings -> BH IO Reply
205insertData' ids = do
206 r <- indexDocument testIndex testMapping ids exampleTweet (DocId "1")
207 _ <- refreshIndex testIndex
208 return r
210insertOther :: BH IO ()
211insertOther = do
212 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings otherTweet (DocId "2")
213 _ <- refreshIndex testIndex
214 return ()
216insertWithSpaceInId :: BH IO ()
217insertWithSpaceInId = do
218 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "Hello World")
219 _ <- refreshIndex testIndex
220 return ()
222searchTweet :: Search -> BH IO (Either EsError Tweet)
223searchTweet search = do
224 result <- searchTweets search
225 let myTweet :: Either EsError Tweet
226 myTweet = grabFirst result
227 return myTweet
229searchTweets :: Search -> BH IO (Either EsError (SearchResult Tweet))
230searchTweets search = parseEsResponse =<< searchByIndex testIndex search
232searchExpectNoResults :: Search -> BH IO ()
233searchExpectNoResults search = do
234 result <- searchTweets search
235 let emptyHits = fmap (hits . searchHits) result
236 liftIO $
237 emptyHits `shouldBe` Right []
239searchExpectAggs :: Search -> BH IO ()
240searchExpectAggs search = do
241 reply <- searchAll search
242 let isEmpty x = return (M.null x)
243 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
244 liftIO $
245 (result >>= aggregations >>= isEmpty) `shouldBe` Just False
247searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) =>
248 Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> BH IO ()
249searchValidBucketAgg search aggKey extractor = do
250 reply <- searchAll search
251 let bucketDocs = docCount . head . buckets
252 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
253 let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)
254 liftIO $
255 count `shouldBe` Just 1
257searchTermsAggHint :: [ExecutionHint] -> BH IO ()
258searchTermsAggHint hints = do
259 let terms hint = TermsAgg $ (mkTermsAggregation "user") { termExecutionHint = Just hint }
260 let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint
261 forM_ hints $ searchExpectAggs . search
262 forM_ hints (\x -> searchValidBucketAgg (search x) "users" toTerms)
264searchTweetHighlight :: Search -> BH IO (Either EsError (Maybe HitHighlight))
265searchTweetHighlight search = do
266 result <- searchTweets search
267 let myHighlight = fmap (hitHighlight . head . hits . searchHits) result
268 return myHighlight
270searchExpectSource :: Source -> Either EsError Value -> BH IO ()
271searchExpectSource src expected = do
272 _ <- insertData
273 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
274 let search = (mkSearch (Just query) Nothing) { source = Just src }
275 reply <- searchAll search
276 result <- parseEsResponse reply-- :: Either EsError (SearchResult Value)
277 let value = grabFirst result
278 liftIO $
279 value `shouldBe` expected
281data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
282instance FromJSON BulkTest where
283 parseJSON = genericParseJSON defaultOptions
284instance ToJSON BulkTest where
285 toJSON = genericToJSON defaultOptions
287class GApproxEq f where
288 gApproxEq :: f a -> f a -> Bool
290-- | Unit type
291instance GApproxEq U1 where
292 gApproxEq U1 U1 = True
294-- | Sum type, ensure same constructors, recurse
295instance (GApproxEq a, GApproxEq b) => GApproxEq (a :+: b) where
296 gApproxEq (L1 a) (L1 b) = gApproxEq a b
297 gApproxEq (R1 a) (R1 b) = gApproxEq a b
298 gApproxEq _ _ = False
300-- | Product type, ensure each field is approx eq
301instance (GApproxEq a, GApproxEq b) => GApproxEq (a :*: b) where
302 gApproxEq (a1 :*: b1) (a2 :*: b2) = gApproxEq a1 a2 && gApproxEq b1 b2
304-- | Value type, actually check the values for approx equality
305instance (ApproxEq a) => GApproxEq (K1 i a) where
306 gApproxEq (K1 a) (K1 b) = a =~ b
308instance (GApproxEq f) => GApproxEq (M1 i t f) where
309 gApproxEq (M1 a) (M1 b) = gApproxEq a b
311-- | Typeclass for "equal where it matters". Use this to specify
312-- less-strict equivalence for things such as lists that can wind up
313-- in an unpredictable order
314class ApproxEq a where
315 (=~) :: a -> a -> Bool
316 default (=~) :: (Generic a, GApproxEq (Rep a)) => a -> a -> Bool
317 a =~ b = gApproxEq (G.from a) (G.from b)
319instance ApproxEq NominalDiffTime where (=~) = (==)
320instance ApproxEq UTCTime where (=~) = (==)
321instance ApproxEq Text where (=~) = (==)
322instance ApproxEq Bool where (=~) = (==)
323instance ApproxEq Int where (=~) = (==)
324instance ApproxEq Double where (=~) = (==)
325instance ApproxEq a => ApproxEq (NonEmpty a)
326instance ApproxEq a => ApproxEq (Maybe a)
327instance ApproxEq GeoPoint
328instance ApproxEq Regexp
329instance ApproxEq RangeValue
330instance ApproxEq LessThan
331instance ApproxEq LessThanEq
332instance ApproxEq LessThanD
333instance ApproxEq LessThanEqD
334instance ApproxEq GreaterThan
335instance ApproxEq GreaterThanEq
336instance ApproxEq GreaterThanD
337instance ApproxEq GreaterThanEqD
338instance ApproxEq MinimumMatchHighLow
339instance ApproxEq RegexpFlag
340instance ApproxEq RegexpFlags
341instance ApproxEq NullValue
342instance ApproxEq Version
343instance ApproxEq DistanceRange
344instance ApproxEq IndexName
345instance ApproxEq MappingName
346instance ApproxEq DocId
347instance ApproxEq IndexAliasRouting
348instance ApproxEq RoutingValue
349instance ApproxEq ShardCount
350instance ApproxEq ReplicaCount
351instance ApproxEq TemplateName
352instance ApproxEq TemplatePattern
353instance ApproxEq QueryString
354instance ApproxEq FieldName
355instance ApproxEq CacheName
356instance ApproxEq CacheKey
357instance ApproxEq Existence
358instance ApproxEq CutoffFrequency
359instance ApproxEq Analyzer
360instance ApproxEq Lenient
361instance ApproxEq Tiebreaker
362instance ApproxEq Boost
363instance ApproxEq BoostTerms
364instance ApproxEq MaxExpansions
365instance ApproxEq MinimumMatch
366instance ApproxEq DisableCoord
367instance ApproxEq IgnoreTermFrequency
368instance ApproxEq MinimumTermFrequency
369instance ApproxEq MaxQueryTerms
370instance ApproxEq Fuzziness
371instance ApproxEq PrefixLength
372instance ApproxEq TypeName
373instance ApproxEq PercentMatch
374instance ApproxEq StopWord
375instance ApproxEq QueryPath
376instance ApproxEq AllowLeadingWildcard
377instance ApproxEq LowercaseExpanded
378instance ApproxEq EnablePositionIncrements
379instance ApproxEq AnalyzeWildcard
380instance ApproxEq GeneratePhraseQueries
381instance ApproxEq Locale
382instance ApproxEq MaxWordLength
383instance ApproxEq MinWordLength
384instance ApproxEq PhraseSlop
385instance ApproxEq MinDocFrequency
386instance ApproxEq MaxDocFrequency
387instance ApproxEq Filter
388instance ApproxEq Query
389instance ApproxEq SimpleQueryStringQuery
390instance ApproxEq FieldOrFields
391instance ApproxEq SimpleQueryFlag
392instance ApproxEq RegexpQuery
393instance ApproxEq QueryStringQuery
394instance ApproxEq RangeQuery
395instance ApproxEq PrefixQuery
396instance ApproxEq NestedQuery
397instance ApproxEq MoreLikeThisFieldQuery
398instance ApproxEq MoreLikeThisQuery
399instance ApproxEq IndicesQuery
400instance ApproxEq HasParentQuery
401instance ApproxEq HasChildQuery
402instance ApproxEq FuzzyQuery
403instance ApproxEq FuzzyLikeFieldQuery
404instance ApproxEq FuzzyLikeThisQuery
405instance ApproxEq FilteredQuery
406instance ApproxEq DisMaxQuery
407instance ApproxEq CommonTermsQuery
408instance ApproxEq CommonMinimumMatch
409instance ApproxEq BoostingQuery
410instance ApproxEq BoolQuery
411instance ApproxEq MatchQuery
412instance ApproxEq MultiMatchQueryType
413instance ApproxEq BooleanOperator
414instance ApproxEq ZeroTermsQuery
415instance ApproxEq MatchQueryType
416instance ApproxEq AliasRouting
417instance ApproxEq IndexAliasCreate
418instance ApproxEq SearchAliasRouting
419instance ApproxEq ScoreType
420instance ApproxEq Distance
421instance ApproxEq DistanceUnit
422instance ApproxEq DistanceType
423instance ApproxEq OptimizeBbox
424instance ApproxEq GeoBoundingBoxConstraint
425instance ApproxEq GeoFilterType
426instance ApproxEq GeoBoundingBox
427instance ApproxEq LatLon
428instance ApproxEq RangeExecution
429instance ApproxEq FSType
430instance ApproxEq CompoundFormat
431instance ApproxEq InitialShardCount
432instance ApproxEq Bytes
433instance ApproxEq ReplicaBounds
434instance ApproxEq Term
435instance ApproxEq BoolMatch
436instance ApproxEq MultiMatchQuery
437instance ApproxEq IndexSettings
438instance ApproxEq AllocationPolicy
439instance ApproxEq Char
440instance ApproxEq a => ApproxEq [a] where
441 as =~ bs = and (zipWith (=~) as bs)
442instance (ApproxEq l, ApproxEq r) => ApproxEq (Either l r) where
443 Left a =~ Left b = a =~ b
444 Right a =~ Right b = a =~ b
445 _ =~ _ = False
446instance ApproxEq NodeAttrFilter
447instance ApproxEq NodeAttrName
449-- | Due to the way nodeattrfilters get serialized here, they may come
450-- out in a different order, but they are morally equivalent
451instance ApproxEq UpdatableIndexSetting where
452 RoutingAllocationInclude a =~ RoutingAllocationInclude b =
453 NE.sort a =~ NE.sort b
454 RoutingAllocationExclude a =~ RoutingAllocationExclude b =
455 NE.sort a =~ NE.sort b
456 RoutingAllocationRequire a =~ RoutingAllocationRequire b =
457 NE.sort a =~ NE.sort b
458 a =~ b = a == b
462noDuplicates :: Eq a => [a] -> Bool
463noDuplicates xs = nub xs == xs
465instance Arbitrary NominalDiffTime where
466 arbitrary = fromInteger <$> arbitrary
468instance (Arbitrary k, Ord k, Arbitrary v) => Arbitrary (M.Map k v) where
469 arbitrary = M.fromList <$> arbitrary
471instance Arbitrary Text where
472 arbitrary = T.pack <$> arbitrary
474instance Arbitrary UTCTime where
475 arbitrary = UTCTime
476 <$> arbitrary
477 <*> (fromRational . toRational <$> choose (0::Double, 86400))
479instance Arbitrary Day where
480 arbitrary = ModifiedJulianDay <$> (2000 +) <$> arbitrary
481 shrink = (ModifiedJulianDay <$>) . shrink . toModifiedJulianDay
483instance Arbitrary a => Arbitrary (NonEmpty a) where
484 arbitrary = liftA2 (:|) arbitrary arbitrary
486arbitraryScore :: Gen Score
487arbitraryScore = fmap getPositive <$> arbitrary
489instance Arbitrary a => Arbitrary (Hit a) where
490 arbitrary = Hit <$> arbitrary
491 <*> arbitrary
492 <*> arbitrary
493 <*> arbitraryScore
494 <*> arbitrary
495 <*> arbitrary
498instance Arbitrary a => Arbitrary (SearchHits a) where
499 arbitrary = reduceSize $ do
500 tot <- getPositive <$> arbitrary
501 score <- arbitraryScore
502 hs <- arbitrary
503 return $ SearchHits tot score hs
505reduceSize :: Gen a -> Gen a
506reduceSize f = sized $ \n -> resize (n `div` 2) f
508getSource :: EsResult a -> Maybe a
509getSource = fmap _source . foundResult
511grabFirst :: Either EsError (SearchResult a) -> Either EsError a
512grabFirst r =
513 case fmap (hitSource . head . hits . searchHits) r of
514 (Left e) -> Left e
515 (Right Nothing) -> Left (EsError 500 "Source was missing")
516 (Right (Just x)) -> Right x
518-------------------------------------------------------------------------------
519arbitraryAlphaNum :: Gen Char
520arbitraryAlphaNum = oneof [choose ('a', 'z')
521 ,choose ('A','Z')
522 , choose ('0', '9')]
524instance Arbitrary RoutingValue where
525 arbitrary = RoutingValue . T.pack <$> listOf1 arbitraryAlphaNum
527instance Arbitrary AliasRouting where
528 arbitrary = oneof [allAlias
529 ,one
530 ,theOther
531 ,both]
532 where one = GranularAliasRouting
533 <$> (Just <$> arbitrary)
534 <*> pure Nothing
535 theOther = GranularAliasRouting Nothing
536 <$> (Just <$> arbitrary)
537 both = GranularAliasRouting
538 <$> (Just <$> arbitrary)
539 <*> (Just <$> arbitrary)
540 allAlias = AllAliasRouting <$> arbitrary
542instance Arbitrary FieldName where
543 arbitrary = FieldName . T.pack <$> listOf1 arbitraryAlphaNum
545instance Arbitrary RegexpFlags where
546 arbitrary = oneof [ pure AllRegexpFlags
547 , pure NoRegexpFlags
548 , SomeRegexpFlags <$> genUniqueFlags
549 ]
550 where genUniqueFlags = NE.fromList . nub <$> listOf1 arbitrary
552instance Arbitrary IndexAliasCreate where
553 arbitrary = IndexAliasCreate <$> arbitrary <*> reduceSize arbitrary
555instance Arbitrary Query where
556 arbitrary = reduceSize $ oneof [ TermQuery <$> arbitrary <*> arbitrary
557 , TermsQuery <$> arbitrary <*> arbitrary
558 , QueryMatchQuery <$> arbitrary
559 , QueryMultiMatchQuery <$> arbitrary
560 , QueryBoolQuery <$> arbitrary
561 , QueryBoostingQuery <$> arbitrary
562 , QueryCommonTermsQuery <$> arbitrary
563 , ConstantScoreFilter <$> arbitrary <*> arbitrary
564 , ConstantScoreQuery <$> arbitrary <*> arbitrary
565 , QueryDisMaxQuery <$> arbitrary
566 , QueryFilteredQuery <$> arbitrary
567 , QueryFuzzyLikeThisQuery <$> arbitrary
568 , QueryFuzzyLikeFieldQuery <$> arbitrary
569 , QueryFuzzyQuery <$> arbitrary
570 , QueryHasChildQuery <$> arbitrary
571 , QueryHasParentQuery <$> arbitrary
572 , IdsQuery <$> arbitrary <*> arbitrary
573 , QueryIndicesQuery <$> arbitrary
574 , MatchAllQuery <$> arbitrary
575 , QueryMoreLikeThisQuery <$> arbitrary
576 , QueryMoreLikeThisFieldQuery <$> arbitrary
577 , QueryNestedQuery <$> arbitrary
578 , QueryPrefixQuery <$> arbitrary
579 , QueryQueryStringQuery <$> arbitrary
580 , QuerySimpleQueryStringQuery <$> arbitrary
581 , QueryRangeQuery <$> arbitrary
582 , QueryRegexpQuery <$> arbitrary
583 ]
585instance Arbitrary Filter where
586 arbitrary = reduceSize $ oneof [ AndFilter <$> arbitrary <*> arbitrary
587 , OrFilter <$> arbitrary <*> arbitrary
588 , NotFilter <$> arbitrary <*> arbitrary
589 , pure IdentityFilter
590 , BoolFilter <$> arbitrary
591 , ExistsFilter <$> arbitrary
592 , GeoBoundingBoxFilter <$> arbitrary
593 , GeoDistanceFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
594 , GeoDistanceRangeFilter <$> arbitrary <*> arbitrary
595 , GeoPolygonFilter <$> arbitrary <*> arbitrary
596 , IdsFilter <$> arbitrary <*> arbitrary
597 , LimitFilter <$> arbitrary
598 , MissingFilter <$> arbitrary <*> arbitrary <*> arbitrary
599 , PrefixFilter <$> arbitrary <*> arbitrary <*> arbitrary
600 , QueryFilter <$> arbitrary <*> arbitrary
601 , RangeFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
602 , RegexpFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
603 , TermFilter <$> arbitrary <*> arbitrary]
605instance Arbitrary ReplicaBounds where
606 arbitrary = oneof [ replicasBounded
607 , replicasLowerBounded
608 , pure ReplicasUnbounded
609 ]
610 where replicasBounded = do Positive a <- arbitrary
611 Positive b <- arbitrary
612 return (ReplicasBounded a b)
613 replicasLowerBounded = do Positive a <- arbitrary
614 return (ReplicasLowerBounded a)
616instance Arbitrary NodeAttrName where
617 arbitrary = NodeAttrName . T.pack . getNonEmpty <$> arbitrary
620instance Arbitrary NodeAttrFilter where
621 arbitrary = do
622 n <- arbitrary
623 s:ss <- listOf1 (listOf1 arbitraryAlphaNum)
624 let ts = T.pack <$> s :| ss
625 return (NodeAttrFilter n ts)
627$(derive makeArbitrary ''IndexName)
628$(derive makeArbitrary ''MappingName)
629$(derive makeArbitrary ''DocId)
630$(derive makeArbitrary ''Version)
631$(derive makeArbitrary ''IndexAliasRouting)
632$(derive makeArbitrary ''ShardCount)
633$(derive makeArbitrary ''ReplicaCount)
634$(derive makeArbitrary ''TemplateName)
635$(derive makeArbitrary ''TemplatePattern)
636$(derive makeArbitrary ''QueryString)
637$(derive makeArbitrary ''CacheName)
638$(derive makeArbitrary ''CacheKey)
639$(derive makeArbitrary ''Existence)
640$(derive makeArbitrary ''CutoffFrequency)
641$(derive makeArbitrary ''Analyzer)
642$(derive makeArbitrary ''MaxExpansions)
643$(derive makeArbitrary ''Lenient)
644$(derive makeArbitrary ''Tiebreaker)
645$(derive makeArbitrary ''Boost)
646$(derive makeArbitrary ''BoostTerms)
647$(derive makeArbitrary ''MinimumMatch)
648$(derive makeArbitrary ''DisableCoord)
649$(derive makeArbitrary ''IgnoreTermFrequency)
650$(derive makeArbitrary ''MinimumTermFrequency)
651$(derive makeArbitrary ''MaxQueryTerms)
652$(derive makeArbitrary ''Fuzziness)
653$(derive makeArbitrary ''PrefixLength)
654$(derive makeArbitrary ''TypeName)
655$(derive makeArbitrary ''PercentMatch)
656$(derive makeArbitrary ''StopWord)
657$(derive makeArbitrary ''QueryPath)
658$(derive makeArbitrary ''AllowLeadingWildcard)
659$(derive makeArbitrary ''LowercaseExpanded)
660$(derive makeArbitrary ''EnablePositionIncrements)
661$(derive makeArbitrary ''AnalyzeWildcard)
662$(derive makeArbitrary ''GeneratePhraseQueries)
663$(derive makeArbitrary ''Locale)
664$(derive makeArbitrary ''MaxWordLength)
665$(derive makeArbitrary ''MinWordLength)
666$(derive makeArbitrary ''PhraseSlop)
667$(derive makeArbitrary ''MinDocFrequency)
668$(derive makeArbitrary ''MaxDocFrequency)
669$(derive makeArbitrary ''Regexp)
670$(derive makeArbitrary ''SimpleQueryStringQuery)
671$(derive makeArbitrary ''FieldOrFields)
672$(derive makeArbitrary ''SimpleQueryFlag)
673$(derive makeArbitrary ''RegexpQuery)
674$(derive makeArbitrary ''QueryStringQuery)
675$(derive makeArbitrary ''RangeQuery)
676$(derive makeArbitrary ''RangeValue)
677$(derive makeArbitrary ''PrefixQuery)
678$(derive makeArbitrary ''NestedQuery)
679$(derive makeArbitrary ''MoreLikeThisFieldQuery)
680$(derive makeArbitrary ''MoreLikeThisQuery)
681$(derive makeArbitrary ''IndicesQuery)
682$(derive makeArbitrary ''HasParentQuery)
683$(derive makeArbitrary ''HasChildQuery)
684$(derive makeArbitrary ''FuzzyQuery)
685$(derive makeArbitrary ''FuzzyLikeFieldQuery)
686$(derive makeArbitrary ''FuzzyLikeThisQuery)
687$(derive makeArbitrary ''FilteredQuery)
688$(derive makeArbitrary ''DisMaxQuery)
689$(derive makeArbitrary ''CommonTermsQuery)
690$(derive makeArbitrary ''DistanceRange)
691$(derive makeArbitrary ''MultiMatchQuery)
692$(derive makeArbitrary ''LessThanD)
693$(derive makeArbitrary ''LessThanEqD)
694$(derive makeArbitrary ''GreaterThanD)
695$(derive makeArbitrary ''GreaterThanEqD)
696$(derive makeArbitrary ''LessThan)
697$(derive makeArbitrary ''LessThanEq)
698$(derive makeArbitrary ''GreaterThan)
699$(derive makeArbitrary ''GreaterThanEq)
700$(derive makeArbitrary ''GeoPoint)
701$(derive makeArbitrary ''NullValue)
702$(derive makeArbitrary ''MinimumMatchHighLow)
703$(derive makeArbitrary ''CommonMinimumMatch)
704$(derive makeArbitrary ''BoostingQuery)
705$(derive makeArbitrary ''BoolQuery)
706$(derive makeArbitrary ''MatchQuery)
707$(derive makeArbitrary ''MultiMatchQueryType)
708$(derive makeArbitrary ''BooleanOperator)
709$(derive makeArbitrary ''ZeroTermsQuery)
710$(derive makeArbitrary ''MatchQueryType)
711$(derive makeArbitrary ''SearchAliasRouting)
712$(derive makeArbitrary ''ScoreType)
713$(derive makeArbitrary ''Distance)
714$(derive makeArbitrary ''DistanceUnit)
715$(derive makeArbitrary ''DistanceType)
716$(derive makeArbitrary ''OptimizeBbox)
717$(derive makeArbitrary ''GeoBoundingBoxConstraint)
718$(derive makeArbitrary ''GeoFilterType)
719$(derive makeArbitrary ''GeoBoundingBox)
720$(derive makeArbitrary ''LatLon)
721$(derive makeArbitrary ''RangeExecution)
722$(derive makeArbitrary ''RegexpFlag)
723$(derive makeArbitrary ''BoolMatch)
724$(derive makeArbitrary ''Term)
725$(derive makeArbitrary ''IndexSettings)
726$(derive makeArbitrary ''UpdatableIndexSetting)
727$(derive makeArbitrary ''Bytes)
728$(derive makeArbitrary ''AllocationPolicy)
729$(derive makeArbitrary ''InitialShardCount)
730$(derive makeArbitrary ''FSType)
731$(derive makeArbitrary ''CompoundFormat)
734main :: IO ()
735main = hspec $ do
737 describe "index create/delete API" $ do
738 it "creates and then deletes the requested index" $ withTestEnv $ do
739 -- priming state.
740 _ <- deleteExampleIndex
741 resp <- createExampleIndex
742 deleteResp <- deleteExampleIndex
743 liftIO $ do
744 validateStatus resp 200
745 validateStatus deleteResp 200
747 describe "error parsing" $ do
748 it "can parse EsErrors" $ withTestEnv $ do
749 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
750 let errorResp = eitherDecode (responseBody res)
751 liftIO (errorResp `shouldBe` Right (EsError 404 "IndexMissingException[[bogus] missing]"))
753 describe "document API" $ do
754 it "indexes, gets, and then deletes the generated document" $ withTestEnv $ do
755 _ <- insertData
756 docInserted <- getDocument testIndex testMapping (DocId "1")
757 let newTweet = eitherDecode
758 (responseBody docInserted) :: Either String (EsResult Tweet)
759 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))
761 it "indexes, gets, and then deletes the generated document with a DocId containing a space" $ withTestEnv $ do
762 _ <- insertWithSpaceInId
763 docInserted <- getDocument testIndex testMapping (DocId "Hello World")
764 let newTweet = eitherDecode
765 (responseBody docInserted) :: Either String (EsResult Tweet)
766 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))
768 it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do
769 doc <- getDocument testIndex testMapping (DocId "bogus")
770 let noTweet = eitherDecode
771 (responseBody doc) :: Either String (EsResult Tweet)
772 liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing
774 it "can use optimistic concurrency control" $ withTestEnv $ do
775 let ev = ExternalDocVersion minBound
776 let cfg = defaultIndexDocumentSettings { idsVersionControl = ExternalGT ev }
777 resetIndex
778 res <- insertData' cfg
779 liftIO $ isCreated res `shouldBe` True
780 res' <- insertData' cfg
781 liftIO $ isVersionConflict res' `shouldBe` True
783 it "indexes two documents in a parent/child relationship and checks that the child exists" $ withTestEnv $ do
784 resetIndex
785 _ <- putMapping testIndex (MappingName "parent") ParentMapping
786 _ <- putMapping testIndex (MappingName "child") ChildMapping
787 _ <- indexDocument testIndex (MappingName "parent") defaultIndexDocumentSettings exampleTweet (DocId "1")
788 let parent = (Just . DocumentParent . DocId) "1"
789 ids = IndexDocumentSettings NoVersionControl parent
790 _ <- indexDocument testIndex (MappingName "child") ids otherTweet (DocId "2")
791 _ <- refreshIndex testIndex
792 exists <- documentExists testIndex (MappingName "child") parent (DocId "2")
793 liftIO $ exists `shouldBe` True
795 describe "template API" $ do
796 it "can create a template" $ withTestEnv $ do
797 let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
798 resp <- putTemplate idxTpl (TemplateName "tweet-tpl")
799 liftIO $ validateStatus resp 200
801 it "can detect if a template exists" $ withTestEnv $ do
802 exists <- templateExists (TemplateName "tweet-tpl")
803 liftIO $ exists `shouldBe` True
805 it "can delete a template" $ withTestEnv $ do
806 resp <- deleteTemplate (TemplateName "tweet-tpl")
807 liftIO $ validateStatus resp 200
809 it "can detect if a template doesn't exist" $ withTestEnv $ do
810 exists <- templateExists (TemplateName "tweet-tpl")
811 liftIO $ exists `shouldBe` False
813 describe "bulk API" $ do
814 it "inserts all documents we request" $ withTestEnv $ do
815 _ <- insertData
816 let firstTest = BulkTest "blah"
817 let secondTest = BulkTest "bloo"
818 let firstDoc = BulkIndex testIndex
819 testMapping (DocId "2") (toJSON firstTest)
820 let secondDoc = BulkCreate testIndex
821 testMapping (DocId "3") (toJSON secondTest)
822 let stream = V.fromList [firstDoc, secondDoc]
823 _ <- bulk stream
824 _ <- refreshIndex testIndex
825 fDoc <- getDocument testIndex testMapping (DocId "2")
826 sDoc <- getDocument testIndex testMapping (DocId "3")
827 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
828 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
829 liftIO $ do
830 fmap getSource maybeFirst `shouldBe` Right (Just firstTest)
831 fmap getSource maybeSecond `shouldBe` Right (Just secondTest)
834 describe "query API" $ do
835 it "returns document for term query and identity filter" $ withTestEnv $ do
836 _ <- insertData
837 let query = TermQuery (Term "user" "bitemyapp") Nothing
838 let filter = IdentityFilter <&&> IdentityFilter
839 let search = mkSearch (Just query) (Just filter)
840 myTweet <- searchTweet search
841 liftIO $
842 myTweet `shouldBe` Right exampleTweet
844 it "handles constant score queries" $ withTestEnv $ do
845 _ <- insertData
846 let query = TermsQuery "user" ("bitemyapp" :| [])
847 let cfQuery = ConstantScoreQuery query (Boost 1.0)
848 let filter = IdentityFilter
849 let search = mkSearch (Just cfQuery) (Just filter)
850 myTweet <- searchTweet search
851 liftIO $
852 myTweet `shouldBe` Right exampleTweet
853 it "handles constant score filters" $ withTestEnv $ do
854 _ <- insertData
855 let query = TermsQuery "user" ("bitemyapp" :| [])
856 let cfFilter = ConstantScoreFilter IdentityFilter (Boost 1.0)
857 let boolQuery = mkBoolQuery [query, cfFilter] [] []
858 let search = mkSearch (Just (QueryBoolQuery boolQuery)) Nothing
859 myTweet <- searchTweet search
860 liftIO $
861 myTweet `shouldBe` Right exampleTweet
864 it "returns document for terms query and identity filter" $ withTestEnv $ do
865 _ <- insertData
866 let query = TermsQuery "user" ("bitemyapp" :| [])
867 let filter = IdentityFilter <&&> IdentityFilter
868 let search = mkSearch (Just query) (Just filter)
869 myTweet <- searchTweet search
870 liftIO $
871 myTweet `shouldBe` Right exampleTweet
873 it "returns document for match query" $ withTestEnv $ do
874 _ <- insertData
875 let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
876 let search = mkSearch (Just query) Nothing
877 myTweet <- searchTweet search
878 liftIO $
879 myTweet `shouldBe` Right exampleTweet
881 it "returns document for multi-match query" $ withTestEnv $ do
882 _ <- insertData
883 let flds = [FieldName "user", FieldName "message"]
884 let query = QueryMultiMatchQuery $ mkMultiMatchQuery flds (QueryString "bitemyapp")
885 let search = mkSearch (Just query) Nothing
886 myTweet <- searchTweet search
887 liftIO $
888 myTweet `shouldBe` Right exampleTweet
890 it "returns document for bool query" $ withTestEnv $ do
891 _ <- insertData
892 let innerQuery = QueryMatchQuery $
893 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
894 let query = QueryBoolQuery $
895 mkBoolQuery [innerQuery] [] []
896 let search = mkSearch (Just query) Nothing
897 myTweet <- searchTweet search
898 liftIO $
899 myTweet `shouldBe` Right exampleTweet
901 it "returns document for boosting query" $ withTestEnv $ do
902 _ <- insertData
903 let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
904 let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
905 let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
906 let search = mkSearch (Just query) Nothing
907 myTweet <- searchTweet search
908 liftIO $
909 myTweet `shouldBe` Right exampleTweet
911 it "returns document for common terms query" $ withTestEnv $ do
912 _ <- insertData
913 let query = QueryCommonTermsQuery $
914 CommonTermsQuery (FieldName "user")
915 (QueryString "bitemyapp")
916 (CutoffFrequency 0.0001)
917 Or Or Nothing Nothing Nothing Nothing
918 let search = mkSearch (Just query) Nothing
919 myTweet <- searchTweet search
920 liftIO $
921 myTweet `shouldBe` Right exampleTweet
924 describe "sorting" $ do
925 it "returns documents in the right order" $ withTestEnv $ do
926 _ <- insertData
927 _ <- insertOther
928 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
929 let search = Search Nothing
930 (Just IdentityFilter) (Just [sortSpec]) Nothing Nothing
931 False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
932 result <- searchTweets search
933 let myTweet = grabFirst result
934 liftIO $
935 myTweet `shouldBe` Right otherTweet
938 describe "filtering API" $ do
939 it "returns document for composed boolmatch and identity" $ withTestEnv $ do
940 _ <- insertData
941 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
942 <&&> IdentityFilter
943 let search = mkSearch Nothing (Just queryFilter)
944 myTweet <- searchTweet search
945 liftIO $
946 myTweet `shouldBe` Right exampleTweet
948 it "returns document for term filter" $ withTestEnv $ do
949 _ <- insertData
950 let termFilter = TermFilter (Term "user" "bitemyapp") False
951 let search = mkSearch Nothing (Just termFilter)
952 myTweet <- searchTweet search
953 liftIO $
954 myTweet `shouldBe` Right exampleTweet
956 it "returns document for existential filter" $ withTestEnv $ do
957 _ <- insertData
958 let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
959 myTweet <- searchTweet search
960 liftIO $
961 myTweet `shouldBe` Right exampleTweet
963 it "returns document for geo boundingbox filter" $ withTestEnv $ do
964 _ <- insertData
965 let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
966 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
967 let geoFilter = GeoBoundingBoxFilter bbConstraint
968 let search = mkSearch Nothing (Just geoFilter)
969 myTweet <- searchTweet search
970 liftIO $
971 myTweet `shouldBe` Right exampleTweet
973 it "doesn't return document for nonsensical boundingbox filter" $ withTestEnv $ do
974 _ <- insertData
975 let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
976 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
977 let geoFilter = GeoBoundingBoxFilter bbConstraint
978 let search = mkSearch Nothing (Just geoFilter)
979 searchExpectNoResults search
981 it "returns document for geo distance filter" $ withTestEnv $ do
982 _ <- insertData
983 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
984 let distance = Distance 10.0 Miles
985 let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
986 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
987 let search = mkSearch Nothing (Just geoFilter)
988 myTweet <- searchTweet search
989 liftIO $
990 myTweet `shouldBe` Right exampleTweet
992 it "returns document for geo distance range filter" $ withTestEnv $ do
993 _ <- insertData
994 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
995 let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
996 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
997 let search = mkSearch Nothing (Just geoFilter)
998 myTweet <- searchTweet search
999 liftIO $
1000 myTweet `shouldBe` Right exampleTweet
1002 it "doesn't return document for wild geo distance range filter" $ withTestEnv $ do
1003 _ <- insertData
1004 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1005 let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
1006 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
1007 let search = mkSearch Nothing (Just geoFilter)
1008 searchExpectNoResults search
1010 it "returns document for geo polygon filter" $ withTestEnv $ do
1011 _ <- insertData
1012 let points = [LatLon 40.0 (-70.00),
1013 LatLon 40.0 (-72.00),
1014 LatLon 41.0 (-70.00),
1015 LatLon 41.0 (-72.00)]
1016 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
1017 let search = mkSearch Nothing (Just geoFilter)
1018 myTweet <- searchTweet search
1019 liftIO $
1020 myTweet `shouldBe` Right exampleTweet
1022 it "doesn't return document for bad geo polygon filter" $ withTestEnv $ do
1023 _ <- insertData
1024 let points = [LatLon 40.0 (-70.00),
1025 LatLon 40.0 (-71.00),
1026 LatLon 41.0 (-70.00),
1027 LatLon 41.0 (-71.00)]
1028 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
1029 let search = mkSearch Nothing (Just geoFilter)
1030 searchExpectNoResults search
1032 it "returns document for ids filter" $ withTestEnv $ do
1033 _ <- insertData
1034 let filter = IdsFilter (MappingName "tweet") [DocId "1"]
1035 let search = mkSearch Nothing (Just filter)
1036 myTweet <- searchTweet search
1037 liftIO $
1038 myTweet `shouldBe` Right exampleTweet
1040 it "returns document for Double range filter" $ withTestEnv $ do
1041 _ <- insertData
1042 let filter = RangeFilter (FieldName "age")
1043 (RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))
1044 RangeExecutionIndex False
1045 let search = mkSearch Nothing (Just filter)
1046 myTweet <- searchTweet search
1047 liftIO $
1048 myTweet `shouldBe` Right exampleTweet
1050 it "returns document for UTCTime date filter" $ withTestEnv $ do
1051 _ <- insertData
1052 let filter = RangeFilter (FieldName "postDate")
1053 (RangeDateGtLt
1054 (GreaterThanD (UTCTime
1055 (ModifiedJulianDay 54000)
1056 (secondsToDiffTime 0)))
1057 (LessThanD (UTCTime
1058 (ModifiedJulianDay 55000)
1059 (secondsToDiffTime 11))))
1060 RangeExecutionIndex False
1061 let search = mkSearch Nothing (Just filter)
1062 myTweet <- searchTweet search
1063 liftIO $
1064 myTweet `shouldBe` Right exampleTweet
1066 it "returns document for regexp filter" $ withTestEnv $ do
1067 _ <- insertData
1068 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
1069 AllRegexpFlags (CacheName "test") False (CacheKey "key")
1070 let search = mkSearch Nothing (Just filter)
1071 myTweet <- searchTweet search
1072 liftIO $
1073 myTweet `shouldBe` Right exampleTweet
1075 it "doesn't return document for non-matching regexp filter" $ withTestEnv $ do
1076 _ <- insertData
1077 let filter = RegexpFilter (FieldName "user")
1078 (Regexp "boy") AllRegexpFlags
1079 (CacheName "test") False (CacheKey "key")
1080 let search = mkSearch Nothing (Just filter)
1081 searchExpectNoResults search
1083 it "returns document for query filter, uncached" $ withTestEnv $ do
1084 _ <- insertData
1085 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) True
1086 search = mkSearch Nothing (Just filter)
1087 myTweet <- searchTweet search
1088 liftIO $ myTweet `shouldBe` Right exampleTweet
1090 it "returns document for query filter, cached" $ withTestEnv $ do
1091 _ <- insertData
1092 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) False
1093 search = mkSearch Nothing (Just filter)
1094 myTweet <- searchTweet search
1095 liftIO $ myTweet `shouldBe` Right exampleTweet
1097 describe "Aggregation API" $ do
1098 it "returns term aggregation results" $ withTestEnv $ do
1099 _ <- insertData
1100 let terms = TermsAgg $ mkTermsAggregation "user"
1101 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1102 searchExpectAggs search
1103 searchValidBucketAgg search "users" toTerms
1105 it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
1106 _ <- insertData
1107 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
1108 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1109 searchExpectAggs search
1110 searchValidBucketAgg search "users" toTerms
1112 it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
1113 _ <- insertData
1114 searchTermsAggHint [Map, Ordinals]
1116 it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do
1117 _ <- insertData
1118 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
1120 it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
1121 _ <- insertData
1122 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
1125 it "can execute value_count aggregations" $ withTestEnv $ do
1126 _ <- insertData
1127 _ <- insertOther
1128 let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>
1129 mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))
1130 let search = mkAggregateSearch Nothing ags
1131 let docCountPair k n = (k, object ["value" .= Number n])
1132 res <- searchTweets search
1133 liftIO $
1134 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2
1135 , docCountPair "bogus_count" 0
1136 ]))
1138 it "can execute filter aggregations" $ withTestEnv $ do
1139 _ <- insertData
1140 _ <- insertOther
1141 let ags = mkAggregations "bitemyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "bitemyapp") defaultCache) Nothing)) <>
1142 mkAggregations "notmyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "notmyapp") defaultCache) Nothing))
1143 let search = mkAggregateSearch Nothing ags
1144 let docCountPair k n = (k, object ["doc_count" .= Number n])
1145 res <- searchTweets search
1146 liftIO $
1147 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "bitemyapps" 1
1148 , docCountPair "notmyapps" 1
1149 ]))
1150 it "can execute date_range aggregations" $ withTestEnv $ do
1151 let now = fromGregorian 2015 3 14
1152 let ltAMonthAgo = UTCTime (fromGregorian 2015 3 1) 0
1153 let ltAWeekAgo = UTCTime (fromGregorian 2015 3 10) 0
1154 let oldDoc = exampleTweet { postDate = ltAMonthAgo }
1155 let newDoc = exampleTweet { postDate = ltAWeekAgo }
1156 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings oldDoc (DocId "1")
1157 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings newDoc (DocId "2")
1158 _ <- refreshIndex testIndex
1159 let thisMonth = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMMonth])
1160 let thisWeek = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMWeek])
1161 let agg = DateRangeAggregation (FieldName "postDate") Nothing (thisMonth :| [thisWeek])
1162 let ags = mkAggregations "date_ranges" (DateRangeAgg agg)
1163 let search = mkAggregateSearch Nothing ags
1164 res <- searchTweets search
1165 liftIO $ hitsTotal . searchHits <$> res `shouldBe` Right 2
1166 let bucks = do magrs <- fmapL show (aggregations <$> res)
1167 agrs <- note "no aggregations returned" magrs
1168 rawBucks <- note "no date_ranges aggregation" $ M.lookup "date_ranges" agrs
1169 parseEither parseJSON rawBucks
1170 let fromMonthT = UTCTime (fromGregorian 2015 2 14) 0
1171 let fromWeekT = UTCTime (fromGregorian 2015 3 7) 0
1172 liftIO $ buckets <$> bucks `shouldBe` Right [ DateRangeResult "2015-02-14T00:00:00.000Z-*"
1173 (Just fromMonthT)
1174 (Just "2015-02-14T00:00:00.000Z")
1175 Nothing
1176 Nothing
1178 Nothing
1179 , DateRangeResult "2015-03-07T00:00:00.000Z-*"
1180 (Just fromWeekT)
1181 (Just "2015-03-07T00:00:00.000Z")
1182 Nothing
1183 Nothing
1185 Nothing
1188 it "returns date histogram aggregation results" $ withTestEnv $ do
1189 _ <- insertData
1190 let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
1191 let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
1192 searchExpectAggs search
1193 searchValidBucketAgg search "byDate" toDateHistogram
1195 it "returns date histogram using fractional date" $ withTestEnv $ do
1196 _ <- insertData
1197 let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]
1198 let fractionals = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]
1199 let intervals = periods ++ fractionals
1200 let histogram = mkDateHistogram (FieldName "postDate")
1201 let search interval = mkAggregateSearch Nothing $ mkAggregations "byDate" $ DateHistogramAgg (histogram interval)
1202 let expect interval = searchExpectAggs (search interval)
1203 let valid interval = searchValidBucketAgg (search interval) "byDate" toDateHistogram
1204 forM_ intervals expect
1205 forM_ intervals valid
1207 describe "Highlights API" $ do
1209 it "returns highlight from query when there should be one" $ withTestEnv $ do
1210 _ <- insertData
1211 _ <- insertOther
1212 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1213 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
1215 let search = mkHighlightSearch (Just query) testHighlight
1216 myHighlight <- searchTweetHighlight search
1217 liftIO $
1218 myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
1220 it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
1221 _ <- insertData
1222 _ <- insertOther
1223 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1224 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "user") Nothing]
1226 let search = mkHighlightSearch (Just query) testHighlight
1227 myHighlight <- searchTweetHighlight search
1228 liftIO $
1229 myHighlight `shouldBe` Right Nothing
1231 describe "Source filtering" $ do
1233 it "doesn't include source when sources are disabled" $ withTestEnv $ do
1234 searchExpectSource
1235 NoSource
1236 (Left (EsError 500 "Source was missing"))
1238 it "includes a source" $ withTestEnv $ do
1239 searchExpectSource
1240 (SourcePatterns (PopPattern (Pattern "message")))
1241 (Right (Object (HM.fromList [("message", String "Use haskell!")])))
1243 it "includes sources" $ withTestEnv $ do
1244 searchExpectSource
1245 (SourcePatterns (PopPatterns [Pattern "user", Pattern "message"]))
1246 (Right (Object (HM.fromList [("user",String "bitemyapp"),("message", String "Use haskell!")])))
1248 it "includes source patterns" $ withTestEnv $ do
1249 searchExpectSource
1250 (SourcePatterns (PopPattern (Pattern "*ge")))
1251 (Right (Object (HM.fromList [("age", Number 10000),("message", String "Use haskell!")])))
1253 it "excludes source patterns" $ withTestEnv $ do
1254 searchExpectSource
1255 (SourceIncludeExclude (Include []) (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate"]))
1256 (Right (Object (HM.fromList [("user",String "bitemyapp")])))
1258 describe "ToJSON RegexpFlags" $ do
1259 it "generates the correct JSON for AllRegexpFlags" $
1260 toJSON AllRegexpFlags `shouldBe` String "ALL"
1262 it "generates the correct JSON for NoRegexpFlags" $
1263 toJSON NoRegexpFlags `shouldBe` String "NONE"
1265 it "generates the correct JSON for SomeRegexpFlags" $
1266 let flags = AnyString :| [ Automaton
1267 , Complement
1268 , Empty
1269 , Intersection
1270 , Interval ]
1271 in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
1273 prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
1274 let String str = toJSON flags
1275 flagStrs = T.splitOn "|" str
1276 in noDuplicates flagStrs
1278 describe "omitNulls" $ do
1279 it "checks that omitNulls drops list elements when it should" $
1280 let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))
1281 , "test2" .= (toJSON ("some value" :: Text))]
1282 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1284 it "checks that omitNulls doesn't drop list elements when it shouldn't" $
1285 let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))
1286 , "test2" .= (toJSON ("some value" :: Text))]
1287 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))
1288 , ("test2", String "some value")])
1289 it "checks that omitNulls drops non list elements when it should" $
1290 let dropped = omitNulls $ [ "test1" .= (toJSON Null)
1291 , "test2" .= (toJSON ("some value" :: Text))]
1292 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1293 it "checks that omitNulls doesn't drop non list elements when it shouldn't" $
1294 let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
1295 , "test2" .= (toJSON ("some value" :: Text))]
1296 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
1297 , ("test2", String "some value")])
1298 describe "Monoid (SearchHits a)" $ do
1299 prop "abides the monoid laws" $ eq $
1300 prop_Monoid (T :: T (SearchHits ()))
1302 describe "mkDocVersion" $ do
1303 prop "can never construct an out of range docVersion" $ \i ->
1304 let res = mkDocVersion i
1305 in case res of
1306 Nothing -> property True
1307 Just dv -> (dv >= minBound) .&&.
1308 (dv <= maxBound) .&&.
1309 docVersionNumber dv === i
1311 describe "Enum DocVersion" $ do
1312 it "follows the laws of Enum, Bounded" $ do
1313 evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall
1314 evaluate (pred minBound :: DocVersion) `shouldThrow` anyErrorCall
1315 evaluate (toEnum 0 :: DocVersion) `shouldThrow` anyErrorCall
1316 evaluate (toEnum 9200000000000000001 :: DocVersion) `shouldThrow` anyErrorCall
1317 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1318 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1319 enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]
1321 describe "scan&scroll API" $ do
1322 it "returns documents using the scan&scroll API" $ withTestEnv $ do
1323 _ <- insertData
1324 _ <- insertOther
1325 let search = (mkSearch (Just $ MatchAllQuery Nothing) Nothing) { size = (Size 1) }
1326 regular_search <- searchTweet search
1327 scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet]
1328 let scan_search = map hitSource scan_search'
1329 liftIO $
1330 regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored
1331 liftIO $
1332 scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]
1334 describe "index aliases" $ do
1335 it "handles the simple case of aliasing an existing index" $ do
1336 let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1337 let create = IndexAliasCreate Nothing Nothing
1338 let action = AddAlias alias create
1340 withTestEnv $ do
1341 resetIndex
1342 resp <- updateIndexAliases (action :| [])
1343 liftIO $ NHTS.statusCode (responseStatus resp) `shouldBe` 200
1344 let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1345 (do aliases <- withTestEnv getIndexAliases
1346 let expected = IndexAliasSummary alias create
1347 case aliases of
1348 Right (IndexAliasesSummary summs) ->
1349 L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1350 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1352 it "handles an alias with routing and a filter" $ do
1353 let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1354 let sar = SearchAliasRouting (RoutingValue "search val" :| [])
1355 let iar = IndexAliasRouting (RoutingValue "index val")
1356 let routing = GranularAliasRouting (Just sar) (Just iar)
1357 let filter = LimitFilter 42
1358 let create = IndexAliasCreate (Just routing) (Just filter)
1359 let action = AddAlias alias create
1361 withTestEnv $ do
1362 resetIndex
1363 resp <- updateIndexAliases (action :| [])
1364 liftIO $ NHTS.statusCode (responseStatus resp) `shouldBe` 200
1365 let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1366 (do aliases <- withTestEnv getIndexAliases
1367 let expected = IndexAliasSummary alias create
1368 case aliases of
1369 Right (IndexAliasesSummary summs) ->
1370 L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1371 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1373 describe "Index Settings" $ do
1374 it "persists settings" $ withTestEnv $ do
1375 _ <- deleteExampleIndex
1376 _ <- createExampleIndex
1377 let updates = BlocksWrite False :| []
1378 updateResp <- updateIndexSettings updates testIndex
1379 liftIO $ validateStatus updateResp 200
1380 getResp <- getIndexSettings testIndex
1381 liftIO $
1382 getResp `shouldBe` Right (IndexSettingsSummary
1383 testIndex
1384 (IndexSettings (ShardCount 1) (ReplicaCount 0))
1385 (NE.toList updates))
1387 describe "JSON instances" $ do
1388 propJSON (Proxy :: Proxy Version)
1389 propJSON (Proxy :: Proxy IndexName)
1390 propJSON (Proxy :: Proxy MappingName)
1391 propJSON (Proxy :: Proxy DocId)
1392 propJSON (Proxy :: Proxy IndexAliasRouting)
1393 propJSON (Proxy :: Proxy RoutingValue)
1394 propJSON (Proxy :: Proxy ShardCount)
1395 propJSON (Proxy :: Proxy ReplicaCount)
1396 propJSON (Proxy :: Proxy TemplateName)
1397 propJSON (Proxy :: Proxy TemplatePattern)
1398 propJSON (Proxy :: Proxy QueryString)
1399 propJSON (Proxy :: Proxy FieldName)
1400 propJSON (Proxy :: Proxy CacheName)
1401 propJSON (Proxy :: Proxy CacheKey)
1402 propJSON (Proxy :: Proxy Existence)
1403 propJSON (Proxy :: Proxy CutoffFrequency)
1404 propJSON (Proxy :: Proxy Analyzer)
1405 propJSON (Proxy :: Proxy MaxExpansions)
1406 propJSON (Proxy :: Proxy Lenient)
1407 propJSON (Proxy :: Proxy Tiebreaker)
1408 propJSON (Proxy :: Proxy Boost)
1409 propJSON (Proxy :: Proxy BoostTerms)
1410 propJSON (Proxy :: Proxy MinimumMatch)
1411 propJSON (Proxy :: Proxy DisableCoord)
1412 propJSON (Proxy :: Proxy IgnoreTermFrequency)
1413 propJSON (Proxy :: Proxy MinimumTermFrequency)
1414 propJSON (Proxy :: Proxy MaxQueryTerms)
1415 propJSON (Proxy :: Proxy Fuzziness)
1416 propJSON (Proxy :: Proxy PrefixLength)
1417 propJSON (Proxy :: Proxy TypeName)
1418 propJSON (Proxy :: Proxy PercentMatch)
1419 propJSON (Proxy :: Proxy StopWord)
1420 propJSON (Proxy :: Proxy QueryPath)
1421 propJSON (Proxy :: Proxy AllowLeadingWildcard)
1422 propJSON (Proxy :: Proxy LowercaseExpanded)
1423 propJSON (Proxy :: Proxy EnablePositionIncrements)
1424 propJSON (Proxy :: Proxy AnalyzeWildcard)
1425 propJSON (Proxy :: Proxy GeneratePhraseQueries)
1426 propJSON (Proxy :: Proxy Locale)
1427 propJSON (Proxy :: Proxy MaxWordLength)
1428 propJSON (Proxy :: Proxy MinWordLength)
1429 propJSON (Proxy :: Proxy PhraseSlop)
1430 propJSON (Proxy :: Proxy MinDocFrequency)
1431 propJSON (Proxy :: Proxy MaxDocFrequency)
1432 propJSON (Proxy :: Proxy Filter)
1433 propJSON (Proxy :: Proxy Query)
1434 propJSON (Proxy :: Proxy SimpleQueryStringQuery)
1435 propJSON (Proxy :: Proxy FieldOrFields)
1436 propJSON (Proxy :: Proxy SimpleQueryFlag)
1437 propJSON (Proxy :: Proxy RegexpQuery)
1438 propJSON (Proxy :: Proxy QueryStringQuery)
1439 propJSON (Proxy :: Proxy RangeQuery)
1440 propJSON (Proxy :: Proxy PrefixQuery)
1441 propJSON (Proxy :: Proxy NestedQuery)
1442 propJSON (Proxy :: Proxy MoreLikeThisFieldQuery)
1443 propJSON (Proxy :: Proxy MoreLikeThisQuery)
1444 propJSON (Proxy :: Proxy IndicesQuery)
1445 propJSON (Proxy :: Proxy HasParentQuery)
1446 propJSON (Proxy :: Proxy HasChildQuery)
1447 propJSON (Proxy :: Proxy FuzzyQuery)
1448 propJSON (Proxy :: Proxy FuzzyLikeFieldQuery)
1449 propJSON (Proxy :: Proxy FuzzyLikeThisQuery)
1450 propJSON (Proxy :: Proxy FilteredQuery)
1451 propJSON (Proxy :: Proxy DisMaxQuery)
1452 propJSON (Proxy :: Proxy CommonTermsQuery)
1453 propJSON (Proxy :: Proxy CommonMinimumMatch)
1454 propJSON (Proxy :: Proxy BoostingQuery)
1455 propJSON (Proxy :: Proxy BoolQuery)
1456 propJSON (Proxy :: Proxy MatchQuery)
1457 propJSON (Proxy :: Proxy MultiMatchQueryType)
1458 propJSON (Proxy :: Proxy BooleanOperator)
1459 propJSON (Proxy :: Proxy ZeroTermsQuery)
1460 propJSON (Proxy :: Proxy MatchQueryType)
1461 propJSON (Proxy :: Proxy AliasRouting)
1462 propJSON (Proxy :: Proxy IndexAliasCreate)
1463 propJSON (Proxy :: Proxy SearchAliasRouting)
1464 propJSON (Proxy :: Proxy ScoreType)
1465 propJSON (Proxy :: Proxy Distance)
1466 propJSON (Proxy :: Proxy DistanceUnit)
1467 propJSON (Proxy :: Proxy DistanceType)
1468 propJSON (Proxy :: Proxy OptimizeBbox)
1469 propJSON (Proxy :: Proxy GeoBoundingBoxConstraint)
1470 propJSON (Proxy :: Proxy GeoFilterType)
1471 propJSON (Proxy :: Proxy GeoBoundingBox)
1472 propJSON (Proxy :: Proxy LatLon)
1473 propJSON (Proxy :: Proxy RangeExecution)
1474 prop "RegexpFlags FromJSON/ToJSON roundtrips, removing dups " $ \rfs ->
1475 let expected = case rfs of
1476 SomeRegexpFlags fs -> SomeRegexpFlags (NE.fromList (nub (NE.toList fs)))
1477 x -> x
1478 in parseEither parseJSON (toJSON rfs) === Right expected
1479 propJSON (Proxy :: Proxy BoolMatch)
1480 propJSON (Proxy :: Proxy Term)
1481 propJSON (Proxy :: Proxy MultiMatchQuery)
1482 propJSON (Proxy :: Proxy IndexSettings)
1483 propJSON (Proxy :: Proxy UpdatableIndexSetting)
1484 propJSON (Proxy :: Proxy ReplicaBounds)
1485 propJSON (Proxy :: Proxy Bytes)
1486 propJSON (Proxy :: Proxy AllocationPolicy)
1487 propJSON (Proxy :: Proxy InitialShardCount)
1488 propJSON (Proxy :: Proxy FSType)
1489 propJSON (Proxy :: Proxy CompoundFormat)