git.iko.soy/typeable/bloodhound
on 90-markdown-bugs help sign in
typeable/bloodhound/tests/tests.hs
1521 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) }
183newAge :: Int
184newAge = 31337
186newUser :: Text
187newUser = "someotherapp"
189tweetPatch :: Value
190tweetPatch =
191 object [ "age" .= newAge
192 , "user" .= newUser
193 ]
195patchedTweet :: Tweet
196patchedTweet = exampleTweet{age = newAge, user = newUser}
198otherTweet :: Tweet
199otherTweet = Tweet { user = "notmyapp"
200 , postDate = UTCTime
201 (ModifiedJulianDay 55000)
202 (secondsToDiffTime 11)
203 , message = "Use haskell!"
204 , age = 1000
205 , location = Location 40.12 (-71.34) }
207resetIndex :: BH IO ()
208resetIndex = do
209 _ <- deleteExampleIndex
210 _ <- createExampleIndex
211 _ <- putMapping testIndex testMapping TweetMapping
212 return ()
214insertData :: BH IO Reply
215insertData = do
216 resetIndex
217 insertData' defaultIndexDocumentSettings
219insertData' :: IndexDocumentSettings -> BH IO Reply
220insertData' ids = do
221 r <- indexDocument testIndex testMapping ids exampleTweet (DocId "1")
222 _ <- refreshIndex testIndex
223 return r
225updateData :: BH IO Reply
226updateData = do
227 r <- updateDocument testIndex testMapping defaultIndexDocumentSettings tweetPatch (DocId "1")
228 _ <- refreshIndex testIndex
229 return r
231insertOther :: BH IO ()
232insertOther = do
233 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings otherTweet (DocId "2")
234 _ <- refreshIndex testIndex
235 return ()
237insertWithSpaceInId :: BH IO ()
238insertWithSpaceInId = do
239 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "Hello World")
240 _ <- refreshIndex testIndex
241 return ()
243searchTweet :: Search -> BH IO (Either EsError Tweet)
244searchTweet search = do
245 result <- searchTweets search
246 let myTweet :: Either EsError Tweet
247 myTweet = grabFirst result
248 return myTweet
250searchTweets :: Search -> BH IO (Either EsError (SearchResult Tweet))
251searchTweets search = parseEsResponse =<< searchByIndex testIndex search
253searchExpectNoResults :: Search -> BH IO ()
254searchExpectNoResults search = do
255 result <- searchTweets search
256 let emptyHits = fmap (hits . searchHits) result
257 liftIO $
258 emptyHits `shouldBe` Right []
260searchExpectAggs :: Search -> BH IO ()
261searchExpectAggs search = do
262 reply <- searchByIndex testIndex search
263 let isEmpty x = return (M.null x)
264 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
265 liftIO $
266 (result >>= aggregations >>= isEmpty) `shouldBe` Just False
268searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) =>
269 Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> BH IO ()
270searchValidBucketAgg search aggKey extractor = do
271 reply <- searchByIndex testIndex search
272 let bucketDocs = docCount . head . buckets
273 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
274 let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)
275 liftIO $
276 count `shouldBe` Just 1
278searchTermsAggHint :: [ExecutionHint] -> BH IO ()
279searchTermsAggHint hints = do
280 let terms hint = TermsAgg $ (mkTermsAggregation "user") { termExecutionHint = Just hint }
281 let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint
282 forM_ hints $ searchExpectAggs . search
283 forM_ hints (\x -> searchValidBucketAgg (search x) "users" toTerms)
285searchTweetHighlight :: Search -> BH IO (Either EsError (Maybe HitHighlight))
286searchTweetHighlight search = do
287 result <- searchTweets search
288 let myHighlight = fmap (hitHighlight . head . hits . searchHits) result
289 return myHighlight
291searchExpectSource :: Source -> Either EsError Value -> BH IO ()
292searchExpectSource src expected = do
293 _ <- insertData
294 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
295 let search = (mkSearch (Just query) Nothing) { source = Just src }
296 reply <- searchByIndex testIndex search
297 result <- parseEsResponse reply
298 let value = grabFirst result
299 liftIO $
300 value `shouldBe` expected
302data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
303instance FromJSON BulkTest where
304 parseJSON = genericParseJSON defaultOptions
305instance ToJSON BulkTest where
306 toJSON = genericToJSON defaultOptions
308class GApproxEq f where
309 gApproxEq :: f a -> f a -> Bool
311-- | Unit type
312instance GApproxEq U1 where
313 gApproxEq U1 U1 = True
315-- | Sum type, ensure same constructors, recurse
316instance (GApproxEq a, GApproxEq b) => GApproxEq (a :+: b) where
317 gApproxEq (L1 a) (L1 b) = gApproxEq a b
318 gApproxEq (R1 a) (R1 b) = gApproxEq a b
319 gApproxEq _ _ = False
321-- | Product type, ensure each field is approx eq
322instance (GApproxEq a, GApproxEq b) => GApproxEq (a :*: b) where
323 gApproxEq (a1 :*: b1) (a2 :*: b2) = gApproxEq a1 a2 && gApproxEq b1 b2
325-- | Value type, actually check the values for approx equality
326instance (ApproxEq a) => GApproxEq (K1 i a) where
327 gApproxEq (K1 a) (K1 b) = a =~ b
329instance (GApproxEq f) => GApproxEq (M1 i t f) where
330 gApproxEq (M1 a) (M1 b) = gApproxEq a b
332-- | Typeclass for "equal where it matters". Use this to specify
333-- less-strict equivalence for things such as lists that can wind up
334-- in an unpredictable order
335class ApproxEq a where
336 (=~) :: a -> a -> Bool
337 default (=~) :: (Generic a, GApproxEq (Rep a)) => a -> a -> Bool
338 a =~ b = gApproxEq (G.from a) (G.from b)
340instance ApproxEq NominalDiffTime where (=~) = (==)
341instance ApproxEq UTCTime where (=~) = (==)
342instance ApproxEq Text where (=~) = (==)
343instance ApproxEq Bool where (=~) = (==)
344instance ApproxEq Int where (=~) = (==)
345instance ApproxEq Double where (=~) = (==)
346instance ApproxEq a => ApproxEq (NonEmpty a)
347instance ApproxEq a => ApproxEq (Maybe a)
348instance ApproxEq GeoPoint
349instance ApproxEq Regexp
350instance ApproxEq RangeValue
351instance ApproxEq LessThan
352instance ApproxEq LessThanEq
353instance ApproxEq LessThanD
354instance ApproxEq LessThanEqD
355instance ApproxEq GreaterThan
356instance ApproxEq GreaterThanEq
357instance ApproxEq GreaterThanD
358instance ApproxEq GreaterThanEqD
359instance ApproxEq MinimumMatchHighLow
360instance ApproxEq RegexpFlag
361instance ApproxEq RegexpFlags
362instance ApproxEq NullValue
363instance ApproxEq Version
364instance ApproxEq DistanceRange
365instance ApproxEq IndexName
366instance ApproxEq MappingName
367instance ApproxEq DocId
368instance ApproxEq IndexAliasRouting
369instance ApproxEq RoutingValue
370instance ApproxEq ShardCount
371instance ApproxEq ReplicaCount
372instance ApproxEq TemplateName
373instance ApproxEq TemplatePattern
374instance ApproxEq QueryString
375instance ApproxEq FieldName
376instance ApproxEq CacheName
377instance ApproxEq CacheKey
378instance ApproxEq Existence
379instance ApproxEq CutoffFrequency
380instance ApproxEq Analyzer
381instance ApproxEq Lenient
382instance ApproxEq Tiebreaker
383instance ApproxEq Boost
384instance ApproxEq BoostTerms
385instance ApproxEq MaxExpansions
386instance ApproxEq MinimumMatch
387instance ApproxEq DisableCoord
388instance ApproxEq IgnoreTermFrequency
389instance ApproxEq MinimumTermFrequency
390instance ApproxEq MaxQueryTerms
391instance ApproxEq Fuzziness
392instance ApproxEq PrefixLength
393instance ApproxEq TypeName
394instance ApproxEq PercentMatch
395instance ApproxEq StopWord
396instance ApproxEq QueryPath
397instance ApproxEq AllowLeadingWildcard
398instance ApproxEq LowercaseExpanded
399instance ApproxEq EnablePositionIncrements
400instance ApproxEq AnalyzeWildcard
401instance ApproxEq GeneratePhraseQueries
402instance ApproxEq Locale
403instance ApproxEq MaxWordLength
404instance ApproxEq MinWordLength
405instance ApproxEq PhraseSlop
406instance ApproxEq MinDocFrequency
407instance ApproxEq MaxDocFrequency
408instance ApproxEq Filter
409instance ApproxEq Query
410instance ApproxEq SimpleQueryStringQuery
411instance ApproxEq FieldOrFields
412instance ApproxEq SimpleQueryFlag
413instance ApproxEq RegexpQuery
414instance ApproxEq QueryStringQuery
415instance ApproxEq RangeQuery
416instance ApproxEq PrefixQuery
417instance ApproxEq NestedQuery
418instance ApproxEq MoreLikeThisFieldQuery
419instance ApproxEq MoreLikeThisQuery
420instance ApproxEq IndicesQuery
421instance ApproxEq HasParentQuery
422instance ApproxEq HasChildQuery
423instance ApproxEq FuzzyQuery
424instance ApproxEq FuzzyLikeFieldQuery
425instance ApproxEq FuzzyLikeThisQuery
426instance ApproxEq FilteredQuery
427instance ApproxEq DisMaxQuery
428instance ApproxEq CommonTermsQuery
429instance ApproxEq CommonMinimumMatch
430instance ApproxEq BoostingQuery
431instance ApproxEq BoolQuery
432instance ApproxEq MatchQuery
433instance ApproxEq MultiMatchQueryType
434instance ApproxEq BooleanOperator
435instance ApproxEq ZeroTermsQuery
436instance ApproxEq MatchQueryType
437instance ApproxEq AliasRouting
438instance ApproxEq IndexAliasCreate
439instance ApproxEq SearchAliasRouting
440instance ApproxEq ScoreType
441instance ApproxEq Distance
442instance ApproxEq DistanceUnit
443instance ApproxEq DistanceType
444instance ApproxEq OptimizeBbox
445instance ApproxEq GeoBoundingBoxConstraint
446instance ApproxEq GeoFilterType
447instance ApproxEq GeoBoundingBox
448instance ApproxEq LatLon
449instance ApproxEq RangeExecution
450instance ApproxEq FSType
451instance ApproxEq CompoundFormat
452instance ApproxEq InitialShardCount
453instance ApproxEq Bytes
454instance ApproxEq ReplicaBounds
455instance ApproxEq Term
456instance ApproxEq BoolMatch
457instance ApproxEq MultiMatchQuery
458instance ApproxEq IndexSettings
459instance ApproxEq AllocationPolicy
460instance ApproxEq Char
461instance ApproxEq a => ApproxEq [a] where
462 as =~ bs = and (zipWith (=~) as bs)
463instance (ApproxEq l, ApproxEq r) => ApproxEq (Either l r) where
464 Left a =~ Left b = a =~ b
465 Right a =~ Right b = a =~ b
466 _ =~ _ = False
467instance ApproxEq NodeAttrFilter
468instance ApproxEq NodeAttrName
470-- | Due to the way nodeattrfilters get serialized here, they may come
471-- out in a different order, but they are morally equivalent
472instance ApproxEq UpdatableIndexSetting where
473 RoutingAllocationInclude a =~ RoutingAllocationInclude b =
474 NE.sort a =~ NE.sort b
475 RoutingAllocationExclude a =~ RoutingAllocationExclude b =
476 NE.sort a =~ NE.sort b
477 RoutingAllocationRequire a =~ RoutingAllocationRequire b =
478 NE.sort a =~ NE.sort b
479 a =~ b = a == b
482noDuplicates :: Eq a => [a] -> Bool
483noDuplicates xs = nub xs == xs
485instance Arbitrary NominalDiffTime where
486 arbitrary = fromInteger <$> arbitrary
488instance (Arbitrary k, Ord k, Arbitrary v) => Arbitrary (M.Map k v) where
489 arbitrary = M.fromList <$> arbitrary
491instance Arbitrary Text where
492 arbitrary = T.pack <$> arbitrary
494instance Arbitrary UTCTime where
495 arbitrary = UTCTime
496 <$> arbitrary
497 <*> (fromRational . toRational <$> choose (0::Double, 86400))
499instance Arbitrary Day where
500 arbitrary = ModifiedJulianDay <$> (2000 +) <$> arbitrary
501 shrink = (ModifiedJulianDay <$>) . shrink . toModifiedJulianDay
503instance Arbitrary a => Arbitrary (NonEmpty a) where
504 arbitrary = liftA2 (:|) arbitrary arbitrary
506arbitraryScore :: Gen Score
507arbitraryScore = fmap getPositive <$> arbitrary
509instance (Arbitrary a, Typeable a) => Arbitrary (Hit a) where
510 arbitrary = Hit <$> arbitrary
511 <*> arbitrary
512 <*> arbitrary
513 <*> arbitraryScore
514 <*> arbitrary
515 <*> arbitrary
516 shrink = genericShrink
519instance (Arbitrary a, Typeable a) => Arbitrary (SearchHits a) where
520 arbitrary = reduceSize $ do
521 tot <- getPositive <$> arbitrary
522 score <- arbitraryScore
523 hs <- arbitrary
524 return $ SearchHits tot score hs
525 shrink = genericShrink
527reduceSize :: Gen a -> Gen a
528reduceSize f = sized $ \n -> resize (n `div` 2) f
530getSource :: EsResult a -> Maybe a
531getSource = fmap _source . foundResult
533grabFirst :: Either EsError (SearchResult a) -> Either EsError a
534grabFirst r =
535 case fmap (hitSource . head . hits . searchHits) r of
536 (Left e) -> Left e
537 (Right Nothing) -> Left (EsError 500 "Source was missing")
538 (Right (Just x)) -> Right x
540-------------------------------------------------------------------------------
541arbitraryAlphaNum :: Gen Char
542arbitraryAlphaNum = oneof [choose ('a', 'z')
543 ,choose ('A','Z')
544 , choose ('0', '9')]
546instance Arbitrary RoutingValue where
547 arbitrary = RoutingValue . T.pack <$> listOf1 arbitraryAlphaNum
549instance Arbitrary AliasRouting where
550 arbitrary = oneof [allAlias
551 ,one
552 ,theOther
553 ,both]
554 where one = GranularAliasRouting
555 <$> (Just <$> arbitrary)
556 <*> pure Nothing
557 theOther = GranularAliasRouting Nothing
558 <$> (Just <$> arbitrary)
559 both = GranularAliasRouting
560 <$> (Just <$> arbitrary)
561 <*> (Just <$> arbitrary)
562 allAlias = AllAliasRouting <$> arbitrary
563 shrink = genericShrink
566instance Arbitrary FieldName where
567 arbitrary = FieldName . T.pack <$> listOf1 arbitraryAlphaNum
568 shrink = genericShrink
571instance Arbitrary RegexpFlags where
572 arbitrary = oneof [ pure AllRegexpFlags
573 , pure NoRegexpFlags
574 , SomeRegexpFlags <$> genUniqueFlags
575 ]
576 where genUniqueFlags = NE.fromList . nub <$> listOf1 arbitrary
577 shrink = genericShrink
580instance Arbitrary IndexAliasCreate where
581 arbitrary = IndexAliasCreate <$> arbitrary <*> reduceSize arbitrary
582 shrink = genericShrink
584instance Arbitrary Query where
585 arbitrary = reduceSize $ oneof [ TermQuery <$> arbitrary <*> arbitrary
586 , TermsQuery <$> arbitrary <*> arbitrary
587 , QueryMatchQuery <$> arbitrary
588 , QueryMultiMatchQuery <$> arbitrary
589 , QueryBoolQuery <$> arbitrary
590 , QueryBoostingQuery <$> arbitrary
591 , QueryCommonTermsQuery <$> arbitrary
592 , ConstantScoreFilter <$> arbitrary <*> arbitrary
593 , ConstantScoreQuery <$> arbitrary <*> arbitrary
594 , QueryDisMaxQuery <$> arbitrary
595 , QueryFilteredQuery <$> arbitrary
596 , QueryFuzzyLikeThisQuery <$> arbitrary
597 , QueryFuzzyLikeFieldQuery <$> arbitrary
598 , QueryFuzzyQuery <$> arbitrary
599 , QueryHasChildQuery <$> arbitrary
600 , QueryHasParentQuery <$> arbitrary
601 , IdsQuery <$> arbitrary <*> arbitrary
602 , QueryIndicesQuery <$> arbitrary
603 , MatchAllQuery <$> arbitrary
604 , QueryMoreLikeThisQuery <$> arbitrary
605 , QueryMoreLikeThisFieldQuery <$> arbitrary
606 , QueryNestedQuery <$> arbitrary
607 , QueryPrefixQuery <$> arbitrary
608 , QueryQueryStringQuery <$> arbitrary
609 , QuerySimpleQueryStringQuery <$> arbitrary
610 , QueryRangeQuery <$> arbitrary
611 , QueryRegexpQuery <$> arbitrary
612 ]
613 shrink = genericShrink
615instance Arbitrary Filter where
616 arbitrary = reduceSize $ oneof [ AndFilter <$> arbitrary <*> arbitrary
617 , OrFilter <$> arbitrary <*> arbitrary
618 , NotFilter <$> arbitrary <*> arbitrary
619 , pure IdentityFilter
620 , BoolFilter <$> arbitrary
621 , ExistsFilter <$> arbitrary
622 , GeoBoundingBoxFilter <$> arbitrary
623 , GeoDistanceFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
624 , GeoDistanceRangeFilter <$> arbitrary <*> arbitrary
625 , GeoPolygonFilter <$> arbitrary <*> arbitrary
626 , IdsFilter <$> arbitrary <*> arbitrary
627 , LimitFilter <$> arbitrary
628 , MissingFilter <$> arbitrary <*> arbitrary <*> arbitrary
629 , PrefixFilter <$> arbitrary <*> arbitrary <*> arbitrary
630 , QueryFilter <$> arbitrary <*> arbitrary
631 , RangeFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
632 , RegexpFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
633 , TermFilter <$> arbitrary <*> arbitrary]
634 shrink = genericShrink
636instance Arbitrary ReplicaBounds where
637 arbitrary = oneof [ replicasBounded
638 , replicasLowerBounded
639 , pure ReplicasUnbounded
640 ]
641 where replicasBounded = do Positive a <- arbitrary
642 Positive b <- arbitrary
643 return (ReplicasBounded a b)
644 replicasLowerBounded = do Positive a <- arbitrary
645 return (ReplicasLowerBounded a)
647instance Arbitrary NodeAttrName where
648 arbitrary = NodeAttrName . T.pack . getNonEmpty <$> arbitrary
651instance Arbitrary NodeAttrFilter where
652 arbitrary = do
653 n <- arbitrary
654 s:ss <- listOf1 (listOf1 arbitraryAlphaNum)
655 let ts = T.pack <$> s :| ss
656 return (NodeAttrFilter n ts)
658$(derive makeArbitrary ''IndexName)
659$(derive makeArbitrary ''MappingName)
660$(derive makeArbitrary ''DocId)
661$(derive makeArbitrary ''Version)
662$(derive makeArbitrary ''IndexAliasRouting)
663$(derive makeArbitrary ''ShardCount)
664$(derive makeArbitrary ''ReplicaCount)
665$(derive makeArbitrary ''TemplateName)
666$(derive makeArbitrary ''TemplatePattern)
667$(derive makeArbitrary ''QueryString)
668$(derive makeArbitrary ''CacheName)
669$(derive makeArbitrary ''CacheKey)
670$(derive makeArbitrary ''Existence)
671$(derive makeArbitrary ''CutoffFrequency)
672$(derive makeArbitrary ''Analyzer)
673$(derive makeArbitrary ''MaxExpansions)
674$(derive makeArbitrary ''Lenient)
675$(derive makeArbitrary ''Tiebreaker)
676$(derive makeArbitrary ''Boost)
677$(derive makeArbitrary ''BoostTerms)
678$(derive makeArbitrary ''MinimumMatch)
679$(derive makeArbitrary ''DisableCoord)
680$(derive makeArbitrary ''IgnoreTermFrequency)
681$(derive makeArbitrary ''MinimumTermFrequency)
682$(derive makeArbitrary ''MaxQueryTerms)
683$(derive makeArbitrary ''Fuzziness)
684$(derive makeArbitrary ''PrefixLength)
685$(derive makeArbitrary ''TypeName)
686$(derive makeArbitrary ''PercentMatch)
687$(derive makeArbitrary ''StopWord)
688$(derive makeArbitrary ''QueryPath)
689$(derive makeArbitrary ''AllowLeadingWildcard)
690$(derive makeArbitrary ''LowercaseExpanded)
691$(derive makeArbitrary ''EnablePositionIncrements)
692$(derive makeArbitrary ''AnalyzeWildcard)
693$(derive makeArbitrary ''GeneratePhraseQueries)
694$(derive makeArbitrary ''Locale)
695$(derive makeArbitrary ''MaxWordLength)
696$(derive makeArbitrary ''MinWordLength)
697$(derive makeArbitrary ''PhraseSlop)
698$(derive makeArbitrary ''MinDocFrequency)
699$(derive makeArbitrary ''MaxDocFrequency)
700$(derive makeArbitrary ''Regexp)
701$(derive makeArbitrary ''SimpleQueryStringQuery)
702$(derive makeArbitrary ''FieldOrFields)
703$(derive makeArbitrary ''SimpleQueryFlag)
704$(derive makeArbitrary ''RegexpQuery)
705$(derive makeArbitrary ''QueryStringQuery)
706$(derive makeArbitrary ''RangeQuery)
707$(derive makeArbitrary ''RangeValue)
708$(derive makeArbitrary ''PrefixQuery)
709$(derive makeArbitrary ''NestedQuery)
710$(derive makeArbitrary ''MoreLikeThisFieldQuery)
711$(derive makeArbitrary ''MoreLikeThisQuery)
712$(derive makeArbitrary ''IndicesQuery)
713$(derive makeArbitrary ''HasParentQuery)
714$(derive makeArbitrary ''HasChildQuery)
715$(derive makeArbitrary ''FuzzyQuery)
716$(derive makeArbitrary ''FuzzyLikeFieldQuery)
717$(derive makeArbitrary ''FuzzyLikeThisQuery)
718$(derive makeArbitrary ''FilteredQuery)
719$(derive makeArbitrary ''DisMaxQuery)
720$(derive makeArbitrary ''CommonTermsQuery)
721$(derive makeArbitrary ''DistanceRange)
722$(derive makeArbitrary ''MultiMatchQuery)
723$(derive makeArbitrary ''LessThanD)
724$(derive makeArbitrary ''LessThanEqD)
725$(derive makeArbitrary ''GreaterThanD)
726$(derive makeArbitrary ''GreaterThanEqD)
727$(derive makeArbitrary ''LessThan)
728$(derive makeArbitrary ''LessThanEq)
729$(derive makeArbitrary ''GreaterThan)
730$(derive makeArbitrary ''GreaterThanEq)
731$(derive makeArbitrary ''GeoPoint)
732$(derive makeArbitrary ''NullValue)
733$(derive makeArbitrary ''MinimumMatchHighLow)
734$(derive makeArbitrary ''CommonMinimumMatch)
735$(derive makeArbitrary ''BoostingQuery)
736$(derive makeArbitrary ''BoolQuery)
737$(derive makeArbitrary ''MatchQuery)
738$(derive makeArbitrary ''MultiMatchQueryType)
739$(derive makeArbitrary ''BooleanOperator)
740$(derive makeArbitrary ''ZeroTermsQuery)
741$(derive makeArbitrary ''MatchQueryType)
742$(derive makeArbitrary ''SearchAliasRouting)
743$(derive makeArbitrary ''ScoreType)
744$(derive makeArbitrary ''Distance)
745$(derive makeArbitrary ''DistanceUnit)
746$(derive makeArbitrary ''DistanceType)
747$(derive makeArbitrary ''OptimizeBbox)
748$(derive makeArbitrary ''GeoBoundingBoxConstraint)
749$(derive makeArbitrary ''GeoFilterType)
750$(derive makeArbitrary ''GeoBoundingBox)
751$(derive makeArbitrary ''LatLon)
752$(derive makeArbitrary ''RangeExecution)
753$(derive makeArbitrary ''RegexpFlag)
754$(derive makeArbitrary ''BoolMatch)
755$(derive makeArbitrary ''Term)
756$(derive makeArbitrary ''IndexSettings)
757$(derive makeArbitrary ''UpdatableIndexSetting)
758$(derive makeArbitrary ''Bytes)
759$(derive makeArbitrary ''AllocationPolicy)
760$(derive makeArbitrary ''InitialShardCount)
761$(derive makeArbitrary ''FSType)
762$(derive makeArbitrary ''CompoundFormat)
765main :: IO ()
766main = hspec $ do
768 describe "index create/delete API" $ do
769 it "creates and then deletes the requested index" $ withTestEnv $ do
770 -- priming state.
771 _ <- deleteExampleIndex
772 resp <- createExampleIndex
773 deleteResp <- deleteExampleIndex
774 liftIO $ do
775 validateStatus resp 200
776 validateStatus deleteResp 200
778 describe "error parsing" $ do
779 it "can parse EsErrors" $ withTestEnv $ do
780 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
781 let errorResp = eitherDecode (responseBody res)
782 liftIO (errorResp `shouldBe` Right (EsError 404 "IndexMissingException[[bogus] missing]"))
784 describe "document API" $ do
785 it "indexes, updates, gets, and then deletes the generated document" $ withTestEnv $ do
786 _ <- insertData
787 _ <- updateData
788 docInserted <- getDocument testIndex testMapping (DocId "1")
789 let newTweet = eitherDecode
790 (responseBody docInserted) :: Either String (EsResult Tweet)
791 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just patchedTweet))
793 it "indexes, gets, and then deletes the generated document with a DocId containing a space" $ withTestEnv $ do
794 _ <- insertWithSpaceInId
795 docInserted <- getDocument testIndex testMapping (DocId "Hello World")
796 let newTweet = eitherDecode
797 (responseBody docInserted) :: Either String (EsResult Tweet)
798 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))
800 it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do
801 doc <- getDocument testIndex testMapping (DocId "bogus")
802 let noTweet = eitherDecode
803 (responseBody doc) :: Either String (EsResult Tweet)
804 liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing
806 it "can use optimistic concurrency control" $ withTestEnv $ do
807 let ev = ExternalDocVersion minBound
808 let cfg = defaultIndexDocumentSettings { idsVersionControl = ExternalGT ev }
809 resetIndex
810 res <- insertData' cfg
811 liftIO $ isCreated res `shouldBe` True
812 res' <- insertData' cfg
813 liftIO $ isVersionConflict res' `shouldBe` True
815 it "indexes two documents in a parent/child relationship and checks that the child exists" $ withTestEnv $ do
816 resetIndex
817 _ <- putMapping testIndex (MappingName "parent") ParentMapping
818 _ <- putMapping testIndex (MappingName "child") ChildMapping
819 _ <- indexDocument testIndex (MappingName "parent") defaultIndexDocumentSettings exampleTweet (DocId "1")
820 let parent = (Just . DocumentParent . DocId) "1"
821 ids = IndexDocumentSettings NoVersionControl parent
822 _ <- indexDocument testIndex (MappingName "child") ids otherTweet (DocId "2")
823 _ <- refreshIndex testIndex
824 exists <- documentExists testIndex (MappingName "child") parent (DocId "2")
825 liftIO $ exists `shouldBe` True
827 describe "template API" $ do
828 it "can create a template" $ withTestEnv $ do
829 let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
830 resp <- putTemplate idxTpl (TemplateName "tweet-tpl")
831 liftIO $ validateStatus resp 200
833 it "can detect if a template exists" $ withTestEnv $ do
834 exists <- templateExists (TemplateName "tweet-tpl")
835 liftIO $ exists `shouldBe` True
837 it "can delete a template" $ withTestEnv $ do
838 resp <- deleteTemplate (TemplateName "tweet-tpl")
839 liftIO $ validateStatus resp 200
841 it "can detect if a template doesn't exist" $ withTestEnv $ do
842 exists <- templateExists (TemplateName "tweet-tpl")
843 liftIO $ exists `shouldBe` False
845 describe "bulk API" $ do
846 it "inserts all documents we request" $ withTestEnv $ do
847 _ <- insertData
848 let firstTest = BulkTest "blah"
849 let secondTest = BulkTest "bloo"
850 let firstDoc = BulkIndex testIndex
851 testMapping (DocId "2") (toJSON firstTest)
852 let secondDoc = BulkCreate testIndex
853 testMapping (DocId "3") (toJSON secondTest)
854 let stream = V.fromList [firstDoc, secondDoc]
855 _ <- bulk stream
856 _ <- refreshIndex testIndex
857 fDoc <- getDocument testIndex testMapping (DocId "2")
858 sDoc <- getDocument testIndex testMapping (DocId "3")
859 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
860 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
861 liftIO $ do
862 fmap getSource maybeFirst `shouldBe` Right (Just firstTest)
863 fmap getSource maybeSecond `shouldBe` Right (Just secondTest)
866 describe "query API" $ do
867 it "returns document for term query and identity filter" $ withTestEnv $ do
868 _ <- insertData
869 let query = TermQuery (Term "user" "bitemyapp") Nothing
870 let filter = IdentityFilter <&&> IdentityFilter
871 let search = mkSearch (Just query) (Just filter)
872 myTweet <- searchTweet search
873 liftIO $
874 myTweet `shouldBe` Right exampleTweet
876 it "handles constant score queries" $ withTestEnv $ do
877 _ <- insertData
878 let query = TermsQuery "user" ("bitemyapp" :| [])
879 let cfQuery = ConstantScoreQuery query (Boost 1.0)
880 let filter = IdentityFilter
881 let search = mkSearch (Just cfQuery) (Just filter)
882 myTweet <- searchTweet search
883 liftIO $
884 myTweet `shouldBe` Right exampleTweet
885 it "handles constant score filters" $ withTestEnv $ do
886 _ <- insertData
887 let query = TermsQuery "user" ("bitemyapp" :| [])
888 let cfFilter = ConstantScoreFilter IdentityFilter (Boost 1.0)
889 let boolQuery = mkBoolQuery [query, cfFilter] [] []
890 let search = mkSearch (Just (QueryBoolQuery boolQuery)) Nothing
891 myTweet <- searchTweet search
892 liftIO $
893 myTweet `shouldBe` Right exampleTweet
896 it "returns document for terms query and identity filter" $ withTestEnv $ do
897 _ <- insertData
898 let query = TermsQuery "user" ("bitemyapp" :| [])
899 let filter = IdentityFilter <&&> IdentityFilter
900 let search = mkSearch (Just query) (Just filter)
901 myTweet <- searchTweet search
902 liftIO $
903 myTweet `shouldBe` Right exampleTweet
905 it "returns document for match query" $ withTestEnv $ do
906 _ <- insertData
907 let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
908 let search = mkSearch (Just query) Nothing
909 myTweet <- searchTweet search
910 liftIO $
911 myTweet `shouldBe` Right exampleTweet
913 it "returns document for multi-match query" $ withTestEnv $ do
914 _ <- insertData
915 let flds = [FieldName "user", FieldName "message"]
916 let query = QueryMultiMatchQuery $ mkMultiMatchQuery flds (QueryString "bitemyapp")
917 let search = mkSearch (Just query) Nothing
918 myTweet <- searchTweet search
919 liftIO $
920 myTweet `shouldBe` Right exampleTweet
922 it "returns document for bool query" $ withTestEnv $ do
923 _ <- insertData
924 let innerQuery = QueryMatchQuery $
925 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
926 let query = QueryBoolQuery $
927 mkBoolQuery [innerQuery] [] []
928 let search = mkSearch (Just query) Nothing
929 myTweet <- searchTweet search
930 liftIO $
931 myTweet `shouldBe` Right exampleTweet
933 it "returns document for boosting query" $ withTestEnv $ do
934 _ <- insertData
935 let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
936 let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
937 let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
938 let search = mkSearch (Just query) Nothing
939 myTweet <- searchTweet search
940 liftIO $
941 myTweet `shouldBe` Right exampleTweet
943 it "returns document for common terms query" $ withTestEnv $ do
944 _ <- insertData
945 let query = QueryCommonTermsQuery $
946 CommonTermsQuery (FieldName "user")
947 (QueryString "bitemyapp")
948 (CutoffFrequency 0.0001)
949 Or Or Nothing Nothing Nothing Nothing
950 let search = mkSearch (Just query) Nothing
951 myTweet <- searchTweet search
952 liftIO $
953 myTweet `shouldBe` Right exampleTweet
956 describe "sorting" $ do
957 it "returns documents in the right order" $ withTestEnv $ do
958 _ <- insertData
959 _ <- insertOther
960 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
961 let search = Search Nothing
962 (Just IdentityFilter) (Just [sortSpec]) Nothing Nothing
963 False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
964 result <- searchTweets search
965 let myTweet = grabFirst result
966 liftIO $
967 myTweet `shouldBe` Right otherTweet
970 describe "filtering API" $ do
971 it "returns document for composed boolmatch and identity" $ withTestEnv $ do
972 _ <- insertData
973 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
974 <&&> IdentityFilter
975 let search = mkSearch Nothing (Just queryFilter)
976 myTweet <- searchTweet search
977 liftIO $
978 myTweet `shouldBe` Right exampleTweet
980 it "returns document for term filter" $ withTestEnv $ do
981 _ <- insertData
982 let termFilter = TermFilter (Term "user" "bitemyapp") False
983 let search = mkSearch Nothing (Just termFilter)
984 myTweet <- searchTweet search
985 liftIO $
986 myTweet `shouldBe` Right exampleTweet
988 it "returns document for existential filter" $ withTestEnv $ do
989 _ <- insertData
990 let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
991 myTweet <- searchTweet search
992 liftIO $
993 myTweet `shouldBe` Right exampleTweet
995 it "returns document for geo boundingbox filter" $ withTestEnv $ do
996 _ <- insertData
997 let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
998 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
999 let geoFilter = GeoBoundingBoxFilter bbConstraint
1000 let search = mkSearch Nothing (Just geoFilter)
1001 myTweet <- searchTweet search
1002 liftIO $
1003 myTweet `shouldBe` Right exampleTweet
1005 it "doesn't return document for nonsensical boundingbox filter" $ withTestEnv $ do
1006 _ <- insertData
1007 let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
1008 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
1009 let geoFilter = GeoBoundingBoxFilter bbConstraint
1010 let search = mkSearch Nothing (Just geoFilter)
1011 searchExpectNoResults search
1013 it "returns document for geo distance filter" $ withTestEnv $ do
1014 _ <- insertData
1015 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1016 let distance = Distance 10.0 Miles
1017 let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
1018 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
1019 let search = mkSearch Nothing (Just geoFilter)
1020 myTweet <- searchTweet search
1021 liftIO $
1022 myTweet `shouldBe` Right exampleTweet
1024 it "returns document for geo distance range filter" $ withTestEnv $ do
1025 _ <- insertData
1026 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1027 let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
1028 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
1029 let search = mkSearch Nothing (Just geoFilter)
1030 myTweet <- searchTweet search
1031 liftIO $
1032 myTweet `shouldBe` Right exampleTweet
1034 it "doesn't return document for wild geo distance range filter" $ withTestEnv $ do
1035 _ <- insertData
1036 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1037 let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
1038 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
1039 let search = mkSearch Nothing (Just geoFilter)
1040 searchExpectNoResults search
1042 it "returns document for geo polygon filter" $ withTestEnv $ do
1043 _ <- insertData
1044 let points = [LatLon 40.0 (-70.00),
1045 LatLon 40.0 (-72.00),
1046 LatLon 41.0 (-70.00),
1047 LatLon 41.0 (-72.00)]
1048 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
1049 let search = mkSearch Nothing (Just geoFilter)
1050 myTweet <- searchTweet search
1051 liftIO $
1052 myTweet `shouldBe` Right exampleTweet
1054 it "doesn't return document for bad geo polygon filter" $ withTestEnv $ do
1055 _ <- insertData
1056 let points = [LatLon 40.0 (-70.00),
1057 LatLon 40.0 (-71.00),
1058 LatLon 41.0 (-70.00),
1059 LatLon 41.0 (-71.00)]
1060 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
1061 let search = mkSearch Nothing (Just geoFilter)
1062 searchExpectNoResults search
1064 it "returns document for ids filter" $ withTestEnv $ do
1065 _ <- insertData
1066 let filter = IdsFilter (MappingName "tweet") [DocId "1"]
1067 let search = mkSearch Nothing (Just filter)
1068 myTweet <- searchTweet search
1069 liftIO $
1070 myTweet `shouldBe` Right exampleTweet
1072 it "returns document for Double range filter" $ withTestEnv $ do
1073 _ <- insertData
1074 let filter = RangeFilter (FieldName "age")
1075 (RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))
1076 RangeExecutionIndex False
1077 let search = mkSearch Nothing (Just filter)
1078 myTweet <- searchTweet search
1079 liftIO $
1080 myTweet `shouldBe` Right exampleTweet
1082 it "returns document for UTCTime date filter" $ withTestEnv $ do
1083 _ <- insertData
1084 let filter = RangeFilter (FieldName "postDate")
1085 (RangeDateGtLt
1086 (GreaterThanD (UTCTime
1087 (ModifiedJulianDay 54000)
1088 (secondsToDiffTime 0)))
1089 (LessThanD (UTCTime
1090 (ModifiedJulianDay 55000)
1091 (secondsToDiffTime 11))))
1092 RangeExecutionIndex False
1093 let search = mkSearch Nothing (Just filter)
1094 myTweet <- searchTweet search
1095 liftIO $
1096 myTweet `shouldBe` Right exampleTweet
1098 it "returns document for regexp filter" $ withTestEnv $ do
1099 _ <- insertData
1100 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
1101 AllRegexpFlags (CacheName "test") False (CacheKey "key")
1102 let search = mkSearch Nothing (Just filter)
1103 myTweet <- searchTweet search
1104 liftIO $
1105 myTweet `shouldBe` Right exampleTweet
1107 it "doesn't return document for non-matching regexp filter" $ withTestEnv $ do
1108 _ <- insertData
1109 let filter = RegexpFilter (FieldName "user")
1110 (Regexp "boy") AllRegexpFlags
1111 (CacheName "test") False (CacheKey "key")
1112 let search = mkSearch Nothing (Just filter)
1113 searchExpectNoResults search
1115 it "returns document for query filter, uncached" $ withTestEnv $ do
1116 _ <- insertData
1117 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) True
1118 search = mkSearch Nothing (Just filter)
1119 myTweet <- searchTweet search
1120 liftIO $ myTweet `shouldBe` Right exampleTweet
1122 it "returns document for query filter, cached" $ withTestEnv $ do
1123 _ <- insertData
1124 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) False
1125 search = mkSearch Nothing (Just filter)
1126 myTweet <- searchTweet search
1127 liftIO $ myTweet `shouldBe` Right exampleTweet
1129 describe "Aggregation API" $ do
1130 it "returns term aggregation results" $ withTestEnv $ do
1131 _ <- insertData
1132 let terms = TermsAgg $ mkTermsAggregation "user"
1133 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1134 searchExpectAggs search
1135 searchValidBucketAgg search "users" toTerms
1137 it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
1138 _ <- insertData
1139 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
1140 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1141 searchExpectAggs search
1142 searchValidBucketAgg search "users" toTerms
1144 it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
1145 _ <- insertData
1146 searchTermsAggHint [Map, Ordinals]
1148 it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do
1149 _ <- insertData
1150 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
1152 it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
1153 _ <- insertData
1154 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
1157 it "can execute value_count aggregations" $ withTestEnv $ do
1158 _ <- insertData
1159 _ <- insertOther
1160 let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>
1161 mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))
1162 let search = mkAggregateSearch Nothing ags
1163 let docCountPair k n = (k, object ["value" .= Number n])
1164 res <- searchTweets search
1165 liftIO $
1166 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2
1167 , docCountPair "bogus_count" 0
1168 ]))
1170 it "can execute filter aggregations" $ withTestEnv $ do
1171 _ <- insertData
1172 _ <- insertOther
1173 let ags = mkAggregations "bitemyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "bitemyapp") defaultCache) Nothing)) <>
1174 mkAggregations "notmyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "notmyapp") defaultCache) Nothing))
1175 let search = mkAggregateSearch Nothing ags
1176 let docCountPair k n = (k, object ["doc_count" .= Number n])
1177 res <- searchTweets search
1178 liftIO $
1179 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "bitemyapps" 1
1180 , docCountPair "notmyapps" 1
1181 ]))
1182 it "can execute date_range aggregations" $ withTestEnv $ do
1183 let now = fromGregorian 2015 3 14
1184 let ltAMonthAgo = UTCTime (fromGregorian 2015 3 1) 0
1185 let ltAWeekAgo = UTCTime (fromGregorian 2015 3 10) 0
1186 let oldDoc = exampleTweet { postDate = ltAMonthAgo }
1187 let newDoc = exampleTweet { postDate = ltAWeekAgo }
1188 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings oldDoc (DocId "1")
1189 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings newDoc (DocId "2")
1190 _ <- refreshIndex testIndex
1191 let thisMonth = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMMonth])
1192 let thisWeek = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMWeek])
1193 let agg = DateRangeAggregation (FieldName "postDate") Nothing (thisMonth :| [thisWeek])
1194 let ags = mkAggregations "date_ranges" (DateRangeAgg agg)
1195 let search = mkAggregateSearch Nothing ags
1196 res <- searchTweets search
1197 liftIO $ hitsTotal . searchHits <$> res `shouldBe` Right 2
1198 let bucks = do magrs <- fmapL show (aggregations <$> res)
1199 agrs <- note "no aggregations returned" magrs
1200 rawBucks <- note "no date_ranges aggregation" $ M.lookup "date_ranges" agrs
1201 parseEither parseJSON rawBucks
1202 let fromMonthT = UTCTime (fromGregorian 2015 2 14) 0
1203 let fromWeekT = UTCTime (fromGregorian 2015 3 7) 0
1204 liftIO $ buckets <$> bucks `shouldBe` Right [ DateRangeResult "2015-02-14T00:00:00.000Z-*"
1205 (Just fromMonthT)
1206 (Just "2015-02-14T00:00:00.000Z")
1207 Nothing
1208 Nothing
1210 Nothing
1211 , DateRangeResult "2015-03-07T00:00:00.000Z-*"
1212 (Just fromWeekT)
1213 (Just "2015-03-07T00:00:00.000Z")
1214 Nothing
1215 Nothing
1217 Nothing
1220 it "returns date histogram aggregation results" $ withTestEnv $ do
1221 _ <- insertData
1222 let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
1223 let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
1224 searchExpectAggs search
1225 searchValidBucketAgg search "byDate" toDateHistogram
1227 it "returns date histogram using fractional date" $ withTestEnv $ do
1228 _ <- insertData
1229 let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]
1230 let fractionals = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]
1231 let intervals = periods ++ fractionals
1232 let histogram = mkDateHistogram (FieldName "postDate")
1233 let search interval = mkAggregateSearch Nothing $ mkAggregations "byDate" $ DateHistogramAgg (histogram interval)
1234 let expect interval = searchExpectAggs (search interval)
1235 let valid interval = searchValidBucketAgg (search interval) "byDate" toDateHistogram
1236 forM_ intervals expect
1237 forM_ intervals valid
1239 describe "Highlights API" $ do
1241 it "returns highlight from query when there should be one" $ withTestEnv $ do
1242 _ <- insertData
1243 _ <- insertOther
1244 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1245 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
1247 let search = mkHighlightSearch (Just query) testHighlight
1248 myHighlight <- searchTweetHighlight search
1249 liftIO $
1250 myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
1252 it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
1253 _ <- insertData
1254 _ <- insertOther
1255 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1256 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "user") Nothing]
1258 let search = mkHighlightSearch (Just query) testHighlight
1259 myHighlight <- searchTweetHighlight search
1260 liftIO $
1261 myHighlight `shouldBe` Right Nothing
1263 describe "Source filtering" $ do
1265 it "doesn't include source when sources are disabled" $ withTestEnv $ do
1266 searchExpectSource
1267 NoSource
1268 (Left (EsError 500 "Source was missing"))
1270 it "includes a source" $ withTestEnv $ do
1271 searchExpectSource
1272 (SourcePatterns (PopPattern (Pattern "message")))
1273 (Right (Object (HM.fromList [("message", String "Use haskell!")])))
1275 it "includes sources" $ withTestEnv $ do
1276 searchExpectSource
1277 (SourcePatterns (PopPatterns [Pattern "user", Pattern "message"]))
1278 (Right (Object (HM.fromList [("user",String "bitemyapp"),("message", String "Use haskell!")])))
1280 it "includes source patterns" $ withTestEnv $ do
1281 searchExpectSource
1282 (SourcePatterns (PopPattern (Pattern "*ge")))
1283 (Right (Object (HM.fromList [("age", Number 10000),("message", String "Use haskell!")])))
1285 it "excludes source patterns" $ withTestEnv $ do
1286 searchExpectSource
1287 (SourceIncludeExclude (Include []) (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate"]))
1288 (Right (Object (HM.fromList [("user",String "bitemyapp")])))
1290 describe "ToJSON RegexpFlags" $ do
1291 it "generates the correct JSON for AllRegexpFlags" $
1292 toJSON AllRegexpFlags `shouldBe` String "ALL"
1294 it "generates the correct JSON for NoRegexpFlags" $
1295 toJSON NoRegexpFlags `shouldBe` String "NONE"
1297 it "generates the correct JSON for SomeRegexpFlags" $
1298 let flags = AnyString :| [ Automaton
1299 , Complement
1300 , Empty
1301 , Intersection
1302 , Interval ]
1303 in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
1305 prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
1306 let String str = toJSON flags
1307 flagStrs = T.splitOn "|" str
1308 in noDuplicates flagStrs
1310 describe "omitNulls" $ do
1311 it "checks that omitNulls drops list elements when it should" $
1312 let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))
1313 , "test2" .= (toJSON ("some value" :: Text))]
1314 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1316 it "checks that omitNulls doesn't drop list elements when it shouldn't" $
1317 let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))
1318 , "test2" .= (toJSON ("some value" :: Text))]
1319 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))
1320 , ("test2", String "some value")])
1321 it "checks that omitNulls drops non list elements when it should" $
1322 let dropped = omitNulls $ [ "test1" .= (toJSON Null)
1323 , "test2" .= (toJSON ("some value" :: Text))]
1324 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1325 it "checks that omitNulls doesn't drop non list elements when it shouldn't" $
1326 let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
1327 , "test2" .= (toJSON ("some value" :: Text))]
1328 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
1329 , ("test2", String "some value")])
1330 describe "Monoid (SearchHits a)" $ do
1331 prop "abides the monoid laws" $ eq $
1332 prop_Monoid (T :: T (SearchHits ()))
1334 describe "mkDocVersion" $ do
1335 prop "can never construct an out of range docVersion" $ \i ->
1336 let res = mkDocVersion i
1337 in case res of
1338 Nothing -> property True
1339 Just dv -> (dv >= minBound) .&&.
1340 (dv <= maxBound) .&&.
1341 docVersionNumber dv === i
1343 describe "Enum DocVersion" $ do
1344 it "follows the laws of Enum, Bounded" $ do
1345 evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall
1346 evaluate (pred minBound :: DocVersion) `shouldThrow` anyErrorCall
1347 evaluate (toEnum 0 :: DocVersion) `shouldThrow` anyErrorCall
1348 evaluate (toEnum 9200000000000000001 :: DocVersion) `shouldThrow` anyErrorCall
1349 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1350 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1351 enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]
1353 describe "scan&scroll API" $ do
1354 it "returns documents using the scan&scroll API" $ withTestEnv $ do
1355 _ <- insertData
1356 _ <- insertOther
1357 let search = (mkSearch (Just $ MatchAllQuery Nothing) Nothing) { size = (Size 1) }
1358 regular_search <- searchTweet search
1359 scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet]
1360 let scan_search = map hitSource scan_search'
1361 liftIO $
1362 regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored
1363 liftIO $
1364 scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]
1366 describe "index aliases" $ do
1367 it "handles the simple case of aliasing an existing index" $ do
1368 let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1369 let create = IndexAliasCreate Nothing Nothing
1370 let action = AddAlias alias create
1372 withTestEnv $ do
1373 resetIndex
1374 resp <- updateIndexAliases (action :| [])
1375 liftIO $ validateStatus resp 200
1376 let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1377 (do aliases <- withTestEnv getIndexAliases
1378 let expected = IndexAliasSummary alias create
1379 case aliases of
1380 Right (IndexAliasesSummary summs) ->
1381 L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1382 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1384 it "handles an alias with routing and a filter" $ do
1385 let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1386 let sar = SearchAliasRouting (RoutingValue "search val" :| [])
1387 let iar = IndexAliasRouting (RoutingValue "index val")
1388 let routing = GranularAliasRouting (Just sar) (Just iar)
1389 let filter = LimitFilter 42
1390 let create = IndexAliasCreate (Just routing) (Just filter)
1391 let action = AddAlias alias create
1393 withTestEnv $ do
1394 resetIndex
1395 resp <- updateIndexAliases (action :| [])
1396 liftIO $ validateStatus resp 200
1397 let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1398 (do aliases <- withTestEnv getIndexAliases
1399 let expected = IndexAliasSummary alias create
1400 case aliases of
1401 Right (IndexAliasesSummary summs) ->
1402 L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1403 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1405 describe "Index Settings" $ do
1406 it "persists settings" $ withTestEnv $ do
1407 _ <- deleteExampleIndex
1408 _ <- createExampleIndex
1409 let updates = BlocksWrite False :| []
1410 updateResp <- updateIndexSettings updates testIndex
1411 liftIO $ validateStatus updateResp 200
1412 getResp <- getIndexSettings testIndex
1413 liftIO $
1414 getResp `shouldBe` Right (IndexSettingsSummary
1415 testIndex
1416 (IndexSettings (ShardCount 1) (ReplicaCount 0))
1417 (NE.toList updates))
1419 describe "JSON instances" $ do
1420 propJSON (Proxy :: Proxy Version)
1421 propJSON (Proxy :: Proxy IndexName)
1422 propJSON (Proxy :: Proxy MappingName)
1423 propJSON (Proxy :: Proxy DocId)
1424 propJSON (Proxy :: Proxy IndexAliasRouting)
1425 propJSON (Proxy :: Proxy RoutingValue)
1426 propJSON (Proxy :: Proxy ShardCount)
1427 propJSON (Proxy :: Proxy ReplicaCount)
1428 propJSON (Proxy :: Proxy TemplateName)
1429 propJSON (Proxy :: Proxy TemplatePattern)
1430 propJSON (Proxy :: Proxy QueryString)
1431 propJSON (Proxy :: Proxy FieldName)
1432 propJSON (Proxy :: Proxy CacheName)
1433 propJSON (Proxy :: Proxy CacheKey)
1434 propJSON (Proxy :: Proxy Existence)
1435 propJSON (Proxy :: Proxy CutoffFrequency)
1436 propJSON (Proxy :: Proxy Analyzer)
1437 propJSON (Proxy :: Proxy MaxExpansions)
1438 propJSON (Proxy :: Proxy Lenient)
1439 propJSON (Proxy :: Proxy Tiebreaker)
1440 propJSON (Proxy :: Proxy Boost)
1441 propJSON (Proxy :: Proxy BoostTerms)
1442 propJSON (Proxy :: Proxy MinimumMatch)
1443 propJSON (Proxy :: Proxy DisableCoord)
1444 propJSON (Proxy :: Proxy IgnoreTermFrequency)
1445 propJSON (Proxy :: Proxy MinimumTermFrequency)
1446 propJSON (Proxy :: Proxy MaxQueryTerms)
1447 propJSON (Proxy :: Proxy Fuzziness)
1448 propJSON (Proxy :: Proxy PrefixLength)
1449 propJSON (Proxy :: Proxy TypeName)
1450 propJSON (Proxy :: Proxy PercentMatch)
1451 propJSON (Proxy :: Proxy StopWord)
1452 propJSON (Proxy :: Proxy QueryPath)
1453 propJSON (Proxy :: Proxy AllowLeadingWildcard)
1454 propJSON (Proxy :: Proxy LowercaseExpanded)
1455 propJSON (Proxy :: Proxy EnablePositionIncrements)
1456 propJSON (Proxy :: Proxy AnalyzeWildcard)
1457 propJSON (Proxy :: Proxy GeneratePhraseQueries)
1458 propJSON (Proxy :: Proxy Locale)
1459 propJSON (Proxy :: Proxy MaxWordLength)
1460 propJSON (Proxy :: Proxy MinWordLength)
1461 propJSON (Proxy :: Proxy PhraseSlop)
1462 propJSON (Proxy :: Proxy MinDocFrequency)
1463 propJSON (Proxy :: Proxy MaxDocFrequency)
1464 propJSON (Proxy :: Proxy Filter)
1465 propJSON (Proxy :: Proxy Query)
1466 propJSON (Proxy :: Proxy SimpleQueryStringQuery)
1467 propJSON (Proxy :: Proxy FieldOrFields)
1468 propJSON (Proxy :: Proxy SimpleQueryFlag)
1469 propJSON (Proxy :: Proxy RegexpQuery)
1470 propJSON (Proxy :: Proxy QueryStringQuery)
1471 propJSON (Proxy :: Proxy RangeQuery)
1472 propJSON (Proxy :: Proxy PrefixQuery)
1473 propJSON (Proxy :: Proxy NestedQuery)
1474 propJSON (Proxy :: Proxy MoreLikeThisFieldQuery)
1475 propJSON (Proxy :: Proxy MoreLikeThisQuery)
1476 propJSON (Proxy :: Proxy IndicesQuery)
1477 propJSON (Proxy :: Proxy HasParentQuery)
1478 propJSON (Proxy :: Proxy HasChildQuery)
1479 propJSON (Proxy :: Proxy FuzzyQuery)
1480 propJSON (Proxy :: Proxy FuzzyLikeFieldQuery)
1481 propJSON (Proxy :: Proxy FuzzyLikeThisQuery)
1482 propJSON (Proxy :: Proxy FilteredQuery)
1483 propJSON (Proxy :: Proxy DisMaxQuery)
1484 propJSON (Proxy :: Proxy CommonTermsQuery)
1485 propJSON (Proxy :: Proxy CommonMinimumMatch)
1486 propJSON (Proxy :: Proxy BoostingQuery)
1487 propJSON (Proxy :: Proxy BoolQuery)
1488 propJSON (Proxy :: Proxy MatchQuery)
1489 propJSON (Proxy :: Proxy MultiMatchQueryType)
1490 propJSON (Proxy :: Proxy BooleanOperator)
1491 propJSON (Proxy :: Proxy ZeroTermsQuery)
1492 propJSON (Proxy :: Proxy MatchQueryType)
1493 propJSON (Proxy :: Proxy AliasRouting)
1494 propJSON (Proxy :: Proxy IndexAliasCreate)
1495 propJSON (Proxy :: Proxy SearchAliasRouting)
1496 propJSON (Proxy :: Proxy ScoreType)
1497 propJSON (Proxy :: Proxy Distance)
1498 propJSON (Proxy :: Proxy DistanceUnit)
1499 propJSON (Proxy :: Proxy DistanceType)
1500 propJSON (Proxy :: Proxy OptimizeBbox)
1501 propJSON (Proxy :: Proxy GeoBoundingBoxConstraint)
1502 propJSON (Proxy :: Proxy GeoFilterType)
1503 propJSON (Proxy :: Proxy GeoBoundingBox)
1504 propJSON (Proxy :: Proxy LatLon)
1505 propJSON (Proxy :: Proxy RangeExecution)
1506 prop "RegexpFlags FromJSON/ToJSON roundtrips, removing dups " $ \rfs ->
1507 let expected = case rfs of
1508 SomeRegexpFlags fs -> SomeRegexpFlags (NE.fromList (nub (NE.toList fs)))
1509 x -> x
1510 in parseEither parseJSON (toJSON rfs) === Right expected
1511 propJSON (Proxy :: Proxy BoolMatch)
1512 propJSON (Proxy :: Proxy Term)
1513 propJSON (Proxy :: Proxy MultiMatchQuery)
1514 propJSON (Proxy :: Proxy IndexSettings)
1515 propJSON (Proxy :: Proxy UpdatableIndexSetting)
1516 propJSON (Proxy :: Proxy ReplicaBounds)
1517 propJSON (Proxy :: Proxy Bytes)
1518 propJSON (Proxy :: Proxy AllocationPolicy)
1519 propJSON (Proxy :: Proxy InitialShardCount)
1520 propJSON (Proxy :: Proxy FSType)
1521 propJSON (Proxy :: Proxy CompoundFormat)