git.iko.soy/typeable/bloodhound
on 0b116a0 help sign in
typeable/bloodhound/tests/tests.hs
1499 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
461noDuplicates :: Eq a => [a] -> Bool
462noDuplicates xs = nub xs == xs
464instance Arbitrary NominalDiffTime where
465 arbitrary = fromInteger <$> arbitrary
467instance (Arbitrary k, Ord k, Arbitrary v) => Arbitrary (M.Map k v) where
468 arbitrary = M.fromList <$> arbitrary
470instance Arbitrary Text where
471 arbitrary = T.pack <$> arbitrary
473instance Arbitrary UTCTime where
474 arbitrary = UTCTime
475 <$> arbitrary
476 <*> (fromRational . toRational <$> choose (0::Double, 86400))
478instance Arbitrary Day where
479 arbitrary = ModifiedJulianDay <$> (2000 +) <$> arbitrary
480 shrink = (ModifiedJulianDay <$>) . shrink . toModifiedJulianDay
482instance Arbitrary a => Arbitrary (NonEmpty a) where
483 arbitrary = liftA2 (:|) arbitrary arbitrary
485arbitraryScore :: Gen Score
486arbitraryScore = fmap getPositive <$> arbitrary
488instance (Arbitrary a, Typeable a) => Arbitrary (Hit a) where
489 arbitrary = Hit <$> arbitrary
490 <*> arbitrary
491 <*> arbitrary
492 <*> arbitraryScore
493 <*> arbitrary
494 <*> arbitrary
495 shrink = genericShrink
498instance (Arbitrary a, Typeable 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
504 shrink = genericShrink
506reduceSize :: Gen a -> Gen a
507reduceSize f = sized $ \n -> resize (n `div` 2) f
509getSource :: EsResult a -> Maybe a
510getSource = fmap _source . foundResult
512grabFirst :: Either EsError (SearchResult a) -> Either EsError a
513grabFirst r =
514 case fmap (hitSource . head . hits . searchHits) r of
515 (Left e) -> Left e
516 (Right Nothing) -> Left (EsError 500 "Source was missing")
517 (Right (Just x)) -> Right x
519-------------------------------------------------------------------------------
520arbitraryAlphaNum :: Gen Char
521arbitraryAlphaNum = oneof [choose ('a', 'z')
522 ,choose ('A','Z')
523 , choose ('0', '9')]
525instance Arbitrary RoutingValue where
526 arbitrary = RoutingValue . T.pack <$> listOf1 arbitraryAlphaNum
528instance Arbitrary AliasRouting where
529 arbitrary = oneof [allAlias
530 ,one
531 ,theOther
532 ,both]
533 where one = GranularAliasRouting
534 <$> (Just <$> arbitrary)
535 <*> pure Nothing
536 theOther = GranularAliasRouting Nothing
537 <$> (Just <$> arbitrary)
538 both = GranularAliasRouting
539 <$> (Just <$> arbitrary)
540 <*> (Just <$> arbitrary)
541 allAlias = AllAliasRouting <$> arbitrary
542 shrink = genericShrink
545instance Arbitrary FieldName where
546 arbitrary = FieldName . T.pack <$> listOf1 arbitraryAlphaNum
547 shrink = genericShrink
550instance Arbitrary RegexpFlags where
551 arbitrary = oneof [ pure AllRegexpFlags
552 , pure NoRegexpFlags
553 , SomeRegexpFlags <$> genUniqueFlags
554 ]
555 where genUniqueFlags = NE.fromList . nub <$> listOf1 arbitrary
556 shrink = genericShrink
559instance Arbitrary IndexAliasCreate where
560 arbitrary = IndexAliasCreate <$> arbitrary <*> reduceSize arbitrary
561 shrink = genericShrink
563instance Arbitrary Query where
564 arbitrary = reduceSize $ oneof [ TermQuery <$> arbitrary <*> arbitrary
565 , TermsQuery <$> arbitrary <*> arbitrary
566 , QueryMatchQuery <$> arbitrary
567 , QueryMultiMatchQuery <$> arbitrary
568 , QueryBoolQuery <$> arbitrary
569 , QueryBoostingQuery <$> arbitrary
570 , QueryCommonTermsQuery <$> arbitrary
571 , ConstantScoreFilter <$> arbitrary <*> arbitrary
572 , ConstantScoreQuery <$> arbitrary <*> arbitrary
573 , QueryDisMaxQuery <$> arbitrary
574 , QueryFilteredQuery <$> arbitrary
575 , QueryFuzzyLikeThisQuery <$> arbitrary
576 , QueryFuzzyLikeFieldQuery <$> arbitrary
577 , QueryFuzzyQuery <$> arbitrary
578 , QueryHasChildQuery <$> arbitrary
579 , QueryHasParentQuery <$> arbitrary
580 , IdsQuery <$> arbitrary <*> arbitrary
581 , QueryIndicesQuery <$> arbitrary
582 , MatchAllQuery <$> arbitrary
583 , QueryMoreLikeThisQuery <$> arbitrary
584 , QueryMoreLikeThisFieldQuery <$> arbitrary
585 , QueryNestedQuery <$> arbitrary
586 , QueryPrefixQuery <$> arbitrary
587 , QueryQueryStringQuery <$> arbitrary
588 , QuerySimpleQueryStringQuery <$> arbitrary
589 , QueryRangeQuery <$> arbitrary
590 , QueryRegexpQuery <$> arbitrary
591 ]
592 shrink = genericShrink
594instance Arbitrary Filter where
595 arbitrary = reduceSize $ oneof [ AndFilter <$> arbitrary <*> arbitrary
596 , OrFilter <$> arbitrary <*> arbitrary
597 , NotFilter <$> arbitrary <*> arbitrary
598 , pure IdentityFilter
599 , BoolFilter <$> arbitrary
600 , ExistsFilter <$> arbitrary
601 , GeoBoundingBoxFilter <$> arbitrary
602 , GeoDistanceFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
603 , GeoDistanceRangeFilter <$> arbitrary <*> arbitrary
604 , GeoPolygonFilter <$> arbitrary <*> arbitrary
605 , IdsFilter <$> arbitrary <*> arbitrary
606 , LimitFilter <$> arbitrary
607 , MissingFilter <$> arbitrary <*> arbitrary <*> arbitrary
608 , PrefixFilter <$> arbitrary <*> arbitrary <*> arbitrary
609 , QueryFilter <$> arbitrary <*> arbitrary
610 , RangeFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
611 , RegexpFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
612 , TermFilter <$> arbitrary <*> arbitrary]
613 shrink = genericShrink
615instance Arbitrary ReplicaBounds where
616 arbitrary = oneof [ replicasBounded
617 , replicasLowerBounded
618 , pure ReplicasUnbounded
619 ]
620 where replicasBounded = do Positive a <- arbitrary
621 Positive b <- arbitrary
622 return (ReplicasBounded a b)
623 replicasLowerBounded = do Positive a <- arbitrary
624 return (ReplicasLowerBounded a)
626instance Arbitrary NodeAttrName where
627 arbitrary = NodeAttrName . T.pack . getNonEmpty <$> arbitrary
630instance Arbitrary NodeAttrFilter where
631 arbitrary = do
632 n <- arbitrary
633 s:ss <- listOf1 (listOf1 arbitraryAlphaNum)
634 let ts = T.pack <$> s :| ss
635 return (NodeAttrFilter n ts)
637$(derive makeArbitrary ''IndexName)
638$(derive makeArbitrary ''MappingName)
639$(derive makeArbitrary ''DocId)
640$(derive makeArbitrary ''Version)
641$(derive makeArbitrary ''IndexAliasRouting)
642$(derive makeArbitrary ''ShardCount)
643$(derive makeArbitrary ''ReplicaCount)
644$(derive makeArbitrary ''TemplateName)
645$(derive makeArbitrary ''TemplatePattern)
646$(derive makeArbitrary ''QueryString)
647$(derive makeArbitrary ''CacheName)
648$(derive makeArbitrary ''CacheKey)
649$(derive makeArbitrary ''Existence)
650$(derive makeArbitrary ''CutoffFrequency)
651$(derive makeArbitrary ''Analyzer)
652$(derive makeArbitrary ''MaxExpansions)
653$(derive makeArbitrary ''Lenient)
654$(derive makeArbitrary ''Tiebreaker)
655$(derive makeArbitrary ''Boost)
656$(derive makeArbitrary ''BoostTerms)
657$(derive makeArbitrary ''MinimumMatch)
658$(derive makeArbitrary ''DisableCoord)
659$(derive makeArbitrary ''IgnoreTermFrequency)
660$(derive makeArbitrary ''MinimumTermFrequency)
661$(derive makeArbitrary ''MaxQueryTerms)
662$(derive makeArbitrary ''Fuzziness)
663$(derive makeArbitrary ''PrefixLength)
664$(derive makeArbitrary ''TypeName)
665$(derive makeArbitrary ''PercentMatch)
666$(derive makeArbitrary ''StopWord)
667$(derive makeArbitrary ''QueryPath)
668$(derive makeArbitrary ''AllowLeadingWildcard)
669$(derive makeArbitrary ''LowercaseExpanded)
670$(derive makeArbitrary ''EnablePositionIncrements)
671$(derive makeArbitrary ''AnalyzeWildcard)
672$(derive makeArbitrary ''GeneratePhraseQueries)
673$(derive makeArbitrary ''Locale)
674$(derive makeArbitrary ''MaxWordLength)
675$(derive makeArbitrary ''MinWordLength)
676$(derive makeArbitrary ''PhraseSlop)
677$(derive makeArbitrary ''MinDocFrequency)
678$(derive makeArbitrary ''MaxDocFrequency)
679$(derive makeArbitrary ''Regexp)
680$(derive makeArbitrary ''SimpleQueryStringQuery)
681$(derive makeArbitrary ''FieldOrFields)
682$(derive makeArbitrary ''SimpleQueryFlag)
683$(derive makeArbitrary ''RegexpQuery)
684$(derive makeArbitrary ''QueryStringQuery)
685$(derive makeArbitrary ''RangeQuery)
686$(derive makeArbitrary ''RangeValue)
687$(derive makeArbitrary ''PrefixQuery)
688$(derive makeArbitrary ''NestedQuery)
689$(derive makeArbitrary ''MoreLikeThisFieldQuery)
690$(derive makeArbitrary ''MoreLikeThisQuery)
691$(derive makeArbitrary ''IndicesQuery)
692$(derive makeArbitrary ''HasParentQuery)
693$(derive makeArbitrary ''HasChildQuery)
694$(derive makeArbitrary ''FuzzyQuery)
695$(derive makeArbitrary ''FuzzyLikeFieldQuery)
696$(derive makeArbitrary ''FuzzyLikeThisQuery)
697$(derive makeArbitrary ''FilteredQuery)
698$(derive makeArbitrary ''DisMaxQuery)
699$(derive makeArbitrary ''CommonTermsQuery)
700$(derive makeArbitrary ''DistanceRange)
701$(derive makeArbitrary ''MultiMatchQuery)
702$(derive makeArbitrary ''LessThanD)
703$(derive makeArbitrary ''LessThanEqD)
704$(derive makeArbitrary ''GreaterThanD)
705$(derive makeArbitrary ''GreaterThanEqD)
706$(derive makeArbitrary ''LessThan)
707$(derive makeArbitrary ''LessThanEq)
708$(derive makeArbitrary ''GreaterThan)
709$(derive makeArbitrary ''GreaterThanEq)
710$(derive makeArbitrary ''GeoPoint)
711$(derive makeArbitrary ''NullValue)
712$(derive makeArbitrary ''MinimumMatchHighLow)
713$(derive makeArbitrary ''CommonMinimumMatch)
714$(derive makeArbitrary ''BoostingQuery)
715$(derive makeArbitrary ''BoolQuery)
716$(derive makeArbitrary ''MatchQuery)
717$(derive makeArbitrary ''MultiMatchQueryType)
718$(derive makeArbitrary ''BooleanOperator)
719$(derive makeArbitrary ''ZeroTermsQuery)
720$(derive makeArbitrary ''MatchQueryType)
721$(derive makeArbitrary ''SearchAliasRouting)
722$(derive makeArbitrary ''ScoreType)
723$(derive makeArbitrary ''Distance)
724$(derive makeArbitrary ''DistanceUnit)
725$(derive makeArbitrary ''DistanceType)
726$(derive makeArbitrary ''OptimizeBbox)
727$(derive makeArbitrary ''GeoBoundingBoxConstraint)
728$(derive makeArbitrary ''GeoFilterType)
729$(derive makeArbitrary ''GeoBoundingBox)
730$(derive makeArbitrary ''LatLon)
731$(derive makeArbitrary ''RangeExecution)
732$(derive makeArbitrary ''RegexpFlag)
733$(derive makeArbitrary ''BoolMatch)
734$(derive makeArbitrary ''Term)
735$(derive makeArbitrary ''IndexSettings)
736$(derive makeArbitrary ''UpdatableIndexSetting)
737$(derive makeArbitrary ''Bytes)
738$(derive makeArbitrary ''AllocationPolicy)
739$(derive makeArbitrary ''InitialShardCount)
740$(derive makeArbitrary ''FSType)
741$(derive makeArbitrary ''CompoundFormat)
744main :: IO ()
745main = hspec $ do
747 describe "index create/delete API" $ do
748 it "creates and then deletes the requested index" $ withTestEnv $ do
749 -- priming state.
750 _ <- deleteExampleIndex
751 resp <- createExampleIndex
752 deleteResp <- deleteExampleIndex
753 liftIO $ do
754 validateStatus resp 200
755 validateStatus deleteResp 200
757 describe "error parsing" $ do
758 it "can parse EsErrors" $ withTestEnv $ do
759 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
760 let errorResp = eitherDecode (responseBody res)
761 liftIO (errorResp `shouldBe` Right (EsError 404 "IndexMissingException[[bogus] missing]"))
763 describe "document API" $ do
764 it "indexes, gets, and then deletes the generated document" $ withTestEnv $ do
765 _ <- insertData
766 docInserted <- getDocument testIndex testMapping (DocId "1")
767 let newTweet = eitherDecode
768 (responseBody docInserted) :: Either String (EsResult Tweet)
769 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))
771 it "indexes, gets, and then deletes the generated document with a DocId containing a space" $ withTestEnv $ do
772 _ <- insertWithSpaceInId
773 docInserted <- getDocument testIndex testMapping (DocId "Hello World")
774 let newTweet = eitherDecode
775 (responseBody docInserted) :: Either String (EsResult Tweet)
776 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))
778 it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do
779 doc <- getDocument testIndex testMapping (DocId "bogus")
780 let noTweet = eitherDecode
781 (responseBody doc) :: Either String (EsResult Tweet)
782 liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing
784 it "can use optimistic concurrency control" $ withTestEnv $ do
785 let ev = ExternalDocVersion minBound
786 let cfg = defaultIndexDocumentSettings { idsVersionControl = ExternalGT ev }
787 resetIndex
788 res <- insertData' cfg
789 liftIO $ isCreated res `shouldBe` True
790 res' <- insertData' cfg
791 liftIO $ isVersionConflict res' `shouldBe` True
793 it "indexes two documents in a parent/child relationship and checks that the child exists" $ withTestEnv $ do
794 resetIndex
795 _ <- putMapping testIndex (MappingName "parent") ParentMapping
796 _ <- putMapping testIndex (MappingName "child") ChildMapping
797 _ <- indexDocument testIndex (MappingName "parent") defaultIndexDocumentSettings exampleTweet (DocId "1")
798 let parent = (Just . DocumentParent . DocId) "1"
799 ids = IndexDocumentSettings NoVersionControl parent
800 _ <- indexDocument testIndex (MappingName "child") ids otherTweet (DocId "2")
801 _ <- refreshIndex testIndex
802 exists <- documentExists testIndex (MappingName "child") parent (DocId "2")
803 liftIO $ exists `shouldBe` True
805 describe "template API" $ do
806 it "can create a template" $ withTestEnv $ do
807 let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
808 resp <- putTemplate idxTpl (TemplateName "tweet-tpl")
809 liftIO $ validateStatus resp 200
811 it "can detect if a template exists" $ withTestEnv $ do
812 exists <- templateExists (TemplateName "tweet-tpl")
813 liftIO $ exists `shouldBe` True
815 it "can delete a template" $ withTestEnv $ do
816 resp <- deleteTemplate (TemplateName "tweet-tpl")
817 liftIO $ validateStatus resp 200
819 it "can detect if a template doesn't exist" $ withTestEnv $ do
820 exists <- templateExists (TemplateName "tweet-tpl")
821 liftIO $ exists `shouldBe` False
823 describe "bulk API" $ do
824 it "inserts all documents we request" $ withTestEnv $ do
825 _ <- insertData
826 let firstTest = BulkTest "blah"
827 let secondTest = BulkTest "bloo"
828 let firstDoc = BulkIndex testIndex
829 testMapping (DocId "2") (toJSON firstTest)
830 let secondDoc = BulkCreate testIndex
831 testMapping (DocId "3") (toJSON secondTest)
832 let stream = V.fromList [firstDoc, secondDoc]
833 _ <- bulk stream
834 _ <- refreshIndex testIndex
835 fDoc <- getDocument testIndex testMapping (DocId "2")
836 sDoc <- getDocument testIndex testMapping (DocId "3")
837 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
838 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
839 liftIO $ do
840 fmap getSource maybeFirst `shouldBe` Right (Just firstTest)
841 fmap getSource maybeSecond `shouldBe` Right (Just secondTest)
844 describe "query API" $ do
845 it "returns document for term query and identity filter" $ withTestEnv $ do
846 _ <- insertData
847 let query = TermQuery (Term "user" "bitemyapp") Nothing
848 let filter = IdentityFilter <&&> IdentityFilter
849 let search = mkSearch (Just query) (Just filter)
850 myTweet <- searchTweet search
851 liftIO $
852 myTweet `shouldBe` Right exampleTweet
854 it "handles constant score queries" $ withTestEnv $ do
855 _ <- insertData
856 let query = TermsQuery "user" ("bitemyapp" :| [])
857 let cfQuery = ConstantScoreQuery query (Boost 1.0)
858 let filter = IdentityFilter
859 let search = mkSearch (Just cfQuery) (Just filter)
860 myTweet <- searchTweet search
861 liftIO $
862 myTweet `shouldBe` Right exampleTweet
863 it "handles constant score filters" $ withTestEnv $ do
864 _ <- insertData
865 let query = TermsQuery "user" ("bitemyapp" :| [])
866 let cfFilter = ConstantScoreFilter IdentityFilter (Boost 1.0)
867 let boolQuery = mkBoolQuery [query, cfFilter] [] []
868 let search = mkSearch (Just (QueryBoolQuery boolQuery)) Nothing
869 myTweet <- searchTweet search
870 liftIO $
871 myTweet `shouldBe` Right exampleTweet
874 it "returns document for terms query and identity filter" $ withTestEnv $ do
875 _ <- insertData
876 let query = TermsQuery "user" ("bitemyapp" :| [])
877 let filter = IdentityFilter <&&> IdentityFilter
878 let search = mkSearch (Just query) (Just filter)
879 myTweet <- searchTweet search
880 liftIO $
881 myTweet `shouldBe` Right exampleTweet
883 it "returns document for match query" $ withTestEnv $ do
884 _ <- insertData
885 let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
886 let search = mkSearch (Just query) Nothing
887 myTweet <- searchTweet search
888 liftIO $
889 myTweet `shouldBe` Right exampleTweet
891 it "returns document for multi-match query" $ withTestEnv $ do
892 _ <- insertData
893 let flds = [FieldName "user", FieldName "message"]
894 let query = QueryMultiMatchQuery $ mkMultiMatchQuery flds (QueryString "bitemyapp")
895 let search = mkSearch (Just query) Nothing
896 myTweet <- searchTweet search
897 liftIO $
898 myTweet `shouldBe` Right exampleTweet
900 it "returns document for bool query" $ withTestEnv $ do
901 _ <- insertData
902 let innerQuery = QueryMatchQuery $
903 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
904 let query = QueryBoolQuery $
905 mkBoolQuery [innerQuery] [] []
906 let search = mkSearch (Just query) Nothing
907 myTweet <- searchTweet search
908 liftIO $
909 myTweet `shouldBe` Right exampleTweet
911 it "returns document for boosting query" $ withTestEnv $ do
912 _ <- insertData
913 let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
914 let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
915 let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
916 let search = mkSearch (Just query) Nothing
917 myTweet <- searchTweet search
918 liftIO $
919 myTweet `shouldBe` Right exampleTweet
921 it "returns document for common terms query" $ withTestEnv $ do
922 _ <- insertData
923 let query = QueryCommonTermsQuery $
924 CommonTermsQuery (FieldName "user")
925 (QueryString "bitemyapp")
926 (CutoffFrequency 0.0001)
927 Or Or Nothing Nothing Nothing Nothing
928 let search = mkSearch (Just query) Nothing
929 myTweet <- searchTweet search
930 liftIO $
931 myTweet `shouldBe` Right exampleTweet
934 describe "sorting" $ do
935 it "returns documents in the right order" $ withTestEnv $ do
936 _ <- insertData
937 _ <- insertOther
938 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
939 let search = Search Nothing
940 (Just IdentityFilter) (Just [sortSpec]) Nothing Nothing
941 False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
942 result <- searchTweets search
943 let myTweet = grabFirst result
944 liftIO $
945 myTweet `shouldBe` Right otherTweet
948 describe "filtering API" $ do
949 it "returns document for composed boolmatch and identity" $ withTestEnv $ do
950 _ <- insertData
951 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
952 <&&> IdentityFilter
953 let search = mkSearch Nothing (Just queryFilter)
954 myTweet <- searchTweet search
955 liftIO $
956 myTweet `shouldBe` Right exampleTweet
958 it "returns document for term filter" $ withTestEnv $ do
959 _ <- insertData
960 let termFilter = TermFilter (Term "user" "bitemyapp") False
961 let search = mkSearch Nothing (Just termFilter)
962 myTweet <- searchTweet search
963 liftIO $
964 myTweet `shouldBe` Right exampleTweet
966 it "returns document for existential filter" $ withTestEnv $ do
967 _ <- insertData
968 let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
969 myTweet <- searchTweet search
970 liftIO $
971 myTweet `shouldBe` Right exampleTweet
973 it "returns document for geo boundingbox filter" $ withTestEnv $ do
974 _ <- insertData
975 let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
976 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
977 let geoFilter = GeoBoundingBoxFilter bbConstraint
978 let search = mkSearch Nothing (Just geoFilter)
979 myTweet <- searchTweet search
980 liftIO $
981 myTweet `shouldBe` Right exampleTweet
983 it "doesn't return document for nonsensical boundingbox filter" $ withTestEnv $ do
984 _ <- insertData
985 let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
986 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
987 let geoFilter = GeoBoundingBoxFilter bbConstraint
988 let search = mkSearch Nothing (Just geoFilter)
989 searchExpectNoResults search
991 it "returns document for geo distance filter" $ withTestEnv $ do
992 _ <- insertData
993 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
994 let distance = Distance 10.0 Miles
995 let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
996 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
997 let search = mkSearch Nothing (Just geoFilter)
998 myTweet <- searchTweet search
999 liftIO $
1000 myTweet `shouldBe` Right exampleTweet
1002 it "returns document for 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 0.0 Miles) (Distance 10.0 Miles)
1006 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
1007 let search = mkSearch Nothing (Just geoFilter)
1008 myTweet <- searchTweet search
1009 liftIO $
1010 myTweet `shouldBe` Right exampleTweet
1012 it "doesn't return document for wild geo distance range filter" $ withTestEnv $ do
1013 _ <- insertData
1014 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1015 let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
1016 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
1017 let search = mkSearch Nothing (Just geoFilter)
1018 searchExpectNoResults search
1020 it "returns document for geo polygon filter" $ withTestEnv $ do
1021 _ <- insertData
1022 let points = [LatLon 40.0 (-70.00),
1023 LatLon 40.0 (-72.00),
1024 LatLon 41.0 (-70.00),
1025 LatLon 41.0 (-72.00)]
1026 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
1027 let search = mkSearch Nothing (Just geoFilter)
1028 myTweet <- searchTweet search
1029 liftIO $
1030 myTweet `shouldBe` Right exampleTweet
1032 it "doesn't return document for bad geo polygon filter" $ withTestEnv $ do
1033 _ <- insertData
1034 let points = [LatLon 40.0 (-70.00),
1035 LatLon 40.0 (-71.00),
1036 LatLon 41.0 (-70.00),
1037 LatLon 41.0 (-71.00)]
1038 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
1039 let search = mkSearch Nothing (Just geoFilter)
1040 searchExpectNoResults search
1042 it "returns document for ids filter" $ withTestEnv $ do
1043 _ <- insertData
1044 let filter = IdsFilter (MappingName "tweet") [DocId "1"]
1045 let search = mkSearch Nothing (Just filter)
1046 myTweet <- searchTweet search
1047 liftIO $
1048 myTweet `shouldBe` Right exampleTweet
1050 it "returns document for Double range filter" $ withTestEnv $ do
1051 _ <- insertData
1052 let filter = RangeFilter (FieldName "age")
1053 (RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))
1054 RangeExecutionIndex False
1055 let search = mkSearch Nothing (Just filter)
1056 myTweet <- searchTweet search
1057 liftIO $
1058 myTweet `shouldBe` Right exampleTweet
1060 it "returns document for UTCTime date filter" $ withTestEnv $ do
1061 _ <- insertData
1062 let filter = RangeFilter (FieldName "postDate")
1063 (RangeDateGtLt
1064 (GreaterThanD (UTCTime
1065 (ModifiedJulianDay 54000)
1066 (secondsToDiffTime 0)))
1067 (LessThanD (UTCTime
1068 (ModifiedJulianDay 55000)
1069 (secondsToDiffTime 11))))
1070 RangeExecutionIndex False
1071 let search = mkSearch Nothing (Just filter)
1072 myTweet <- searchTweet search
1073 liftIO $
1074 myTweet `shouldBe` Right exampleTweet
1076 it "returns document for regexp filter" $ withTestEnv $ do
1077 _ <- insertData
1078 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
1079 AllRegexpFlags (CacheName "test") False (CacheKey "key")
1080 let search = mkSearch Nothing (Just filter)
1081 myTweet <- searchTweet search
1082 liftIO $
1083 myTweet `shouldBe` Right exampleTweet
1085 it "doesn't return document for non-matching regexp filter" $ withTestEnv $ do
1086 _ <- insertData
1087 let filter = RegexpFilter (FieldName "user")
1088 (Regexp "boy") AllRegexpFlags
1089 (CacheName "test") False (CacheKey "key")
1090 let search = mkSearch Nothing (Just filter)
1091 searchExpectNoResults search
1093 it "returns document for query filter, uncached" $ withTestEnv $ do
1094 _ <- insertData
1095 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) True
1096 search = mkSearch Nothing (Just filter)
1097 myTweet <- searchTweet search
1098 liftIO $ myTweet `shouldBe` Right exampleTweet
1100 it "returns document for query filter, cached" $ withTestEnv $ do
1101 _ <- insertData
1102 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) False
1103 search = mkSearch Nothing (Just filter)
1104 myTweet <- searchTweet search
1105 liftIO $ myTweet `shouldBe` Right exampleTweet
1107 describe "Aggregation API" $ do
1108 it "returns term aggregation results" $ withTestEnv $ do
1109 _ <- insertData
1110 let terms = TermsAgg $ mkTermsAggregation "user"
1111 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1112 searchExpectAggs search
1113 searchValidBucketAgg search "users" toTerms
1115 it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
1116 _ <- insertData
1117 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
1118 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1119 searchExpectAggs search
1120 searchValidBucketAgg search "users" toTerms
1122 it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
1123 _ <- insertData
1124 searchTermsAggHint [Map, Ordinals]
1126 it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do
1127 _ <- insertData
1128 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
1130 it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
1131 _ <- insertData
1132 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
1135 it "can execute value_count aggregations" $ withTestEnv $ do
1136 _ <- insertData
1137 _ <- insertOther
1138 let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>
1139 mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))
1140 let search = mkAggregateSearch Nothing ags
1141 let docCountPair k n = (k, object ["value" .= Number n])
1142 res <- searchTweets search
1143 liftIO $
1144 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2
1145 , docCountPair "bogus_count" 0
1146 ]))
1148 it "can execute filter aggregations" $ withTestEnv $ do
1149 _ <- insertData
1150 _ <- insertOther
1151 let ags = mkAggregations "bitemyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "bitemyapp") defaultCache) Nothing)) <>
1152 mkAggregations "notmyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "notmyapp") defaultCache) Nothing))
1153 let search = mkAggregateSearch Nothing ags
1154 let docCountPair k n = (k, object ["doc_count" .= Number n])
1155 res <- searchTweets search
1156 liftIO $
1157 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "bitemyapps" 1
1158 , docCountPair "notmyapps" 1
1159 ]))
1160 it "can execute date_range aggregations" $ withTestEnv $ do
1161 let now = fromGregorian 2015 3 14
1162 let ltAMonthAgo = UTCTime (fromGregorian 2015 3 1) 0
1163 let ltAWeekAgo = UTCTime (fromGregorian 2015 3 10) 0
1164 let oldDoc = exampleTweet { postDate = ltAMonthAgo }
1165 let newDoc = exampleTweet { postDate = ltAWeekAgo }
1166 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings oldDoc (DocId "1")
1167 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings newDoc (DocId "2")
1168 _ <- refreshIndex testIndex
1169 let thisMonth = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMMonth])
1170 let thisWeek = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMWeek])
1171 let agg = DateRangeAggregation (FieldName "postDate") Nothing (thisMonth :| [thisWeek])
1172 let ags = mkAggregations "date_ranges" (DateRangeAgg agg)
1173 let search = mkAggregateSearch Nothing ags
1174 res <- searchTweets search
1175 liftIO $ hitsTotal . searchHits <$> res `shouldBe` Right 2
1176 let bucks = do magrs <- fmapL show (aggregations <$> res)
1177 agrs <- note "no aggregations returned" magrs
1178 rawBucks <- note "no date_ranges aggregation" $ M.lookup "date_ranges" agrs
1179 parseEither parseJSON rawBucks
1180 let fromMonthT = UTCTime (fromGregorian 2015 2 14) 0
1181 let fromWeekT = UTCTime (fromGregorian 2015 3 7) 0
1182 liftIO $ buckets <$> bucks `shouldBe` Right [ DateRangeResult "2015-02-14T00:00:00.000Z-*"
1183 (Just fromMonthT)
1184 (Just "2015-02-14T00:00:00.000Z")
1185 Nothing
1186 Nothing
1188 Nothing
1189 , DateRangeResult "2015-03-07T00:00:00.000Z-*"
1190 (Just fromWeekT)
1191 (Just "2015-03-07T00:00:00.000Z")
1192 Nothing
1193 Nothing
1195 Nothing
1198 it "returns date histogram aggregation results" $ withTestEnv $ do
1199 _ <- insertData
1200 let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
1201 let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
1202 searchExpectAggs search
1203 searchValidBucketAgg search "byDate" toDateHistogram
1205 it "returns date histogram using fractional date" $ withTestEnv $ do
1206 _ <- insertData
1207 let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]
1208 let fractionals = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]
1209 let intervals = periods ++ fractionals
1210 let histogram = mkDateHistogram (FieldName "postDate")
1211 let search interval = mkAggregateSearch Nothing $ mkAggregations "byDate" $ DateHistogramAgg (histogram interval)
1212 let expect interval = searchExpectAggs (search interval)
1213 let valid interval = searchValidBucketAgg (search interval) "byDate" toDateHistogram
1214 forM_ intervals expect
1215 forM_ intervals valid
1217 describe "Highlights API" $ do
1219 it "returns highlight from query when there should be one" $ withTestEnv $ do
1220 _ <- insertData
1221 _ <- insertOther
1222 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1223 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
1225 let search = mkHighlightSearch (Just query) testHighlight
1226 myHighlight <- searchTweetHighlight search
1227 liftIO $
1228 myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
1230 it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
1231 _ <- insertData
1232 _ <- insertOther
1233 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1234 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "user") Nothing]
1236 let search = mkHighlightSearch (Just query) testHighlight
1237 myHighlight <- searchTweetHighlight search
1238 liftIO $
1239 myHighlight `shouldBe` Right Nothing
1241 describe "Source filtering" $ do
1243 it "doesn't include source when sources are disabled" $ withTestEnv $ do
1244 searchExpectSource
1245 NoSource
1246 (Left (EsError 500 "Source was missing"))
1248 it "includes a source" $ withTestEnv $ do
1249 searchExpectSource
1250 (SourcePatterns (PopPattern (Pattern "message")))
1251 (Right (Object (HM.fromList [("message", String "Use haskell!")])))
1253 it "includes sources" $ withTestEnv $ do
1254 searchExpectSource
1255 (SourcePatterns (PopPatterns [Pattern "user", Pattern "message"]))
1256 (Right (Object (HM.fromList [("user",String "bitemyapp"),("message", String "Use haskell!")])))
1258 it "includes source patterns" $ withTestEnv $ do
1259 searchExpectSource
1260 (SourcePatterns (PopPattern (Pattern "*ge")))
1261 (Right (Object (HM.fromList [("age", Number 10000),("message", String "Use haskell!")])))
1263 it "excludes source patterns" $ withTestEnv $ do
1264 searchExpectSource
1265 (SourceIncludeExclude (Include []) (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate"]))
1266 (Right (Object (HM.fromList [("user",String "bitemyapp")])))
1268 describe "ToJSON RegexpFlags" $ do
1269 it "generates the correct JSON for AllRegexpFlags" $
1270 toJSON AllRegexpFlags `shouldBe` String "ALL"
1272 it "generates the correct JSON for NoRegexpFlags" $
1273 toJSON NoRegexpFlags `shouldBe` String "NONE"
1275 it "generates the correct JSON for SomeRegexpFlags" $
1276 let flags = AnyString :| [ Automaton
1277 , Complement
1278 , Empty
1279 , Intersection
1280 , Interval ]
1281 in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
1283 prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
1284 let String str = toJSON flags
1285 flagStrs = T.splitOn "|" str
1286 in noDuplicates flagStrs
1288 describe "omitNulls" $ do
1289 it "checks that omitNulls drops list elements when it should" $
1290 let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))
1291 , "test2" .= (toJSON ("some value" :: Text))]
1292 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1294 it "checks that omitNulls doesn't drop list elements when it shouldn't" $
1295 let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))
1296 , "test2" .= (toJSON ("some value" :: Text))]
1297 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))
1298 , ("test2", String "some value")])
1299 it "checks that omitNulls drops non list elements when it should" $
1300 let dropped = omitNulls $ [ "test1" .= (toJSON Null)
1301 , "test2" .= (toJSON ("some value" :: Text))]
1302 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1303 it "checks that omitNulls doesn't drop non list elements when it shouldn't" $
1304 let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
1305 , "test2" .= (toJSON ("some value" :: Text))]
1306 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
1307 , ("test2", String "some value")])
1308 describe "Monoid (SearchHits a)" $ do
1309 prop "abides the monoid laws" $ eq $
1310 prop_Monoid (T :: T (SearchHits ()))
1312 describe "mkDocVersion" $ do
1313 prop "can never construct an out of range docVersion" $ \i ->
1314 let res = mkDocVersion i
1315 in case res of
1316 Nothing -> property True
1317 Just dv -> (dv >= minBound) .&&.
1318 (dv <= maxBound) .&&.
1319 docVersionNumber dv === i
1321 describe "Enum DocVersion" $ do
1322 it "follows the laws of Enum, Bounded" $ do
1323 evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall
1324 evaluate (pred minBound :: DocVersion) `shouldThrow` anyErrorCall
1325 evaluate (toEnum 0 :: DocVersion) `shouldThrow` anyErrorCall
1326 evaluate (toEnum 9200000000000000001 :: DocVersion) `shouldThrow` anyErrorCall
1327 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1328 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1329 enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]
1331 describe "scan&scroll API" $ do
1332 it "returns documents using the scan&scroll API" $ withTestEnv $ do
1333 _ <- insertData
1334 _ <- insertOther
1335 let search = (mkSearch (Just $ MatchAllQuery Nothing) Nothing) { size = (Size 1) }
1336 regular_search <- searchTweet search
1337 scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet]
1338 let scan_search = map hitSource scan_search'
1339 liftIO $
1340 regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored
1341 liftIO $
1342 scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]
1344 describe "index aliases" $ do
1345 it "handles the simple case of aliasing an existing index" $ do
1346 let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1347 let create = IndexAliasCreate Nothing Nothing
1348 let action = AddAlias alias create
1350 withTestEnv $ do
1351 resetIndex
1352 resp <- updateIndexAliases (action :| [])
1353 liftIO $ validateStatus resp 200
1354 let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1355 (do aliases <- withTestEnv getIndexAliases
1356 let expected = IndexAliasSummary alias create
1357 case aliases of
1358 Right (IndexAliasesSummary summs) ->
1359 L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1360 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1362 it "handles an alias with routing and a filter" $ do
1363 let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1364 let sar = SearchAliasRouting (RoutingValue "search val" :| [])
1365 let iar = IndexAliasRouting (RoutingValue "index val")
1366 let routing = GranularAliasRouting (Just sar) (Just iar)
1367 let filter = LimitFilter 42
1368 let create = IndexAliasCreate (Just routing) (Just filter)
1369 let action = AddAlias alias create
1371 withTestEnv $ do
1372 resetIndex
1373 resp <- updateIndexAliases (action :| [])
1374 liftIO $ validateStatus resp 200
1375 let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1376 (do aliases <- withTestEnv getIndexAliases
1377 let expected = IndexAliasSummary alias create
1378 case aliases of
1379 Right (IndexAliasesSummary summs) ->
1380 L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1381 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1383 describe "Index Settings" $ do
1384 it "persists settings" $ withTestEnv $ do
1385 _ <- deleteExampleIndex
1386 _ <- createExampleIndex
1387 let updates = BlocksWrite False :| []
1388 updateResp <- updateIndexSettings updates testIndex
1389 liftIO $ validateStatus updateResp 200
1390 getResp <- getIndexSettings testIndex
1391 liftIO $
1392 getResp `shouldBe` Right (IndexSettingsSummary
1393 testIndex
1394 (IndexSettings (ShardCount 1) (ReplicaCount 0))
1395 (NE.toList updates))
1397 describe "JSON instances" $ do
1398 propJSON (Proxy :: Proxy Version)
1399 propJSON (Proxy :: Proxy IndexName)
1400 propJSON (Proxy :: Proxy MappingName)
1401 propJSON (Proxy :: Proxy DocId)
1402 propJSON (Proxy :: Proxy IndexAliasRouting)
1403 propJSON (Proxy :: Proxy RoutingValue)
1404 propJSON (Proxy :: Proxy ShardCount)
1405 propJSON (Proxy :: Proxy ReplicaCount)
1406 propJSON (Proxy :: Proxy TemplateName)
1407 propJSON (Proxy :: Proxy TemplatePattern)
1408 propJSON (Proxy :: Proxy QueryString)
1409 propJSON (Proxy :: Proxy FieldName)
1410 propJSON (Proxy :: Proxy CacheName)
1411 propJSON (Proxy :: Proxy CacheKey)
1412 propJSON (Proxy :: Proxy Existence)
1413 propJSON (Proxy :: Proxy CutoffFrequency)
1414 propJSON (Proxy :: Proxy Analyzer)
1415 propJSON (Proxy :: Proxy MaxExpansions)
1416 propJSON (Proxy :: Proxy Lenient)
1417 propJSON (Proxy :: Proxy Tiebreaker)
1418 propJSON (Proxy :: Proxy Boost)
1419 propJSON (Proxy :: Proxy BoostTerms)
1420 propJSON (Proxy :: Proxy MinimumMatch)
1421 propJSON (Proxy :: Proxy DisableCoord)
1422 propJSON (Proxy :: Proxy IgnoreTermFrequency)
1423 propJSON (Proxy :: Proxy MinimumTermFrequency)
1424 propJSON (Proxy :: Proxy MaxQueryTerms)
1425 propJSON (Proxy :: Proxy Fuzziness)
1426 propJSON (Proxy :: Proxy PrefixLength)
1427 propJSON (Proxy :: Proxy TypeName)
1428 propJSON (Proxy :: Proxy PercentMatch)
1429 propJSON (Proxy :: Proxy StopWord)
1430 propJSON (Proxy :: Proxy QueryPath)
1431 propJSON (Proxy :: Proxy AllowLeadingWildcard)
1432 propJSON (Proxy :: Proxy LowercaseExpanded)
1433 propJSON (Proxy :: Proxy EnablePositionIncrements)
1434 propJSON (Proxy :: Proxy AnalyzeWildcard)
1435 propJSON (Proxy :: Proxy GeneratePhraseQueries)
1436 propJSON (Proxy :: Proxy Locale)
1437 propJSON (Proxy :: Proxy MaxWordLength)
1438 propJSON (Proxy :: Proxy MinWordLength)
1439 propJSON (Proxy :: Proxy PhraseSlop)
1440 propJSON (Proxy :: Proxy MinDocFrequency)
1441 propJSON (Proxy :: Proxy MaxDocFrequency)
1442 propJSON (Proxy :: Proxy Filter)
1443 propJSON (Proxy :: Proxy Query)
1444 propJSON (Proxy :: Proxy SimpleQueryStringQuery)
1445 propJSON (Proxy :: Proxy FieldOrFields)
1446 propJSON (Proxy :: Proxy SimpleQueryFlag)
1447 propJSON (Proxy :: Proxy RegexpQuery)
1448 propJSON (Proxy :: Proxy QueryStringQuery)
1449 propJSON (Proxy :: Proxy RangeQuery)
1450 propJSON (Proxy :: Proxy PrefixQuery)
1451 propJSON (Proxy :: Proxy NestedQuery)
1452 propJSON (Proxy :: Proxy MoreLikeThisFieldQuery)
1453 propJSON (Proxy :: Proxy MoreLikeThisQuery)
1454 propJSON (Proxy :: Proxy IndicesQuery)
1455 propJSON (Proxy :: Proxy HasParentQuery)
1456 propJSON (Proxy :: Proxy HasChildQuery)
1457 propJSON (Proxy :: Proxy FuzzyQuery)
1458 propJSON (Proxy :: Proxy FuzzyLikeFieldQuery)
1459 propJSON (Proxy :: Proxy FuzzyLikeThisQuery)
1460 propJSON (Proxy :: Proxy FilteredQuery)
1461 propJSON (Proxy :: Proxy DisMaxQuery)
1462 propJSON (Proxy :: Proxy CommonTermsQuery)
1463 propJSON (Proxy :: Proxy CommonMinimumMatch)
1464 propJSON (Proxy :: Proxy BoostingQuery)
1465 propJSON (Proxy :: Proxy BoolQuery)
1466 propJSON (Proxy :: Proxy MatchQuery)
1467 propJSON (Proxy :: Proxy MultiMatchQueryType)
1468 propJSON (Proxy :: Proxy BooleanOperator)
1469 propJSON (Proxy :: Proxy ZeroTermsQuery)
1470 propJSON (Proxy :: Proxy MatchQueryType)
1471 propJSON (Proxy :: Proxy AliasRouting)
1472 propJSON (Proxy :: Proxy IndexAliasCreate)
1473 propJSON (Proxy :: Proxy SearchAliasRouting)
1474 propJSON (Proxy :: Proxy ScoreType)
1475 propJSON (Proxy :: Proxy Distance)
1476 propJSON (Proxy :: Proxy DistanceUnit)
1477 propJSON (Proxy :: Proxy DistanceType)
1478 propJSON (Proxy :: Proxy OptimizeBbox)
1479 propJSON (Proxy :: Proxy GeoBoundingBoxConstraint)
1480 propJSON (Proxy :: Proxy GeoFilterType)
1481 propJSON (Proxy :: Proxy GeoBoundingBox)
1482 propJSON (Proxy :: Proxy LatLon)
1483 propJSON (Proxy :: Proxy RangeExecution)
1484 prop "RegexpFlags FromJSON/ToJSON roundtrips, removing dups " $ \rfs ->
1485 let expected = case rfs of
1486 SomeRegexpFlags fs -> SomeRegexpFlags (NE.fromList (nub (NE.toList fs)))
1487 x -> x
1488 in parseEither parseJSON (toJSON rfs) === Right expected
1489 propJSON (Proxy :: Proxy BoolMatch)
1490 propJSON (Proxy :: Proxy Term)
1491 propJSON (Proxy :: Proxy MultiMatchQuery)
1492 propJSON (Proxy :: Proxy IndexSettings)
1493 propJSON (Proxy :: Proxy UpdatableIndexSetting)
1494 propJSON (Proxy :: Proxy ReplicaBounds)
1495 propJSON (Proxy :: Proxy Bytes)
1496 propJSON (Proxy :: Proxy AllocationPolicy)
1497 propJSON (Proxy :: Proxy InitialShardCount)
1498 propJSON (Proxy :: Proxy FSType)
1499 propJSON (Proxy :: Proxy CompoundFormat)