git.iko.soy/typeable/bloodhound
on fc6fe99 help sign in
typeable/bloodhound/tests/V1/tests.hs
1905 lines 88 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DefaultSignatures #-}
3{-# LANGUAGE DeriveDataTypeable #-}
4{-# LANGUAGE DeriveGeneric #-}
5{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7{-# LANGUAGE OverloadedStrings #-}
8{-# LANGUAGE RecordWildCards #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE TypeOperators #-}
11{-# OPTIONS_GHC -fno-warn-orphans #-}
12#if __GLASGOW_HASKELL__ < 800
13{-# OPTIONS_GHC -fcontext-stack=100 #-}
14#endif
15module Main where
17import Control.Applicative
18import Control.Error
19import Control.Exception (evaluate)
20import Control.Monad
21import Control.Monad.Catch
22import Control.Monad.Reader
23import Data.Aeson
24import Data.Aeson.Types (parseEither)
25import qualified Data.ByteString.Lazy.Char8 as BL8
26import qualified Data.HashMap.Strict as HM
27import Data.List (nub)
28import qualified Data.List as L
29import Data.List.NonEmpty (NonEmpty (..))
30import qualified Data.List.NonEmpty as NE
31import qualified Data.Map.Strict as M
32import Data.Monoid
33import Data.Ord (comparing)
34import Data.Proxy
35import Data.Text (Text)
36import qualified Data.Text as T
37import Data.Time.Calendar (Day (..), fromGregorian)
38import Data.Time.Clock (NominalDiffTime, UTCTime (..),
39 secondsToDiffTime)
40import Data.Typeable
41import qualified Data.Vector as V
42import qualified Data.Version as Vers
43import Database.V1.Bloodhound
44import GHC.Generics as G
45import Network.HTTP.Client hiding (Proxy)
46import qualified Network.HTTP.Types.Method as NHTM
47import qualified Network.HTTP.Types.Status as NHTS
48import qualified Network.URI as URI
49import Prelude hiding (filter)
50import System.IO.Temp
51import System.PosixCompat.Files
52import Test.Hspec
53import Test.QuickCheck.Property.Monoid (T (..), eq, prop_Monoid)
55import Test.Hspec.QuickCheck (prop)
56import Test.QuickCheck
58import qualified Generics.SOP as SOP
59import qualified Generics.SOP.GGP as SOP
61testServer :: Server
62testServer = Server "http://localhost:9200"
63testIndex :: IndexName
64testIndex = IndexName "bloodhound-tests-twitter-1"
65testMapping :: MappingName
66testMapping = MappingName "tweet"
68withTestEnv :: BH IO a -> IO a
69withTestEnv = withBH defaultManagerSettings testServer
71validateStatus :: Show body => Response body -> Int -> Expectation
72validateStatus resp expected =
73 if actual == expected
74 then return ()
75 else expectationFailure ("Expected " <> show expected <> " but got " <> show actual <> ": " <> show body)
76 where
77 actual = NHTS.statusCode (responseStatus resp)
78 body = responseBody resp
80createExampleIndex :: (MonadBH m) => m Reply
81createExampleIndex = createIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) testIndex
82deleteExampleIndex :: (MonadBH m) => m Reply
83deleteExampleIndex = deleteIndex testIndex
85es13 :: Vers.Version
86es13 = Vers.Version [1, 3, 0] []
88es12 :: Vers.Version
89es12 = Vers.Version [1, 2, 0] []
91es11 :: Vers.Version
92es11 = Vers.Version [1, 1, 0] []
94es14 :: Vers.Version
95es14 = Vers.Version [1, 4, 0] []
97es15 :: Vers.Version
98es15 = Vers.Version [1, 5, 0] []
100es16 :: Vers.Version
101es16 = Vers.Version [1, 6, 0] []
103es20 :: Vers.Version
104es20 = Vers.Version [2, 0, 0] []
106getServerVersion :: IO (Maybe Vers.Version)
107getServerVersion = fmap extractVersion <$> withTestEnv getStatus
108 where
109 extractVersion = versionNumber . number . version
111-- | Get configured repo paths for snapshotting. Note that by default
112-- this is not enabled and if we are over es 1.5, we won't be able to
113-- test snapshotting. Note that this can and should be part of the
114-- client functionality in a much less ad-hoc incarnation.
115getRepoPaths :: IO [FilePath]
116getRepoPaths = withTestEnv $ do
117 bhe <- getBHEnv
118 let Server s = bhServer bhe
119 let tUrl = s <> "/" <> "_nodes"
120 initReq <- parseRequest (URI.escapeURIString URI.isAllowedInURI (T.unpack tUrl))
121 let req = setRequestIgnoreStatus $ initReq { method = NHTM.methodGet }
122 Right (Object o) <- parseEsResponse =<< liftIO (httpLbs req (bhManager bhe))
123 return $ fromMaybe mempty $ do
124 Object nodes <- HM.lookup "nodes" o
125 Object firstNode <- snd <$> headMay (HM.toList nodes)
126 Object settings <- HM.lookup "settings" firstNode
127 Object path <- HM.lookup "path" settings
128 Array repo <- HM.lookup "repo" path
129 return [ T.unpack t | String t <- V.toList repo]
131-- | 1.5 and earlier don't care about repo paths
132canSnapshot :: IO Bool
133canSnapshot = do
134 caresAboutRepos <- atleast es16
135 repoPaths <- getRepoPaths
136 return (not caresAboutRepos || not (null (repoPaths)))
138atleast :: Vers.Version -> IO Bool
139atleast v = getServerVersion >>= \x -> return $ x >= Just v
141atmost :: Vers.Version -> IO Bool
142atmost v = getServerVersion >>= \x -> return $ x <= Just v
144is :: Vers.Version -> IO Bool
145is v = getServerVersion >>= \x -> return $ x == Just v
147when' :: Monad m => m Bool -> m () -> m ()
148when' b f = b >>= \x -> when x f
150(==~) :: (ApproxEq a) => a -> a -> Property
151a ==~ b = counterexample (showApproxEq a ++ " !=~ " ++ showApproxEq b) (a =~ b)
153propJSON :: forall a. (Arbitrary a, ToJSON a, FromJSON a, Show a, ApproxEq a, Typeable a) => Proxy a -> Spec
154propJSON _ = prop testName $ \(a :: a) ->
155 let jsonStr = "via " <> BL8.unpack (encode a)
156 in counterexample jsonStr (parseEither parseJSON (toJSON a) ==~ Right a)
157 where testName = show ty <> " FromJSON/ToJSON roundtrips"
158 ty = typeOf (undefined :: a)
160data Location = Location { lat :: Double
161 , lon :: Double } deriving (Eq, Generic, Show)
163data Tweet = Tweet { user :: Text
164 , postDate :: UTCTime
165 , message :: Text
166 , age :: Int
167 , location :: Location
168 , extra :: Maybe Text }
169 deriving (Eq, Generic, Show)
171instance ToJSON Tweet where
172 toJSON = genericToJSON defaultOptions
173instance FromJSON Tweet where
174 parseJSON = genericParseJSON defaultOptions
175instance ToJSON Location where
176 toJSON = genericToJSON defaultOptions
177instance FromJSON Location where
178 parseJSON = genericParseJSON defaultOptions
180data ParentMapping = ParentMapping deriving (Eq, Show)
182instance ToJSON ParentMapping where
183 toJSON ParentMapping =
184 object ["properties" .=
185 object [ "user" .= object ["type" .= ("string" :: Text)]
186 -- Serializing the date as a date is breaking other tests, mysteriously.
187 -- , "postDate" .= object [ "type" .= ("date" :: Text)
188 -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
189 , "message" .= object ["type" .= ("string" :: Text)]
190 , "age" .= object ["type" .= ("integer" :: Text)]
191 , "location" .= object ["type" .= ("geo_point" :: Text)]
192 ]]
194data ChildMapping = ChildMapping deriving (Eq, Show)
196instance ToJSON ChildMapping where
197 toJSON ChildMapping =
198 object ["_parent" .= object ["type" .= ("parent" :: Text)]
199 , "properties" .=
200 object [ "user" .= object ["type" .= ("string" :: Text)]
201 -- Serializing the date as a date is breaking other tests, mysteriously.
202 -- , "postDate" .= object [ "type" .= ("date" :: Text)
203 -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
204 , "message" .= object ["type" .= ("string" :: Text)]
205 , "age" .= object ["type" .= ("integer" :: Text)]
206 , "location" .= object ["type" .= ("geo_point" :: Text)]
207 ]]
209data TweetMapping = TweetMapping deriving (Eq, Show)
211instance ToJSON TweetMapping where
212 toJSON TweetMapping =
213 object ["properties" .=
214 object [ "user" .= object ["type" .= ("string" :: Text)]
215 -- Serializing the date as a date is breaking other tests, mysteriously.
216 -- , "postDate" .= object [ "type" .= ("date" :: Text)
217 -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
218 , "message" .= object ["type" .= ("string" :: Text)]
219 , "age" .= object ["type" .= ("integer" :: Text)]
220 , "location" .= object ["type" .= ("geo_point" :: Text)]
221 ]]
223exampleTweet :: Tweet
224exampleTweet = Tweet { user = "bitemyapp"
225 , postDate = UTCTime
226 (ModifiedJulianDay 55000)
227 (secondsToDiffTime 10)
228 , message = "Use haskell!"
229 , age = 10000
230 , location = Location 40.12 (-71.34)
231 , extra = Nothing }
233tweetWithExtra :: Tweet
234tweetWithExtra = Tweet { user = "bitemyapp"
235 , postDate = UTCTime
236 (ModifiedJulianDay 55000)
237 (secondsToDiffTime 10)
238 , message = "Use haskell!"
239 , age = 10000
240 , location = Location 40.12 (-71.34)
241 , extra = Just "blah blah" }
243newAge :: Int
244newAge = 31337
246newUser :: Text
247newUser = "someotherapp"
249tweetPatch :: Value
250tweetPatch =
251 object [ "age" .= newAge
252 , "user" .= newUser
253 ]
255patchedTweet :: Tweet
256patchedTweet = exampleTweet{age = newAge, user = newUser}
258otherTweet :: Tweet
259otherTweet = Tweet { user = "notmyapp"
260 , postDate = UTCTime
261 (ModifiedJulianDay 55000)
262 (secondsToDiffTime 11)
263 , message = "Use haskell!"
264 , age = 1000
265 , location = Location 40.12 (-71.34)
266 , extra = Nothing }
268resetIndex :: BH IO ()
269resetIndex = do
270 _ <- deleteExampleIndex
271 _ <- createExampleIndex
272 _ <- putMapping testIndex testMapping TweetMapping
273 return ()
275insertData :: BH IO Reply
276insertData = do
277 resetIndex
278 insertData' defaultIndexDocumentSettings
280insertData' :: IndexDocumentSettings -> BH IO Reply
281insertData' ids = do
282 r <- indexDocument testIndex testMapping ids exampleTweet (DocId "1")
283 _ <- refreshIndex testIndex
284 return r
286updateData :: BH IO Reply
287updateData = do
288 r <- updateDocument testIndex testMapping defaultIndexDocumentSettings tweetPatch (DocId "1")
289 _ <- refreshIndex testIndex
290 return r
292insertOther :: BH IO ()
293insertOther = do
294 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings otherTweet (DocId "2")
295 _ <- refreshIndex testIndex
296 return ()
298insertExtra :: BH IO ()
299insertExtra = do
300 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings tweetWithExtra (DocId "4")
301 _ <- refreshIndex testIndex
302 return ()
304insertWithSpaceInId :: BH IO ()
305insertWithSpaceInId = do
306 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "Hello World")
307 _ <- refreshIndex testIndex
308 return ()
310searchTweet :: Search -> BH IO (Either EsError Tweet)
311searchTweet search = do
312 result <- searchTweets search
313 let myTweet :: Either EsError Tweet
314 myTweet = grabFirst result
315 return myTweet
317searchTweets :: Search -> BH IO (Either EsError (SearchResult Tweet))
318searchTweets search = parseEsResponse =<< searchByIndex testIndex search
320searchExpectNoResults :: Search -> BH IO ()
321searchExpectNoResults search = do
322 result <- searchTweets search
323 let emptyHits = fmap (hits . searchHits) result
324 liftIO $
325 emptyHits `shouldBe` Right []
327searchExpectAggs :: Search -> BH IO ()
328searchExpectAggs search = do
329 reply <- searchByIndex testIndex search
330 let isEmpty x = return (M.null x)
331 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
332 liftIO $
333 (result >>= aggregations >>= isEmpty) `shouldBe` Just False
335searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) =>
336 Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> BH IO ()
337searchValidBucketAgg search aggKey extractor = do
338 reply <- searchByIndex testIndex search
339 let bucketDocs = docCount . head . buckets
340 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
341 let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)
342 liftIO $
343 count `shouldBe` Just 1
345searchTermsAggHint :: [ExecutionHint] -> BH IO ()
346searchTermsAggHint hints = do
347 let terms hint = TermsAgg $ (mkTermsAggregation "user") { termExecutionHint = Just hint }
348 let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint
349 forM_ hints $ searchExpectAggs . search
350 forM_ hints (\x -> searchValidBucketAgg (search x) "users" toTerms)
352searchTweetHighlight :: Search -> BH IO (Either EsError (Maybe HitHighlight))
353searchTweetHighlight search = do
354 result <- searchTweets search
355 let myHighlight = fmap (hitHighlight . head . hits . searchHits) result
356 return myHighlight
358searchExpectSource :: Source -> Either EsError Value -> BH IO ()
359searchExpectSource src expected = do
360 _ <- insertData
361 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
362 let search = (mkSearch (Just query) Nothing) { source = Just src }
363 reply <- searchByIndex testIndex search
364 result <- parseEsResponse reply
365 let value = grabFirst result
366 liftIO $
367 value `shouldBe` expected
369withSnapshotRepo
370 :: ( MonadMask m
371 , MonadBH m
372 )
373 => SnapshotRepoName
374 -> (GenericSnapshotRepo -> m a)
375 -> m a
376withSnapshotRepo srn@(SnapshotRepoName n) f = do
377 repoPaths <- liftIO getRepoPaths
378 -- we'll use the first repo path if available, otherwise system temp
379 -- dir. Note that this will fail on ES > 1.6, so be sure you use
380 -- @when' canSnapshot@.
381 case repoPaths of
382 (firstRepoPath:_) -> withTempDirectory firstRepoPath (T.unpack n) $ \dir -> bracket (alloc dir) free f
383 [] -> withSystemTempDirectory (T.unpack n) $ \dir -> bracket (alloc dir) free f
384 where
385 alloc dir = do
386 liftIO (setFileMode dir mode)
387 let repo = FsSnapshotRepo srn "bloodhound-tests-backups" True Nothing Nothing Nothing
388 resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings repo
389 liftIO (validateStatus resp 200)
390 return (toGSnapshotRepo repo)
391 mode = ownerModes `unionFileModes` groupModes `unionFileModes` otherModes
392 free GenericSnapshotRepo {..} = do
393 resp <- deleteSnapshotRepo gSnapshotRepoName
394 liftIO (validateStatus resp 200)
397withSnapshot
398 :: ( MonadMask m
399 , MonadBH m
400 )
401 => SnapshotRepoName
402 -> SnapshotName
403 -> m a
404 -> m a
405withSnapshot srn sn = bracket_ alloc free
406 where
407 alloc = do
408 resp <- createSnapshot srn sn createSettings
409 liftIO (validateStatus resp 200)
410 -- We'll make this synchronous for testing purposes
411 createSettings = defaultSnapshotCreateSettings { snapWaitForCompletion = True
412 , snapIndices = Just (IndexList (testIndex :| []))
413 -- We don't actually need to back up any data
414 }
415 free = do
416 deleteSnapshot srn sn
420data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
421instance FromJSON BulkTest where
422 parseJSON = genericParseJSON defaultOptions
423instance ToJSON BulkTest where
424 toJSON = genericToJSON defaultOptions
426class GApproxEq f where
427 gApproxEq :: f a -> f a -> Bool
429-- | Unit type
430instance GApproxEq U1 where
431 gApproxEq U1 U1 = True
433-- | Sum type, ensure same constructors, recurse
434instance (GApproxEq a, GApproxEq b) => GApproxEq (a :+: b) where
435 gApproxEq (L1 a) (L1 b) = gApproxEq a b
436 gApproxEq (R1 a) (R1 b) = gApproxEq a b
437 gApproxEq _ _ = False
439-- | Product type, ensure each field is approx eq
440instance (GApproxEq a, GApproxEq b) => GApproxEq (a :*: b) where
441 gApproxEq (a1 :*: b1) (a2 :*: b2) = gApproxEq a1 a2 && gApproxEq b1 b2
443-- | Value type, actually check the values for approx equality
444instance (ApproxEq a) => GApproxEq (K1 i a) where
445 gApproxEq (K1 a) (K1 b) = a =~ b
447instance (GApproxEq f) => GApproxEq (M1 i t f) where
448 gApproxEq (M1 a) (M1 b) = gApproxEq a b
450-- | Typeclass for "equal where it matters". Use this to specify
451-- less-strict equivalence for things such as lists that can wind up
452-- in an unpredictable order
453class ApproxEq a where
454 (=~) :: a -> a -> Bool
455 default (=~) :: (Generic a, GApproxEq (Rep a)) => a -> a -> Bool
456 a =~ b = gApproxEq (G.from a) (G.from b)
458 showApproxEq :: a -> String
459 default showApproxEq :: (Show a) => a -> String
460 showApproxEq = show
462instance ApproxEq NominalDiffTime where (=~) = (==)
463instance ApproxEq UTCTime where (=~) = (==)
464instance ApproxEq Text where (=~) = (==)
465instance ApproxEq Bool where (=~) = (==)
466instance ApproxEq Int where (=~) = (==)
467instance ApproxEq Double where (=~) = (==)
468instance (ApproxEq a, Show a) => ApproxEq (NonEmpty a)
469instance (ApproxEq a, Show a) => ApproxEq (Maybe a)
470instance ApproxEq GeoPoint
471instance ApproxEq Regexp
472instance ApproxEq RangeValue
473instance ApproxEq LessThan
474instance ApproxEq LessThanEq
475instance ApproxEq LessThanD
476instance ApproxEq LessThanEqD
477instance ApproxEq GreaterThan
478instance ApproxEq GreaterThanEq
479instance ApproxEq GreaterThanD
480instance ApproxEq GreaterThanEqD
481instance ApproxEq MinimumMatchHighLow
482instance ApproxEq RegexpFlag
483instance ApproxEq RegexpFlags
484instance ApproxEq NullValue
485instance ApproxEq Version
486instance ApproxEq VersionNumber
487instance ApproxEq DistanceRange
488instance ApproxEq IndexName
489instance ApproxEq MappingName
490instance ApproxEq DocId
491instance ApproxEq IndexAliasRouting
492instance ApproxEq RoutingValue
493instance ApproxEq ShardCount
494instance ApproxEq ReplicaCount
495instance ApproxEq TemplateName
496instance ApproxEq TemplatePattern
497instance ApproxEq QueryString
498instance ApproxEq FieldName
499instance ApproxEq CacheName
500instance ApproxEq CacheKey
501instance ApproxEq Existence
502instance ApproxEq CutoffFrequency
503instance ApproxEq Analyzer
504instance ApproxEq Lenient
505instance ApproxEq Tiebreaker
506instance ApproxEq Boost
507instance ApproxEq BoostTerms
508instance ApproxEq MaxExpansions
509instance ApproxEq MinimumMatch
510instance ApproxEq DisableCoord
511instance ApproxEq IgnoreTermFrequency
512instance ApproxEq MinimumTermFrequency
513instance ApproxEq MaxQueryTerms
514instance ApproxEq Fuzziness
515instance ApproxEq PrefixLength
516instance ApproxEq TypeName
517instance ApproxEq PercentMatch
518instance ApproxEq StopWord
519instance ApproxEq QueryPath
520instance ApproxEq AllowLeadingWildcard
521instance ApproxEq LowercaseExpanded
522instance ApproxEq EnablePositionIncrements
523instance ApproxEq AnalyzeWildcard
524instance ApproxEq GeneratePhraseQueries
525instance ApproxEq Locale
526instance ApproxEq MaxWordLength
527instance ApproxEq MinWordLength
528instance ApproxEq PhraseSlop
529instance ApproxEq MinDocFrequency
530instance ApproxEq MaxDocFrequency
531instance ApproxEq Filter
532instance ApproxEq Query
533instance ApproxEq SimpleQueryStringQuery
534instance ApproxEq FieldOrFields
535instance ApproxEq SimpleQueryFlag
536instance ApproxEq RegexpQuery
537instance ApproxEq QueryStringQuery
538instance ApproxEq RangeQuery
539instance ApproxEq PrefixQuery
540instance ApproxEq NestedQuery
541instance ApproxEq MoreLikeThisFieldQuery
542instance ApproxEq MoreLikeThisQuery
543instance ApproxEq IndicesQuery
544instance ApproxEq HasParentQuery
545instance ApproxEq HasChildQuery
546instance ApproxEq FuzzyQuery
547instance ApproxEq FuzzyLikeFieldQuery
548instance ApproxEq FuzzyLikeThisQuery
549instance ApproxEq FilteredQuery
550instance ApproxEq DisMaxQuery
551instance ApproxEq CommonTermsQuery
552instance ApproxEq CommonMinimumMatch
553instance ApproxEq BoostingQuery
554instance ApproxEq BoolQuery
555instance ApproxEq MatchQuery
556instance ApproxEq MultiMatchQueryType
557instance ApproxEq BooleanOperator
558instance ApproxEq ZeroTermsQuery
559instance ApproxEq MatchQueryType
560instance ApproxEq AliasRouting
561instance ApproxEq IndexAliasCreate
562instance ApproxEq SearchAliasRouting
563instance ApproxEq ScoreType
564instance ApproxEq Distance
565instance ApproxEq DistanceUnit
566instance ApproxEq DistanceType
567instance ApproxEq OptimizeBbox
568instance ApproxEq GeoBoundingBoxConstraint
569instance ApproxEq GeoFilterType
570instance ApproxEq GeoBoundingBox
571instance ApproxEq LatLon
572instance ApproxEq RangeExecution
573instance ApproxEq FSType
574instance ApproxEq CompoundFormat
575instance ApproxEq InitialShardCount
576instance ApproxEq Bytes
577instance ApproxEq ReplicaBounds
578instance ApproxEq Term
579instance ApproxEq BoolMatch
580instance ApproxEq MultiMatchQuery
581instance ApproxEq IndexSettings
582instance ApproxEq AllocationPolicy
583instance ApproxEq Char where
584 (=~) = (==)
585instance ApproxEq Vers.Version where
586 (=~) = (==)
587instance (ApproxEq a, Show a) => ApproxEq [a] where
588 as =~ bs = and (zipWith (=~) as bs)
589instance (ApproxEq l, ApproxEq r) => ApproxEq (Either l r) where
590 Left a =~ Left b = a =~ b
591 Right a =~ Right b = a =~ b
592 _ =~ _ = False
593 showApproxEq (Left x) = "Left " <> showApproxEq x
594 showApproxEq (Right x) = "Right " <> showApproxEq x
595instance ApproxEq NodeAttrFilter
596instance ApproxEq NodeAttrName
597instance ApproxEq BuildHash
598instance ApproxEq TemplateQueryKeyValuePairs where
599 (=~) = (==)
600instance ApproxEq TemplateQueryInline
602-- | Due to the way nodeattrfilters get serialized here, they may come
603-- out in a different order, but they are morally equivalent
604instance ApproxEq UpdatableIndexSetting where
605 RoutingAllocationInclude a =~ RoutingAllocationInclude b =
606 NE.sort a =~ NE.sort b
607 RoutingAllocationExclude a =~ RoutingAllocationExclude b =
608 NE.sort a =~ NE.sort b
609 RoutingAllocationRequire a =~ RoutingAllocationRequire b =
610 NE.sort a =~ NE.sort b
611 a =~ b = a == b
612 showApproxEq (RoutingAllocationInclude xs) = show (RoutingAllocationInclude (NE.sort xs))
613 showApproxEq (RoutingAllocationExclude xs) = show (RoutingAllocationExclude (NE.sort xs))
614 showApproxEq (RoutingAllocationRequire xs) = show (RoutingAllocationRequire (NE.sort xs))
615 showApproxEq x = show x
618noDuplicates :: Eq a => [a] -> Bool
619noDuplicates xs = nub xs == xs
621instance Arbitrary NominalDiffTime where
622 arbitrary = fromInteger <$> arbitrary
624#if !MIN_VERSION_QuickCheck(2,8,0)
625instance (Arbitrary k, Ord k, Arbitrary v) => Arbitrary (M.Map k v) where
626 arbitrary = M.fromList <$> arbitrary
627#endif
629instance Arbitrary Text where
630 arbitrary = T.pack <$> arbitrary
632instance Arbitrary UTCTime where
633 arbitrary = UTCTime
634 <$> arbitrary
635 <*> (fromRational . toRational <$> choose (0::Double, 86400))
637instance Arbitrary Day where
638 arbitrary = ModifiedJulianDay <$> (2000 +) <$> arbitrary
639 shrink = (ModifiedJulianDay <$>) . shrink . toModifiedJulianDay
641#if !MIN_VERSION_QuickCheck(2,9,0)
642instance Arbitrary a => Arbitrary (NonEmpty a) where
643 arbitrary = liftA2 (:|) arbitrary arbitrary
644#endif
646arbitraryScore :: Gen Score
647arbitraryScore = fmap getPositive <$> arbitrary
649instance (Arbitrary a, Typeable a) => Arbitrary (Hit a) where
650 arbitrary = Hit <$> arbitrary
651 <*> arbitrary
652 <*> arbitrary
653 <*> arbitraryScore
654 <*> arbitrary
655 <*> arbitrary
656 shrink = genericShrink
659instance (Arbitrary a, Typeable a) => Arbitrary (SearchHits a) where
660 arbitrary = reduceSize $ do
661 tot <- getPositive <$> arbitrary
662 score <- arbitraryScore
663 hs <- arbitrary
664 return $ SearchHits tot score hs
665 shrink = genericShrink
667reduceSize :: Gen a -> Gen a
668reduceSize f = sized $ \n -> resize (n `div` 2) f
670getSource :: EsResult a -> Maybe a
671getSource = fmap _source . foundResult
673grabFirst :: Either EsError (SearchResult a) -> Either EsError a
674grabFirst r =
675 case fmap (hitSource . head . hits . searchHits) r of
676 (Left e) -> Left e
677 (Right Nothing) -> Left (EsError 500 "Source was missing")
678 (Right (Just x)) -> Right x
680-------------------------------------------------------------------------------
681arbitraryAlphaNum :: Gen Char
682arbitraryAlphaNum = oneof [choose ('a', 'z')
683 ,choose ('A','Z')
684 , choose ('0', '9')]
686instance Arbitrary RoutingValue where
687 arbitrary = RoutingValue . T.pack <$> listOf1 arbitraryAlphaNum
689instance Arbitrary AliasRouting where
690 arbitrary = oneof [allAlias
691 ,one
692 ,theOther
693 ,both]
694 where one = GranularAliasRouting
695 <$> (Just <$> arbitrary)
696 <*> pure Nothing
697 theOther = GranularAliasRouting Nothing
698 <$> (Just <$> arbitrary)
699 both = GranularAliasRouting
700 <$> (Just <$> arbitrary)
701 <*> (Just <$> arbitrary)
702 allAlias = AllAliasRouting <$> arbitrary
703 shrink = genericShrink
706instance Arbitrary FieldName where
707 arbitrary = FieldName . T.pack <$> listOf1 arbitraryAlphaNum
708 shrink = genericShrink
711instance Arbitrary RegexpFlags where
712 arbitrary = oneof [ pure AllRegexpFlags
713 , pure NoRegexpFlags
714 , SomeRegexpFlags <$> genUniqueFlags
715 ]
716 where genUniqueFlags = NE.fromList . nub <$> listOf1 arbitrary
717 shrink = genericShrink
720instance Arbitrary IndexAliasCreate where
721 arbitrary = IndexAliasCreate <$> arbitrary <*> reduceSize arbitrary
722 shrink = genericShrink
724instance Arbitrary Query where
725 arbitrary = reduceSize $ oneof [ TermQuery <$> arbitrary <*> arbitrary
726 , TermsQuery <$> arbitrary <*> arbitrary
727 , QueryMatchQuery <$> arbitrary
728 , QueryMultiMatchQuery <$> arbitrary
729 , QueryBoolQuery <$> arbitrary
730 , QueryBoostingQuery <$> arbitrary
731 , QueryCommonTermsQuery <$> arbitrary
732 , ConstantScoreFilter <$> arbitrary <*> arbitrary
733 , ConstantScoreQuery <$> arbitrary <*> arbitrary
734 , QueryDisMaxQuery <$> arbitrary
735 , QueryFilteredQuery <$> arbitrary
736 , QueryFuzzyLikeThisQuery <$> arbitrary
737 , QueryFuzzyLikeFieldQuery <$> arbitrary
738 , QueryFuzzyQuery <$> arbitrary
739 , QueryHasChildQuery <$> arbitrary
740 , QueryHasParentQuery <$> arbitrary
741 , IdsQuery <$> arbitrary <*> arbitrary
742 , QueryIndicesQuery <$> arbitrary
743 , MatchAllQuery <$> arbitrary
744 , QueryMoreLikeThisQuery <$> arbitrary
745 , QueryMoreLikeThisFieldQuery <$> arbitrary
746 , QueryNestedQuery <$> arbitrary
747 , QueryPrefixQuery <$> arbitrary
748 , QueryQueryStringQuery <$> arbitrary
749 , QuerySimpleQueryStringQuery <$> arbitrary
750 , QueryRangeQuery <$> arbitrary
751 , QueryRegexpQuery <$> arbitrary
752 , QueryTemplateQueryInline <$> arbitrary
753 ]
754 shrink = genericShrink
756instance Arbitrary Filter where
757 arbitrary = reduceSize $ oneof [ AndFilter <$> arbitrary <*> arbitrary
758 , OrFilter <$> arbitrary <*> arbitrary
759 , NotFilter <$> arbitrary <*> arbitrary
760 , pure IdentityFilter
761 , BoolFilter <$> arbitrary
762 , ExistsFilter <$> arbitrary
763 , GeoBoundingBoxFilter <$> arbitrary
764 , GeoDistanceFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
765 , GeoDistanceRangeFilter <$> arbitrary <*> arbitrary
766 , GeoPolygonFilter <$> arbitrary <*> arbitrary
767 , IdsFilter <$> arbitrary <*> arbitrary
768 , LimitFilter <$> arbitrary
769 , MissingFilter <$> arbitrary <*> arbitrary <*> arbitrary
770 , PrefixFilter <$> arbitrary <*> arbitrary <*> arbitrary
771 , QueryFilter <$> arbitrary <*> arbitrary
772 , RangeFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
773 , RegexpFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
774 , TermFilter <$> arbitrary <*> arbitrary]
775 shrink = genericShrink
777instance Arbitrary ReplicaBounds where
778 arbitrary = oneof [ replicasBounded
779 , replicasLowerBounded
780 , pure ReplicasUnbounded
781 ]
782 where replicasBounded = do Positive a <- arbitrary
783 Positive b <- arbitrary
784 return (ReplicasBounded a b)
785 replicasLowerBounded = do Positive a <- arbitrary
786 return (ReplicasLowerBounded a)
788instance Arbitrary NodeAttrName where
789 arbitrary = NodeAttrName . T.pack <$> listOf1 arbitraryAlphaNum
792instance Arbitrary NodeAttrFilter where
793 arbitrary = do
794 n <- arbitrary
795 s:ss <- listOf1 (listOf1 arbitraryAlphaNum)
796 let ts = T.pack <$> s :| ss
797 return (NodeAttrFilter n ts)
798 shrink = genericShrink
800instance Arbitrary VersionNumber where
801 arbitrary = mk . fmap getPositive . getNonEmpty <$> arbitrary
802 where
803 mk versions = VersionNumber (Vers.Version versions [])
805instance Arbitrary TemplateQueryKeyValuePairs where
806 arbitrary = TemplateQueryKeyValuePairs . HM.fromList <$> arbitrary
807 shrink (TemplateQueryKeyValuePairs x) = map (TemplateQueryKeyValuePairs . HM.fromList) . shrink $ HM.toList x
809instance Arbitrary IndexName where arbitrary = sopArbitrary; shrink = genericShrink
810instance Arbitrary MappingName where arbitrary = sopArbitrary; shrink = genericShrink
811instance Arbitrary DocId where arbitrary = sopArbitrary; shrink = genericShrink
812instance Arbitrary Version where arbitrary = sopArbitrary; shrink = genericShrink
813instance Arbitrary BuildHash where arbitrary = sopArbitrary; shrink = genericShrink
814instance Arbitrary IndexAliasRouting where arbitrary = sopArbitrary; shrink = genericShrink
815instance Arbitrary ShardCount where arbitrary = sopArbitrary; shrink = genericShrink
816instance Arbitrary ReplicaCount where arbitrary = sopArbitrary; shrink = genericShrink
817instance Arbitrary TemplateName where arbitrary = sopArbitrary; shrink = genericShrink
818instance Arbitrary TemplatePattern where arbitrary = sopArbitrary; shrink = genericShrink
819instance Arbitrary QueryString where arbitrary = sopArbitrary; shrink = genericShrink
820instance Arbitrary CacheName where arbitrary = sopArbitrary; shrink = genericShrink
821instance Arbitrary CacheKey where arbitrary = sopArbitrary; shrink = genericShrink
822instance Arbitrary Existence where arbitrary = sopArbitrary; shrink = genericShrink
823instance Arbitrary CutoffFrequency where arbitrary = sopArbitrary; shrink = genericShrink
824instance Arbitrary Analyzer where arbitrary = sopArbitrary; shrink = genericShrink
825instance Arbitrary MaxExpansions where arbitrary = sopArbitrary; shrink = genericShrink
826instance Arbitrary Lenient where arbitrary = sopArbitrary; shrink = genericShrink
827instance Arbitrary Tiebreaker where arbitrary = sopArbitrary; shrink = genericShrink
828instance Arbitrary Boost where arbitrary = sopArbitrary; shrink = genericShrink
829instance Arbitrary BoostTerms where arbitrary = sopArbitrary; shrink = genericShrink
830instance Arbitrary MinimumMatch where arbitrary = sopArbitrary; shrink = genericShrink
831instance Arbitrary DisableCoord where arbitrary = sopArbitrary; shrink = genericShrink
832instance Arbitrary IgnoreTermFrequency where arbitrary = sopArbitrary; shrink = genericShrink
833instance Arbitrary MinimumTermFrequency where arbitrary = sopArbitrary; shrink = genericShrink
834instance Arbitrary MaxQueryTerms where arbitrary = sopArbitrary; shrink = genericShrink
835instance Arbitrary Fuzziness where arbitrary = sopArbitrary; shrink = genericShrink
836instance Arbitrary PrefixLength where arbitrary = sopArbitrary; shrink = genericShrink
837instance Arbitrary TypeName where arbitrary = sopArbitrary; shrink = genericShrink
838instance Arbitrary PercentMatch where arbitrary = sopArbitrary; shrink = genericShrink
839instance Arbitrary StopWord where arbitrary = sopArbitrary; shrink = genericShrink
840instance Arbitrary QueryPath where arbitrary = sopArbitrary; shrink = genericShrink
841instance Arbitrary AllowLeadingWildcard where arbitrary = sopArbitrary; shrink = genericShrink
842instance Arbitrary LowercaseExpanded where arbitrary = sopArbitrary; shrink = genericShrink
843instance Arbitrary EnablePositionIncrements where arbitrary = sopArbitrary; shrink = genericShrink
844instance Arbitrary AnalyzeWildcard where arbitrary = sopArbitrary; shrink = genericShrink
845instance Arbitrary GeneratePhraseQueries where arbitrary = sopArbitrary; shrink = genericShrink
846instance Arbitrary Locale where arbitrary = sopArbitrary; shrink = genericShrink
847instance Arbitrary MaxWordLength where arbitrary = sopArbitrary; shrink = genericShrink
848instance Arbitrary MinWordLength where arbitrary = sopArbitrary; shrink = genericShrink
849instance Arbitrary PhraseSlop where arbitrary = sopArbitrary; shrink = genericShrink
850instance Arbitrary MinDocFrequency where arbitrary = sopArbitrary; shrink = genericShrink
851instance Arbitrary MaxDocFrequency where arbitrary = sopArbitrary; shrink = genericShrink
852instance Arbitrary Regexp where arbitrary = sopArbitrary; shrink = genericShrink
853instance Arbitrary SimpleQueryStringQuery where arbitrary = sopArbitrary; shrink = genericShrink
854instance Arbitrary FieldOrFields where arbitrary = sopArbitrary; shrink = genericShrink
855instance Arbitrary SimpleQueryFlag where arbitrary = sopArbitrary; shrink = genericShrink
856instance Arbitrary RegexpQuery where arbitrary = sopArbitrary; shrink = genericShrink
857instance Arbitrary QueryStringQuery where arbitrary = sopArbitrary; shrink = genericShrink
858instance Arbitrary RangeQuery where arbitrary = sopArbitrary; shrink = genericShrink
859instance Arbitrary RangeValue where arbitrary = sopArbitrary; shrink = genericShrink
860instance Arbitrary PrefixQuery where arbitrary = sopArbitrary; shrink = genericShrink
861instance Arbitrary NestedQuery where arbitrary = sopArbitrary; shrink = genericShrink
862instance Arbitrary MoreLikeThisFieldQuery where arbitrary = sopArbitrary; shrink = genericShrink
863instance Arbitrary MoreLikeThisQuery where arbitrary = sopArbitrary; shrink = genericShrink
864instance Arbitrary IndicesQuery where arbitrary = sopArbitrary; shrink = genericShrink
865instance Arbitrary HasParentQuery where arbitrary = sopArbitrary; shrink = genericShrink
866instance Arbitrary HasChildQuery where arbitrary = sopArbitrary; shrink = genericShrink
867instance Arbitrary FuzzyQuery where arbitrary = sopArbitrary; shrink = genericShrink
868instance Arbitrary FuzzyLikeFieldQuery where arbitrary = sopArbitrary; shrink = genericShrink
869instance Arbitrary FuzzyLikeThisQuery where arbitrary = sopArbitrary; shrink = genericShrink
870instance Arbitrary FilteredQuery where arbitrary = sopArbitrary; shrink = genericShrink
871instance Arbitrary DisMaxQuery where arbitrary = sopArbitrary; shrink = genericShrink
872instance Arbitrary CommonTermsQuery where arbitrary = sopArbitrary; shrink = genericShrink
873instance Arbitrary DistanceRange where arbitrary = sopArbitrary; shrink = genericShrink
874instance Arbitrary MultiMatchQuery where arbitrary = sopArbitrary; shrink = genericShrink
875instance Arbitrary LessThanD where arbitrary = sopArbitrary; shrink = genericShrink
876instance Arbitrary LessThanEqD where arbitrary = sopArbitrary; shrink = genericShrink
877instance Arbitrary GreaterThanD where arbitrary = sopArbitrary; shrink = genericShrink
878instance Arbitrary GreaterThanEqD where arbitrary = sopArbitrary; shrink = genericShrink
879instance Arbitrary LessThan where arbitrary = sopArbitrary; shrink = genericShrink
880instance Arbitrary LessThanEq where arbitrary = sopArbitrary; shrink = genericShrink
881instance Arbitrary GreaterThan where arbitrary = sopArbitrary; shrink = genericShrink
882instance Arbitrary GreaterThanEq where arbitrary = sopArbitrary; shrink = genericShrink
883instance Arbitrary GeoPoint where
884 arbitrary = GeoPoint <$> (arbitrary `suchThat` reasonableFieldName) <*> arbitrary
885 where
886 -- These are problematic for geopoint for obvious reasons
887 reasonableFieldName (FieldName "from") = False
888 reasonableFieldName (FieldName "to") = False
889 reasonableFieldName _ = True
890 shrink = genericShrink
891instance Arbitrary NullValue where arbitrary = sopArbitrary; shrink = genericShrink
892instance Arbitrary MinimumMatchHighLow where arbitrary = sopArbitrary; shrink = genericShrink
893instance Arbitrary CommonMinimumMatch where arbitrary = sopArbitrary; shrink = genericShrink
894instance Arbitrary BoostingQuery where arbitrary = sopArbitrary; shrink = genericShrink
895instance Arbitrary BoolQuery where arbitrary = sopArbitrary; shrink = genericShrink
896instance Arbitrary MatchQuery where arbitrary = sopArbitrary; shrink = genericShrink
897instance Arbitrary MultiMatchQueryType where arbitrary = sopArbitrary; shrink = genericShrink
898instance Arbitrary BooleanOperator where arbitrary = sopArbitrary; shrink = genericShrink
899instance Arbitrary ZeroTermsQuery where arbitrary = sopArbitrary; shrink = genericShrink
900instance Arbitrary MatchQueryType where arbitrary = sopArbitrary; shrink = genericShrink
901instance Arbitrary SearchAliasRouting where arbitrary = sopArbitrary; shrink = genericShrink
902instance Arbitrary ScoreType where arbitrary = sopArbitrary; shrink = genericShrink
903instance Arbitrary Distance where arbitrary = sopArbitrary; shrink = genericShrink
904instance Arbitrary DistanceUnit where arbitrary = sopArbitrary; shrink = genericShrink
905instance Arbitrary DistanceType where arbitrary = sopArbitrary; shrink = genericShrink
906instance Arbitrary OptimizeBbox where arbitrary = sopArbitrary; shrink = genericShrink
907instance Arbitrary GeoBoundingBoxConstraint where arbitrary = sopArbitrary; shrink = genericShrink
908instance Arbitrary GeoFilterType where arbitrary = sopArbitrary; shrink = genericShrink
909instance Arbitrary GeoBoundingBox where arbitrary = sopArbitrary; shrink = genericShrink
910instance Arbitrary LatLon where arbitrary = sopArbitrary; shrink = genericShrink
911instance Arbitrary RangeExecution where arbitrary = sopArbitrary; shrink = genericShrink
912instance Arbitrary RegexpFlag where arbitrary = sopArbitrary; shrink = genericShrink
913instance Arbitrary BoolMatch where arbitrary = sopArbitrary; shrink = genericShrink
914instance Arbitrary Term where arbitrary = sopArbitrary; shrink = genericShrink
915instance Arbitrary IndexSettings where arbitrary = sopArbitrary; shrink = genericShrink
916instance Arbitrary UpdatableIndexSetting where arbitrary = sopArbitrary; shrink = genericShrink
917instance Arbitrary Bytes where arbitrary = sopArbitrary; shrink = genericShrink
918instance Arbitrary AllocationPolicy where arbitrary = sopArbitrary; shrink = genericShrink
919instance Arbitrary InitialShardCount where arbitrary = sopArbitrary; shrink = genericShrink
920instance Arbitrary FSType where arbitrary = sopArbitrary; shrink = genericShrink
921instance Arbitrary CompoundFormat where arbitrary = sopArbitrary; shrink = genericShrink
922instance Arbitrary FsSnapshotRepo where arbitrary = sopArbitrary; shrink = genericShrink
923instance Arbitrary SnapshotRepoName where arbitrary = sopArbitrary; shrink = genericShrink
924instance Arbitrary TemplateQueryInline where arbitrary = sopArbitrary; shrink = genericShrink
926newtype UpdatableIndexSetting' = UpdatableIndexSetting' UpdatableIndexSetting
927 deriving (Show, Eq, ToJSON, FromJSON, ApproxEq, Typeable)
929instance Arbitrary UpdatableIndexSetting' where
930 arbitrary = do
931 settings <- arbitrary
932 return $ UpdatableIndexSetting' $ case settings of
933 RoutingAllocationInclude xs -> RoutingAllocationInclude (dropDuplicateAttrNames xs)
934 RoutingAllocationExclude xs -> RoutingAllocationExclude (dropDuplicateAttrNames xs)
935 RoutingAllocationRequire xs -> RoutingAllocationRequire (dropDuplicateAttrNames xs)
936 x -> x
937 where
938 dropDuplicateAttrNames = NE.fromList . L.nubBy sameAttrName . NE.toList
939 sameAttrName a b = nodeAttrFilterName a == nodeAttrFilterName b
941main :: IO ()
942main = hspec $ do
944 describe "index create/delete API" $ do
945 it "creates and then deletes the requested index" $ withTestEnv $ do
946 -- priming state.
947 _ <- deleteExampleIndex
948 resp <- createExampleIndex
949 deleteResp <- deleteExampleIndex
950 liftIO $ do
951 validateStatus resp 200
952 validateStatus deleteResp 200
954 describe "error parsing" $ do
955 it "can parse EsErrors for < 2.0" $ when' (atmost es16) $ withTestEnv $ do
956 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
957 let errorResp = eitherDecode (responseBody res)
958 liftIO (errorResp `shouldBe` Right (EsError 404 "IndexMissingException[[bogus] missing]"))
960 it "can parse EsErrors for >= 2.0" $ when' (atleast es20) $ withTestEnv $ do
961 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
962 let errorResp = eitherDecode (responseBody res)
963 liftIO (errorResp `shouldBe` Right (EsError 404 "no such index"))
965 describe "document API" $ do
966 it "indexes, updates, gets, and then deletes the generated document" $ withTestEnv $ do
967 _ <- insertData
968 _ <- updateData
969 docInserted <- getDocument testIndex testMapping (DocId "1")
970 let newTweet = eitherDecode
971 (responseBody docInserted) :: Either String (EsResult Tweet)
972 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just patchedTweet))
974 it "indexes, gets, and then deletes the generated document with a DocId containing a space" $ withTestEnv $ do
975 _ <- insertWithSpaceInId
976 docInserted <- getDocument testIndex testMapping (DocId "Hello World")
977 let newTweet = eitherDecode
978 (responseBody docInserted) :: Either String (EsResult Tweet)
979 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))
981 it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do
982 doc <- getDocument testIndex testMapping (DocId "bogus")
983 let noTweet = eitherDecode
984 (responseBody doc) :: Either String (EsResult Tweet)
985 liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing
987 it "can use optimistic concurrency control" $ withTestEnv $ do
988 let ev = ExternalDocVersion minBound
989 let cfg = defaultIndexDocumentSettings { idsVersionControl = ExternalGT ev }
990 resetIndex
991 res <- insertData' cfg
992 liftIO $ isCreated res `shouldBe` True
993 res' <- insertData' cfg
994 liftIO $ isVersionConflict res' `shouldBe` True
996 it "indexes two documents in a parent/child relationship and checks that the child exists" $ withTestEnv $ do
997 resetIndex
998 _ <- putMapping testIndex (MappingName "child") ChildMapping
999 _ <- putMapping testIndex (MappingName "parent") ParentMapping
1000 _ <- indexDocument testIndex (MappingName "parent") defaultIndexDocumentSettings exampleTweet (DocId "1")
1001 let parent = (Just . DocumentParent . DocId) "1"
1002 ids = IndexDocumentSettings NoVersionControl parent
1003 _ <- indexDocument testIndex (MappingName "child") ids otherTweet (DocId "2")
1004 _ <- refreshIndex testIndex
1005 exists <- documentExists testIndex (MappingName "child") parent (DocId "2")
1006 liftIO $ exists `shouldBe` True
1008 describe "template API" $ do
1009 it "can create a template" $ withTestEnv $ do
1010 let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
1011 resp <- putTemplate idxTpl (TemplateName "tweet-tpl")
1012 liftIO $ validateStatus resp 200
1014 it "can detect if a template exists" $ withTestEnv $ do
1015 exists <- templateExists (TemplateName "tweet-tpl")
1016 liftIO $ exists `shouldBe` True
1018 it "can delete a template" $ withTestEnv $ do
1019 resp <- deleteTemplate (TemplateName "tweet-tpl")
1020 liftIO $ validateStatus resp 200
1022 it "can detect if a template doesn't exist" $ withTestEnv $ do
1023 exists <- templateExists (TemplateName "tweet-tpl")
1024 liftIO $ exists `shouldBe` False
1026 describe "bulk API" $ do
1027 it "inserts all documents we request" $ withTestEnv $ do
1028 _ <- insertData
1029 let firstTest = BulkTest "blah"
1030 let secondTest = BulkTest "bloo"
1031 let firstDoc = BulkIndex testIndex
1032 testMapping (DocId "2") (toJSON firstTest)
1033 let secondDoc = BulkCreate testIndex
1034 testMapping (DocId "3") (toJSON secondTest)
1035 let stream = V.fromList [firstDoc, secondDoc]
1036 _ <- bulk stream
1037 _ <- refreshIndex testIndex
1038 fDoc <- getDocument testIndex testMapping (DocId "2")
1039 sDoc <- getDocument testIndex testMapping (DocId "3")
1040 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
1041 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
1042 liftIO $ do
1043 fmap getSource maybeFirst `shouldBe` Right (Just firstTest)
1044 fmap getSource maybeSecond `shouldBe` Right (Just secondTest)
1047 describe "query API" $ do
1048 it "returns document for term query and identity filter" $ withTestEnv $ do
1049 _ <- insertData
1050 let query = TermQuery (Term "user" "bitemyapp") Nothing
1051 let filter = IdentityFilter <&&> IdentityFilter
1052 let search = mkSearch (Just query) (Just filter)
1053 myTweet <- searchTweet search
1054 liftIO $
1055 myTweet `shouldBe` Right exampleTweet
1057 it "handles constant score queries" $ withTestEnv $ do
1058 _ <- insertData
1059 let query = TermsQuery "user" ("bitemyapp" :| [])
1060 let cfQuery = ConstantScoreQuery query (Boost 1.0)
1061 let filter = IdentityFilter
1062 let search = mkSearch (Just cfQuery) (Just filter)
1063 myTweet <- searchTweet search
1064 liftIO $
1065 myTweet `shouldBe` Right exampleTweet
1066 it "handles constant score filters" $ withTestEnv $ do
1067 _ <- insertData
1068 let query = TermsQuery "user" ("bitemyapp" :| [])
1069 let cfFilter = ConstantScoreFilter IdentityFilter (Boost 1.0)
1070 let boolQuery = mkBoolQuery [query, cfFilter] [] []
1071 let search = mkSearch (Just (QueryBoolQuery boolQuery)) Nothing
1072 myTweet <- searchTweet search
1073 liftIO $
1074 myTweet `shouldBe` Right exampleTweet
1077 it "returns document for terms query and identity filter" $ withTestEnv $ do
1078 _ <- insertData
1079 let query = TermsQuery "user" ("bitemyapp" :| [])
1080 let filter = IdentityFilter <&&> IdentityFilter
1081 let search = mkSearch (Just query) (Just filter)
1082 myTweet <- searchTweet search
1083 liftIO $
1084 myTweet `shouldBe` Right exampleTweet
1086 it "returns document for match query" $ withTestEnv $ do
1087 _ <- insertData
1088 let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1089 let search = mkSearch (Just query) Nothing
1090 myTweet <- searchTweet search
1091 liftIO $
1092 myTweet `shouldBe` Right exampleTweet
1094 it "returns document for multi-match query" $ withTestEnv $ do
1095 _ <- insertData
1096 let flds = [FieldName "user", FieldName "message"]
1097 let query = QueryMultiMatchQuery $ mkMultiMatchQuery flds (QueryString "bitemyapp")
1098 let search = mkSearch (Just query) Nothing
1099 myTweet <- searchTweet search
1100 liftIO $
1101 myTweet `shouldBe` Right exampleTweet
1103 it "returns document for bool query" $ withTestEnv $ do
1104 _ <- insertData
1105 let innerQuery = QueryMatchQuery $
1106 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1107 let query = QueryBoolQuery $
1108 mkBoolQuery [innerQuery] [] []
1109 let search = mkSearch (Just query) Nothing
1110 myTweet <- searchTweet search
1111 liftIO $
1112 myTweet `shouldBe` Right exampleTweet
1114 it "returns document for boosting query" $ withTestEnv $ do
1115 _ <- insertData
1116 let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1117 let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
1118 let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
1119 let search = mkSearch (Just query) Nothing
1120 myTweet <- searchTweet search
1121 liftIO $
1122 myTweet `shouldBe` Right exampleTweet
1124 it "returns document for common terms query" $ withTestEnv $ do
1125 _ <- insertData
1126 let query = QueryCommonTermsQuery $
1127 CommonTermsQuery (FieldName "user")
1128 (QueryString "bitemyapp")
1129 (CutoffFrequency 0.0001)
1130 Or Or Nothing Nothing Nothing Nothing
1131 let search = mkSearch (Just query) Nothing
1132 myTweet <- searchTweet search
1133 liftIO $
1134 myTweet `shouldBe` Right exampleTweet
1136 it "returns document for for inline template query" $ withTestEnv $ do
1137 _ <- insertData
1138 let innerQuery = QueryMatchQuery $
1139 mkMatchQuery (FieldName "{{userKey}}")
1140 (QueryString "{{bitemyappKey}}")
1141 templateParams = TemplateQueryKeyValuePairs $ HM.fromList
1142 [ ("userKey", "user")
1143 , ("bitemyappKey", "bitemyapp")
1145 templateQuery = QueryTemplateQueryInline $
1146 TemplateQueryInline innerQuery templateParams
1147 search = mkSearch (Just templateQuery) Nothing
1148 myTweet <- searchTweet search
1149 liftIO $ myTweet `shouldBe` Right exampleTweet
1152 describe "sorting" $ do
1153 it "returns documents in the right order" $ withTestEnv $ do
1154 _ <- insertData
1155 _ <- insertOther
1156 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
1157 let search = Search Nothing
1158 (Just IdentityFilter) (Just [sortSpec]) Nothing Nothing
1159 False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
1160 result <- searchTweets search
1161 let myTweet = grabFirst result
1162 liftIO $
1163 myTweet `shouldBe` Right otherTweet
1166 describe "filtering API" $ do
1167 it "returns document for composed boolmatch and identity" $ withTestEnv $ do
1168 _ <- insertData
1169 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
1170 <&&> IdentityFilter
1171 let search = mkSearch Nothing (Just queryFilter)
1172 myTweet <- searchTweet search
1173 liftIO $
1174 myTweet `shouldBe` Right exampleTweet
1176 it "returns document for term filter" $ withTestEnv $ do
1177 _ <- insertData
1178 let termFilter = TermFilter (Term "user" "bitemyapp") False
1179 let search = mkSearch Nothing (Just termFilter)
1180 myTweet <- searchTweet search
1181 liftIO $
1182 myTweet `shouldBe` Right exampleTweet
1184 it "returns document for existential filter" $ withTestEnv $ do
1185 _ <- insertData
1186 let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
1187 myTweet <- searchTweet search
1188 liftIO $
1189 myTweet `shouldBe` Right exampleTweet
1191 it "returns document for geo boundingbox filter" $ withTestEnv $ do
1192 _ <- insertData
1193 let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
1194 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
1195 let geoFilter = GeoBoundingBoxFilter bbConstraint
1196 let search = mkSearch Nothing (Just geoFilter)
1197 myTweet <- searchTweet search
1198 liftIO $
1199 myTweet `shouldBe` Right exampleTweet
1201 it "doesn't return document for nonsensical boundingbox filter" $ withTestEnv $ do
1202 _ <- insertData
1203 let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
1204 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
1205 let geoFilter = GeoBoundingBoxFilter bbConstraint
1206 let search = mkSearch Nothing (Just geoFilter)
1207 searchExpectNoResults search
1209 it "returns document for geo distance filter" $ withTestEnv $ do
1210 _ <- insertData
1211 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1212 let distance = Distance 10.0 Miles
1213 let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
1214 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
1215 let search = mkSearch Nothing (Just geoFilter)
1216 myTweet <- searchTweet search
1217 liftIO $
1218 myTweet `shouldBe` Right exampleTweet
1220 it "returns document for geo distance range filter" $ withTestEnv $ do
1221 _ <- insertData
1222 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1223 let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
1224 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
1225 let search = mkSearch Nothing (Just geoFilter)
1226 myTweet <- searchTweet search
1227 liftIO $
1228 myTweet `shouldBe` Right exampleTweet
1230 it "doesn't return document for wild geo distance range filter" $ withTestEnv $ do
1231 _ <- insertData
1232 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1233 let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
1234 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
1235 let search = mkSearch Nothing (Just geoFilter)
1236 searchExpectNoResults search
1238 it "returns document for geo polygon filter" $ withTestEnv $ do
1239 _ <- insertData
1240 let points = [LatLon 40.0 (-70.00),
1241 LatLon 40.0 (-72.00),
1242 LatLon 41.0 (-70.00),
1243 LatLon 41.0 (-72.00)]
1244 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
1245 let search = mkSearch Nothing (Just geoFilter)
1246 myTweet <- searchTweet search
1247 liftIO $
1248 myTweet `shouldBe` Right exampleTweet
1250 it "doesn't return document for bad geo polygon filter" $ withTestEnv $ do
1251 _ <- insertData
1252 let points = [LatLon 40.0 (-70.00),
1253 LatLon 40.0 (-71.00),
1254 LatLon 41.0 (-70.00),
1255 LatLon 41.0 (-71.00)]
1256 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
1257 let search = mkSearch Nothing (Just geoFilter)
1258 searchExpectNoResults search
1260 it "returns document for ids filter" $ withTestEnv $ do
1261 _ <- insertData
1262 let filter = IdsFilter (MappingName "tweet") [DocId "1"]
1263 let search = mkSearch Nothing (Just filter)
1264 myTweet <- searchTweet search
1265 liftIO $
1266 myTweet `shouldBe` Right exampleTweet
1268 it "returns document for Double range filter" $ withTestEnv $ do
1269 _ <- insertData
1270 let filter = RangeFilter (FieldName "age")
1271 (RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))
1272 RangeExecutionIndex False
1273 let search = mkSearch Nothing (Just filter)
1274 myTweet <- searchTweet search
1275 liftIO $
1276 myTweet `shouldBe` Right exampleTweet
1278 it "returns document for UTCTime date filter" $ withTestEnv $ do
1279 _ <- insertData
1280 let filter = RangeFilter (FieldName "postDate")
1281 (RangeDateGtLt
1282 (GreaterThanD (UTCTime
1283 (ModifiedJulianDay 54000)
1284 (secondsToDiffTime 0)))
1285 (LessThanD (UTCTime
1286 (ModifiedJulianDay 55000)
1287 (secondsToDiffTime 11))))
1288 RangeExecutionIndex False
1289 let search = mkSearch Nothing (Just filter)
1290 myTweet <- searchTweet search
1291 liftIO $
1292 myTweet `shouldBe` Right exampleTweet
1294 it "returns document for regexp filter" $ withTestEnv $ do
1295 _ <- insertData
1296 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
1297 AllRegexpFlags (CacheName "test") False (CacheKey "key")
1298 let search = mkSearch Nothing (Just filter)
1299 myTweet <- searchTweet search
1300 liftIO $
1301 myTweet `shouldBe` Right exampleTweet
1303 it "doesn't return document for non-matching regexp filter" $ withTestEnv $ do
1304 _ <- insertData
1305 let filter = RegexpFilter (FieldName "user")
1306 (Regexp "boy") AllRegexpFlags
1307 (CacheName "test") False (CacheKey "key")
1308 let search = mkSearch Nothing (Just filter)
1309 searchExpectNoResults search
1311 it "returns document for query filter, uncached" $ withTestEnv $ do
1312 _ <- insertData
1313 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) True
1314 search = mkSearch Nothing (Just filter)
1315 myTweet <- searchTweet search
1316 liftIO $ myTweet `shouldBe` Right exampleTweet
1318 it "returns document for query filter, cached" $ withTestEnv $ do
1319 _ <- insertData
1320 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) False
1321 search = mkSearch Nothing (Just filter)
1322 myTweet <- searchTweet search
1323 liftIO $ myTweet `shouldBe` Right exampleTweet
1325 describe "Aggregation API" $ do
1326 it "returns term aggregation results" $ withTestEnv $ do
1327 _ <- insertData
1328 let terms = TermsAgg $ mkTermsAggregation "user"
1329 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1330 searchExpectAggs search
1331 searchValidBucketAgg search "users" toTerms
1333 it "return sub-aggregation results" $ withTestEnv $ do
1334 _ <- insertData
1335 let subaggs = mkAggregations "age_agg" . TermsAgg $ mkTermsAggregation "age"
1336 agg = TermsAgg $ (mkTermsAggregation "user") { termAggs = Just subaggs}
1337 search = mkAggregateSearch Nothing $ mkAggregations "users" agg
1338 reply <- searchByIndex testIndex search
1339 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
1340 usersAggResults = result >>= aggregations >>= toTerms "users"
1341 subAggResults = usersAggResults >>= (listToMaybe . buckets) >>= termsAggs >>= toTerms "age_agg"
1342 subAddResultsExists = isJust subAggResults
1343 liftIO $ (subAddResultsExists) `shouldBe` True
1345 it "returns cardinality aggregation results" $ withTestEnv $ do
1346 _ <- insertData
1347 let cardinality = CardinalityAgg $ mkCardinalityAggregation $ FieldName "user"
1348 let search = mkAggregateSearch Nothing $ mkAggregations "users" cardinality
1349 let search' = search { Database.V1.Bloodhound.from = From 0, size = Size 0 }
1350 searchExpectAggs search'
1351 let docCountPair k n = (k, object ["value" .= Number n])
1352 res <- searchTweets search'
1353 liftIO $
1354 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "users" 1]))
1356 it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
1357 _ <- insertData
1358 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
1359 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1360 searchExpectAggs search
1361 searchValidBucketAgg search "users" toTerms
1363 -- One of these fails with 1.7.3
1364 it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
1365 _ <- insertData
1366 searchTermsAggHint [Map, Ordinals]
1368 it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do
1369 _ <- insertData
1370 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
1372 it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
1373 _ <- insertData
1374 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
1375 -- One of the above.
1377 it "can execute value_count aggregations" $ withTestEnv $ do
1378 _ <- insertData
1379 _ <- insertOther
1380 let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>
1381 mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))
1382 let search = mkAggregateSearch Nothing ags
1383 let docCountPair k n = (k, object ["value" .= Number n])
1384 res <- searchTweets search
1385 liftIO $
1386 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2
1387 , docCountPair "bogus_count" 0
1388 ]))
1390 it "can execute filter aggregations" $ withTestEnv $ do
1391 _ <- insertData
1392 _ <- insertOther
1393 let ags = mkAggregations "bitemyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "bitemyapp") defaultCache) Nothing)) <>
1394 mkAggregations "notmyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "notmyapp") defaultCache) Nothing))
1395 let search = mkAggregateSearch Nothing ags
1396 let docCountPair k n = (k, object ["doc_count" .= Number n])
1397 res <- searchTweets search
1398 liftIO $
1399 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "bitemyapps" 1
1400 , docCountPair "notmyapps" 1
1401 ]))
1402 it "can execute date_range aggregations" $ withTestEnv $ do
1403 let now = fromGregorian 2015 3 14
1404 let ltAMonthAgo = UTCTime (fromGregorian 2015 3 1) 0
1405 let ltAWeekAgo = UTCTime (fromGregorian 2015 3 10) 0
1406 let oldDoc = exampleTweet { postDate = ltAMonthAgo }
1407 let newDoc = exampleTweet { postDate = ltAWeekAgo }
1408 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings oldDoc (DocId "1")
1409 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings newDoc (DocId "2")
1410 _ <- refreshIndex testIndex
1411 let thisMonth = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMMonth])
1412 let thisWeek = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMWeek])
1413 let agg = DateRangeAggregation (FieldName "postDate") Nothing (thisMonth :| [thisWeek])
1414 let ags = mkAggregations "date_ranges" (DateRangeAgg agg)
1415 let search = mkAggregateSearch Nothing ags
1416 res <- searchTweets search
1417 liftIO $ hitsTotal . searchHits <$> res `shouldBe` Right 2
1418 let bucks = do magrs <- fmapL show (aggregations <$> res)
1419 agrs <- note "no aggregations returned" magrs
1420 rawBucks <- note "no date_ranges aggregation" $ M.lookup "date_ranges" agrs
1421 parseEither parseJSON rawBucks
1422 let fromMonthT = UTCTime (fromGregorian 2015 2 14) 0
1423 let fromWeekT = UTCTime (fromGregorian 2015 3 7) 0
1424 liftIO $ buckets <$> bucks `shouldBe` Right [ DateRangeResult "2015-02-14T00:00:00.000Z-*"
1425 (Just fromMonthT)
1426 (Just "2015-02-14T00:00:00.000Z")
1427 Nothing
1428 Nothing
1430 Nothing
1431 , DateRangeResult "2015-03-07T00:00:00.000Z-*"
1432 (Just fromWeekT)
1433 (Just "2015-03-07T00:00:00.000Z")
1434 Nothing
1435 Nothing
1437 Nothing
1440 it "returns date histogram aggregation results" $ withTestEnv $ do
1441 _ <- insertData
1442 let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
1443 let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
1444 searchExpectAggs search
1445 searchValidBucketAgg search "byDate" toDateHistogram
1447 it "returns date histogram using fractional date" $ withTestEnv $ do
1448 _ <- insertData
1449 let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]
1450 let fractionals = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]
1451 let intervals = periods ++ fractionals
1452 let histogram = mkDateHistogram (FieldName "postDate")
1453 let search interval = mkAggregateSearch Nothing $ mkAggregations "byDate" $ DateHistogramAgg (histogram interval)
1454 let expect interval = searchExpectAggs (search interval)
1455 let valid interval = searchValidBucketAgg (search interval) "byDate" toDateHistogram
1456 forM_ intervals expect
1457 forM_ intervals valid
1459 it "can execute missing aggregations" $ withTestEnv $ do
1460 _ <- insertData
1461 _ <- insertExtra
1462 let ags = mkAggregations "missing_agg" (MissingAgg (MissingAggregation "extra"))
1463 let search = mkAggregateSearch Nothing ags
1464 let docCountPair k n = (k, object ["doc_count" .= Number n])
1465 res <- searchTweets search
1466 liftIO $
1467 fmap aggregations res `shouldBe` Right (Just (M.fromList [docCountPair "missing_agg" 1]))
1469 describe "Highlights API" $ do
1471 it "returns highlight from query when there should be one" $ withTestEnv $ do
1472 _ <- insertData
1473 _ <- insertOther
1474 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1475 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
1477 let search = mkHighlightSearch (Just query) testHighlight
1478 myHighlight <- searchTweetHighlight search
1479 liftIO $
1480 myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
1482 it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
1483 _ <- insertData
1484 _ <- insertOther
1485 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1486 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "user") Nothing]
1488 let search = mkHighlightSearch (Just query) testHighlight
1489 myHighlight <- searchTweetHighlight search
1490 liftIO $
1491 myHighlight `shouldBe` Right Nothing
1493 describe "Source filtering" $ do
1495 it "doesn't include source when sources are disabled" $ withTestEnv $ do
1496 searchExpectSource
1497 NoSource
1498 (Left (EsError 500 "Source was missing"))
1500 it "includes a source" $ withTestEnv $ do
1501 searchExpectSource
1502 (SourcePatterns (PopPattern (Pattern "message")))
1503 (Right (Object (HM.fromList [("message", String "Use haskell!")])))
1505 it "includes sources" $ withTestEnv $ do
1506 searchExpectSource
1507 (SourcePatterns (PopPatterns [Pattern "user", Pattern "message"]))
1508 (Right (Object (HM.fromList [("user",String "bitemyapp"),("message", String "Use haskell!")])))
1510 it "includes source patterns" $ withTestEnv $ do
1511 searchExpectSource
1512 (SourcePatterns (PopPattern (Pattern "*ge")))
1513 (Right (Object (HM.fromList [("age", Number 10000),("message", String "Use haskell!")])))
1515 it "excludes source patterns" $ withTestEnv $ do
1516 searchExpectSource
1517 (SourceIncludeExclude (Include [])
1518 (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate", Pattern "extra"]))
1519 (Right (Object (HM.fromList [("user",String "bitemyapp")])))
1521 describe "ToJSON RegexpFlags" $ do
1522 it "generates the correct JSON for AllRegexpFlags" $
1523 toJSON AllRegexpFlags `shouldBe` String "ALL"
1525 it "generates the correct JSON for NoRegexpFlags" $
1526 toJSON NoRegexpFlags `shouldBe` String "NONE"
1528 it "generates the correct JSON for SomeRegexpFlags" $
1529 let flags = AnyString :| [ Automaton
1530 , Complement
1531 , Empty
1532 , Intersection
1533 , Interval ]
1534 in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
1536 prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
1537 let String str = toJSON flags
1538 flagStrs = T.splitOn "|" str
1539 in noDuplicates flagStrs
1541 describe "omitNulls" $ do
1542 it "checks that omitNulls drops list elements when it should" $
1543 let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))
1544 , "test2" .= (toJSON ("some value" :: Text))]
1545 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1547 it "checks that omitNulls doesn't drop list elements when it shouldn't" $
1548 let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))
1549 , "test2" .= (toJSON ("some value" :: Text))]
1550 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))
1551 , ("test2", String "some value")])
1552 it "checks that omitNulls drops non list elements when it should" $
1553 let dropped = omitNulls $ [ "test1" .= (toJSON Null)
1554 , "test2" .= (toJSON ("some value" :: Text))]
1555 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1556 it "checks that omitNulls doesn't drop non list elements when it shouldn't" $
1557 let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
1558 , "test2" .= (toJSON ("some value" :: Text))]
1559 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
1560 , ("test2", String "some value")])
1561 describe "Monoid (SearchHits a)" $ do
1562 prop "abides the monoid laws" $ eq $
1563 prop_Monoid (T :: T (SearchHits ()))
1565 describe "mkDocVersion" $ do
1566 prop "can never construct an out of range docVersion" $ \i ->
1567 let res = mkDocVersion i
1568 in case res of
1569 Nothing -> property True
1570 Just dv -> (dv >= minBound) .&&.
1571 (dv <= maxBound) .&&.
1572 docVersionNumber dv === i
1574 describe "FsSnapshotRepo" $ do
1575 prop "SnapshotRepo laws" $ \fsr ->
1576 fromGSnapshotRepo (toGSnapshotRepo fsr) === Right (fsr :: FsSnapshotRepo)
1578 describe "snapshot repos" $ do
1579 it "always parses all snapshot repos API" $ when' canSnapshot $ withTestEnv $ do
1580 res <- getSnapshotRepos AllSnapshotRepos
1581 liftIO $ case res of
1582 Left e -> expectationFailure ("Expected a right but got Left " <> show e)
1583 Right _ -> return ()
1585 it "finds an existing list of repos" $ when' canSnapshot $ withTestEnv $ do
1586 let r1n = SnapshotRepoName "bloodhound-repo1"
1587 let r2n = SnapshotRepoName "bloodhound-repo2"
1588 withSnapshotRepo r1n $ \r1 ->
1589 withSnapshotRepo r2n $ \r2 -> do
1590 repos <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| [ExactRepo r2n]))
1591 liftIO $ case repos of
1592 Right xs -> do
1593 let srt = L.sortBy (comparing gSnapshotRepoName)
1594 srt xs `shouldBe` srt [r1, r2]
1595 Left e -> expectationFailure (show e)
1597 it "creates and updates with updateSnapshotRepo" $ when' canSnapshot $ withTestEnv $ do
1598 let r1n = SnapshotRepoName "bloodhound-repo1"
1599 withSnapshotRepo r1n $ \r1 -> do
1600 let Just (String dir) = HM.lookup "location" (gSnapshotRepoSettingsObject (gSnapshotRepoSettings r1))
1601 let noCompression = FsSnapshotRepo r1n (T.unpack dir) False Nothing Nothing Nothing
1602 resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings noCompression
1603 liftIO (validateStatus resp 200)
1604 Right [roundtrippedNoCompression] <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| []))
1605 liftIO (roundtrippedNoCompression `shouldBe` toGSnapshotRepo noCompression)
1607 -- verify came around in 1.4 it seems
1608 it "can verify existing repos" $ when' canSnapshot $ when' (atleast es14) $ withTestEnv $ do
1609 let r1n = SnapshotRepoName "bloodhound-repo1"
1610 withSnapshotRepo r1n $ \_ -> do
1611 res <- verifySnapshotRepo r1n
1612 liftIO $ case res of
1613 Right (SnapshotVerification vs)
1614 | null vs -> expectationFailure "Expected nonempty set of verifying nodes"
1615 | otherwise -> return ()
1616 Left e -> expectationFailure (show e)
1618 describe "snapshots" $ do
1619 it "always parses all snapshots API" $ when' canSnapshot $ withTestEnv $ do
1620 let r1n = SnapshotRepoName "bloodhound-repo1"
1621 withSnapshotRepo r1n $ \_ -> do
1622 res <- getSnapshots r1n AllSnapshots
1623 liftIO $ case res of
1624 Left e -> expectationFailure ("Expected a right but got Left " <> show e)
1625 Right _ -> return ()
1627 it "can parse a snapshot that it created" $ when' canSnapshot $ withTestEnv $ do
1628 let r1n = SnapshotRepoName "bloodhound-repo1"
1629 withSnapshotRepo r1n $ \_ -> do
1630 let s1n = SnapshotName "example-snapshot"
1631 withSnapshot r1n s1n $ do
1632 res <- getSnapshots r1n (SnapshotList (ExactSnap s1n :| []))
1633 liftIO $ case res of
1634 Right [snap]
1635 | snapInfoState snap == SnapshotSuccess &&
1636 snapInfoName snap == s1n -> return ()
1637 | otherwise -> expectationFailure (show snap)
1638 Right [] -> expectationFailure "There were no snapshots"
1639 Right snaps -> expectationFailure ("Expected 1 snapshot but got" <> show (length snaps))
1640 Left e -> expectationFailure (show e)
1642 describe "snapshot restore" $ do
1643 it "can restore a snapshot that we create" $ when' canSnapshot $ withTestEnv $ do
1644 let r1n = SnapshotRepoName "bloodhound-repo1"
1645 withSnapshotRepo r1n $ \_ -> do
1646 let s1n = SnapshotName "example-snapshot"
1647 withSnapshot r1n s1n $ do
1648 let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True }
1649 -- have to close an index to restore it
1650 resp1 <- closeIndex testIndex
1651 liftIO (validateStatus resp1 200)
1652 resp2 <- restoreSnapshot r1n s1n settings
1653 liftIO (validateStatus resp2 200)
1655 it "can restore and rename" $ when' canSnapshot $ withTestEnv $ do
1656 let r1n = SnapshotRepoName "bloodhound-repo1"
1657 withSnapshotRepo r1n $ \_ -> do
1658 let s1n = SnapshotName "example-snapshot"
1659 withSnapshot r1n s1n $ do
1660 let pat = RestoreRenamePattern "bloodhound-tests-twitter-(\\d+)"
1661 let replace = RRTLit "restored-" :| [RRSubWholeMatch]
1662 let expectedIndex = IndexName "restored-bloodhound-tests-twitter-1"
1663 oldEnoughForOverrides <- liftIO (atleast es15)
1664 let overrides = RestoreIndexSettings { restoreOverrideReplicas = Just (ReplicaCount 0) }
1665 let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True
1666 , snapRestoreRenamePattern = Just pat
1667 , snapRestoreRenameReplacement = Just replace
1668 , snapRestoreIndexSettingsOverrides = if oldEnoughForOverrides
1669 then Just overrides
1670 else Nothing
1672 -- have to close an index to restore it
1673 let go = do
1674 resp <- restoreSnapshot r1n s1n settings
1675 liftIO (validateStatus resp 200)
1676 exists <- indexExists expectedIndex
1677 liftIO (exists `shouldBe` True)
1678 go `finally` deleteIndex expectedIndex
1680 describe "getNodesInfo" $ do
1681 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
1682 res <- getNodesInfo LocalNode
1683 liftIO $ case res of
1684 -- This is really just a smoke test for response
1685 -- parsing. Node info is so variable, there's not much I can
1686 -- assert here.
1687 Right NodesInfo {..} -> length nodesInfo `shouldBe` 1
1688 Left e -> expectationFailure ("Expected NodesInfo but got " <> show e)
1690 describe "getNodesStats" $ do
1691 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
1692 res <- getNodesStats LocalNode
1693 liftIO $ case res of
1694 -- This is really just a smoke test for response
1695 -- parsing. Node stats is so variable, there's not much I can
1696 -- assert here.
1697 Right NodesStats {..} -> length nodesStats `shouldBe` 1
1698 Left e -> expectationFailure ("Expected NodesStats but got " <> show e)
1700 describe "Enum DocVersion" $ do
1701 it "follows the laws of Enum, Bounded" $ do
1702 evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall
1703 evaluate (pred minBound :: DocVersion) `shouldThrow` anyErrorCall
1704 evaluate (toEnum 0 :: DocVersion) `shouldThrow` anyErrorCall
1705 evaluate (toEnum 9200000000000000001 :: DocVersion) `shouldThrow` anyErrorCall
1706 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1707 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1708 enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]
1710 describe "scan&scroll API" $ do
1711 it "returns documents using the scan&scroll API" $ withTestEnv $ do
1712 _ <- insertData
1713 _ <- insertOther
1714 let search = (mkSearch (Just $ MatchAllQuery Nothing) Nothing) { size = (Size 1) }
1715 regular_search <- searchTweet search
1716 scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet]
1717 let scan_search = map hitSource scan_search'
1718 liftIO $
1719 regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored
1720 liftIO $
1721 scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]
1723 describe "index aliases" $ do
1724 it "handles the simple case of aliasing an existing index" $ do
1725 let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1726 let create = IndexAliasCreate Nothing Nothing
1727 let action = AddAlias alias create
1729 withTestEnv $ do
1730 resetIndex
1731 resp <- updateIndexAliases (action :| [])
1732 liftIO $ validateStatus resp 200
1733 let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1734 (do aliases <- withTestEnv getIndexAliases
1735 let expected = IndexAliasSummary alias create
1736 case aliases of
1737 Right (IndexAliasesSummary summs) ->
1738 L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1739 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1741 it "handles an alias with routing and a filter" $ do
1742 let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1743 let sar = SearchAliasRouting (RoutingValue "search val" :| [])
1744 let iar = IndexAliasRouting (RoutingValue "index val")
1745 let routing = GranularAliasRouting (Just sar) (Just iar)
1746 let filter = LimitFilter 42
1747 let create = IndexAliasCreate (Just routing) (Just filter)
1748 let action = AddAlias alias create
1750 withTestEnv $ do
1751 resetIndex
1752 resp <- updateIndexAliases (action :| [])
1753 liftIO $ validateStatus resp 200
1754 let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1755 (do aliases <- withTestEnv getIndexAliases
1756 let expected = IndexAliasSummary alias create
1757 case aliases of
1758 Right (IndexAliasesSummary summs) ->
1759 L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1760 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1762 describe "Index Listing" $ do
1763 it "returns a list of index names" $ withTestEnv $ do
1764 _ <- createExampleIndex
1765 ixns <- listIndices
1766 liftIO (ixns `shouldContain` [testIndex])
1768 describe "Index Settings" $ do
1769 it "persists settings" $ withTestEnv $ do
1770 _ <- deleteExampleIndex
1771 _ <- createExampleIndex
1772 let updates = BlocksWrite False :| []
1773 updateResp <- updateIndexSettings updates testIndex
1774 liftIO $ validateStatus updateResp 200
1775 getResp <- getIndexSettings testIndex
1776 liftIO $
1777 getResp `shouldBe` Right (IndexSettingsSummary
1778 testIndex
1779 (IndexSettings (ShardCount 1) (ReplicaCount 0))
1780 (NE.toList updates))
1782 describe "Index Optimization" $ do
1783 it "returns a successful response upon completion" $ withTestEnv $ do
1784 _ <- createExampleIndex
1785 resp <- optimizeIndex (IndexList (testIndex :| [])) defaultIndexOptimizationSettings
1786 liftIO $ validateStatus resp 200
1788 describe "JSON instances" $ do
1789 propJSON (Proxy :: Proxy Version)
1790 propJSON (Proxy :: Proxy IndexName)
1791 propJSON (Proxy :: Proxy MappingName)
1792 propJSON (Proxy :: Proxy DocId)
1793 propJSON (Proxy :: Proxy IndexAliasRouting)
1794 propJSON (Proxy :: Proxy RoutingValue)
1795 propJSON (Proxy :: Proxy ShardCount)
1796 propJSON (Proxy :: Proxy ReplicaCount)
1797 propJSON (Proxy :: Proxy TemplateName)
1798 propJSON (Proxy :: Proxy TemplatePattern)
1799 propJSON (Proxy :: Proxy QueryString)
1800 propJSON (Proxy :: Proxy FieldName)
1801 propJSON (Proxy :: Proxy CacheName)
1802 propJSON (Proxy :: Proxy CacheKey)
1803 propJSON (Proxy :: Proxy Existence)
1804 propJSON (Proxy :: Proxy CutoffFrequency)
1805 propJSON (Proxy :: Proxy Analyzer)
1806 propJSON (Proxy :: Proxy MaxExpansions)
1807 propJSON (Proxy :: Proxy Lenient)
1808 propJSON (Proxy :: Proxy Tiebreaker)
1809 propJSON (Proxy :: Proxy Boost)
1810 propJSON (Proxy :: Proxy BoostTerms)
1811 propJSON (Proxy :: Proxy MinimumMatch)
1812 propJSON (Proxy :: Proxy DisableCoord)
1813 propJSON (Proxy :: Proxy IgnoreTermFrequency)
1814 propJSON (Proxy :: Proxy MinimumTermFrequency)
1815 propJSON (Proxy :: Proxy MaxQueryTerms)
1816 propJSON (Proxy :: Proxy Fuzziness)
1817 propJSON (Proxy :: Proxy PrefixLength)
1818 propJSON (Proxy :: Proxy TypeName)
1819 propJSON (Proxy :: Proxy PercentMatch)
1820 propJSON (Proxy :: Proxy StopWord)
1821 propJSON (Proxy :: Proxy QueryPath)
1822 propJSON (Proxy :: Proxy AllowLeadingWildcard)
1823 propJSON (Proxy :: Proxy LowercaseExpanded)
1824 propJSON (Proxy :: Proxy EnablePositionIncrements)
1825 propJSON (Proxy :: Proxy AnalyzeWildcard)
1826 propJSON (Proxy :: Proxy GeneratePhraseQueries)
1827 propJSON (Proxy :: Proxy Locale)
1828 propJSON (Proxy :: Proxy MaxWordLength)
1829 propJSON (Proxy :: Proxy MinWordLength)
1830 propJSON (Proxy :: Proxy PhraseSlop)
1831 propJSON (Proxy :: Proxy MinDocFrequency)
1832 propJSON (Proxy :: Proxy MaxDocFrequency)
1833 propJSON (Proxy :: Proxy Filter)
1834 propJSON (Proxy :: Proxy Query)
1835 propJSON (Proxy :: Proxy SimpleQueryStringQuery)
1836 propJSON (Proxy :: Proxy FieldOrFields)
1837 propJSON (Proxy :: Proxy SimpleQueryFlag)
1838 propJSON (Proxy :: Proxy RegexpQuery)
1839 propJSON (Proxy :: Proxy QueryStringQuery)
1840 propJSON (Proxy :: Proxy RangeQuery)
1841 propJSON (Proxy :: Proxy PrefixQuery)
1842 propJSON (Proxy :: Proxy NestedQuery)
1843 propJSON (Proxy :: Proxy MoreLikeThisFieldQuery)
1844 propJSON (Proxy :: Proxy MoreLikeThisQuery)
1845 propJSON (Proxy :: Proxy IndicesQuery)
1846 propJSON (Proxy :: Proxy HasParentQuery)
1847 propJSON (Proxy :: Proxy HasChildQuery)
1848 propJSON (Proxy :: Proxy FuzzyQuery)
1849 propJSON (Proxy :: Proxy FuzzyLikeFieldQuery)
1850 propJSON (Proxy :: Proxy FuzzyLikeThisQuery)
1851 propJSON (Proxy :: Proxy FilteredQuery)
1852 propJSON (Proxy :: Proxy DisMaxQuery)
1853 propJSON (Proxy :: Proxy CommonTermsQuery)
1854 propJSON (Proxy :: Proxy CommonMinimumMatch)
1855 propJSON (Proxy :: Proxy BoostingQuery)
1856 propJSON (Proxy :: Proxy BoolQuery)
1857 propJSON (Proxy :: Proxy MatchQuery)
1858 propJSON (Proxy :: Proxy MultiMatchQueryType)
1859 propJSON (Proxy :: Proxy BooleanOperator)
1860 propJSON (Proxy :: Proxy ZeroTermsQuery)
1861 propJSON (Proxy :: Proxy MatchQueryType)
1862 propJSON (Proxy :: Proxy AliasRouting)
1863 propJSON (Proxy :: Proxy IndexAliasCreate)
1864 propJSON (Proxy :: Proxy SearchAliasRouting)
1865 propJSON (Proxy :: Proxy ScoreType)
1866 propJSON (Proxy :: Proxy Distance)
1867 propJSON (Proxy :: Proxy DistanceUnit)
1868 propJSON (Proxy :: Proxy DistanceType)
1869 propJSON (Proxy :: Proxy OptimizeBbox)
1870 propJSON (Proxy :: Proxy GeoBoundingBoxConstraint)
1871 propJSON (Proxy :: Proxy GeoFilterType)
1872 propJSON (Proxy :: Proxy GeoBoundingBox)
1873 propJSON (Proxy :: Proxy LatLon)
1874 propJSON (Proxy :: Proxy RangeExecution)
1875 prop "RegexpFlags FromJSON/ToJSON roundtrips, removing dups " $ \rfs ->
1876 let expected = case rfs of
1877 SomeRegexpFlags fs -> SomeRegexpFlags (NE.fromList (nub (NE.toList fs)))
1878 x -> x
1879 in parseEither parseJSON (toJSON rfs) === Right expected
1880 propJSON (Proxy :: Proxy BoolMatch)
1881 propJSON (Proxy :: Proxy Term)
1882 propJSON (Proxy :: Proxy MultiMatchQuery)
1883 propJSON (Proxy :: Proxy IndexSettings)
1884 propJSON (Proxy :: Proxy UpdatableIndexSetting')
1885 propJSON (Proxy :: Proxy ReplicaBounds)
1886 propJSON (Proxy :: Proxy Bytes)
1887 propJSON (Proxy :: Proxy AllocationPolicy)
1888 propJSON (Proxy :: Proxy InitialShardCount)
1889 propJSON (Proxy :: Proxy FSType)
1890 propJSON (Proxy :: Proxy CompoundFormat)
1891 propJSON (Proxy :: Proxy TemplateQueryInline)
1893-- Temporary solution for lacking of generic derivation of Arbitrary
1894-- We use generics-sop, as it's much more concise than directly using GHC.Generics
1896-- This will be unneeded after https://github.com/nick8325/quickcheck/pull/112
1897-- is merged and released
1898sopArbitrary :: forall a. (Generic a, SOP.GTo a, SOP.All SOP.SListI (SOP.GCode a), SOP.All2 Arbitrary (SOP.GCode a)) => Gen a
1899sopArbitrary = fmap SOP.gto sopArbitrary'
1901sopArbitrary' :: forall xss. (SOP.All SOP.SListI xss, SOP.All2 Arbitrary xss) => Gen (SOP.SOP SOP.I xss)
1902sopArbitrary' = SOP.hsequence =<< elements (SOP.apInjs_POP $ SOP.hcpure p arbitrary)
1903 where
1904 p :: Proxy Arbitrary
1905 p = Proxy