git.iko.soy/typeable/bloodhound
on es-2-canary help sign in
typeable/bloodhound/tests/tests.hs
1861 lines 86 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.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.Posix.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, Show l, ApproxEq r, Show 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
599-- | Due to the way nodeattrfilters get serialized here, they may come
600-- out in a different order, but they are morally equivalent
601instance ApproxEq UpdatableIndexSetting where
602 RoutingAllocationInclude a =~ RoutingAllocationInclude b =
603 NE.sort a =~ NE.sort b
604 RoutingAllocationExclude a =~ RoutingAllocationExclude b =
605 NE.sort a =~ NE.sort b
606 RoutingAllocationRequire a =~ RoutingAllocationRequire b =
607 NE.sort a =~ NE.sort b
608 a =~ b = a == b
609 showApproxEq (RoutingAllocationInclude xs) = show (RoutingAllocationInclude (NE.sort xs))
610 showApproxEq (RoutingAllocationExclude xs) = show (RoutingAllocationExclude (NE.sort xs))
611 showApproxEq (RoutingAllocationRequire xs) = show (RoutingAllocationRequire (NE.sort xs))
612 showApproxEq x = show x
615noDuplicates :: Eq a => [a] -> Bool
616noDuplicates xs = nub xs == xs
618instance Arbitrary NominalDiffTime where
619 arbitrary = fromInteger <$> arbitrary
621#if !MIN_VERSION_QuickCheck(2,8,0)
622instance (Arbitrary k, Ord k, Arbitrary v) => Arbitrary (M.Map k v) where
623 arbitrary = M.fromList <$> arbitrary
624#endif
626instance Arbitrary Text where
627 arbitrary = T.pack <$> arbitrary
629instance Arbitrary UTCTime where
630 arbitrary = UTCTime
631 <$> arbitrary
632 <*> (fromRational . toRational <$> choose (0::Double, 86400))
634instance Arbitrary Day where
635 arbitrary = ModifiedJulianDay <$> (2000 +) <$> arbitrary
636 shrink = (ModifiedJulianDay <$>) . shrink . toModifiedJulianDay
638#if !MIN_VERSION_QuickCheck(2,9,0)
639instance Arbitrary a => Arbitrary (NonEmpty a) where
640 arbitrary = liftA2 (:|) arbitrary arbitrary
641#endif
643arbitraryScore :: Gen Score
644arbitraryScore = fmap getPositive <$> arbitrary
646instance (Arbitrary a, Typeable a) => Arbitrary (Hit a) where
647 arbitrary = Hit <$> arbitrary
648 <*> arbitrary
649 <*> arbitrary
650 <*> arbitraryScore
651 <*> arbitrary
652 <*> arbitrary
653 shrink = genericShrink
656instance (Arbitrary a, Typeable a) => Arbitrary (SearchHits a) where
657 arbitrary = reduceSize $ do
658 tot <- getPositive <$> arbitrary
659 score <- arbitraryScore
660 hs <- arbitrary
661 return $ SearchHits tot score hs
662 shrink = genericShrink
664reduceSize :: Gen a -> Gen a
665reduceSize f = sized $ \n -> resize (n `div` 2) f
667getSource :: EsResult a -> Maybe a
668getSource = fmap _source . foundResult
670grabFirst :: Either EsError (SearchResult a) -> Either EsError a
671grabFirst r =
672 case fmap (hitSource . head . hits . searchHits) r of
673 (Left e) -> Left e
674 (Right Nothing) -> Left (EsError 500 "Source was missing")
675 (Right (Just x)) -> Right x
677-------------------------------------------------------------------------------
678arbitraryAlphaNum :: Gen Char
679arbitraryAlphaNum = oneof [choose ('a', 'z')
680 ,choose ('A','Z')
681 , choose ('0', '9')]
683instance Arbitrary RoutingValue where
684 arbitrary = RoutingValue . T.pack <$> listOf1 arbitraryAlphaNum
686instance Arbitrary AliasRouting where
687 arbitrary = oneof [allAlias
688 ,one
689 ,theOther
690 ,both]
691 where one = GranularAliasRouting
692 <$> (Just <$> arbitrary)
693 <*> pure Nothing
694 theOther = GranularAliasRouting Nothing
695 <$> (Just <$> arbitrary)
696 both = GranularAliasRouting
697 <$> (Just <$> arbitrary)
698 <*> (Just <$> arbitrary)
699 allAlias = AllAliasRouting <$> arbitrary
700 shrink = genericShrink
703instance Arbitrary FieldName where
704 arbitrary = FieldName . T.pack <$> listOf1 arbitraryAlphaNum
705 shrink = genericShrink
708instance Arbitrary RegexpFlags where
709 arbitrary = oneof [ pure AllRegexpFlags
710 , pure NoRegexpFlags
711 , SomeRegexpFlags <$> genUniqueFlags
712 ]
713 where genUniqueFlags = NE.fromList . nub <$> listOf1 arbitrary
714 shrink = genericShrink
717instance Arbitrary IndexAliasCreate where
718 arbitrary = IndexAliasCreate <$> arbitrary <*> reduceSize arbitrary
719 shrink = genericShrink
721instance Arbitrary Query where
722 arbitrary = reduceSize $ oneof [ TermQuery <$> arbitrary <*> arbitrary
723 , TermsQuery <$> arbitrary <*> arbitrary
724 , QueryMatchQuery <$> arbitrary
725 , QueryMultiMatchQuery <$> arbitrary
726 , QueryBoolQuery <$> arbitrary
727 , QueryBoostingQuery <$> arbitrary
728 , QueryCommonTermsQuery <$> arbitrary
729 , ConstantScoreFilter <$> arbitrary <*> arbitrary
730 , ConstantScoreQuery <$> arbitrary <*> arbitrary
731 , QueryDisMaxQuery <$> arbitrary
732 , QueryFilteredQuery <$> arbitrary
733 , QueryFuzzyLikeThisQuery <$> arbitrary
734 , QueryFuzzyLikeFieldQuery <$> arbitrary
735 , QueryFuzzyQuery <$> arbitrary
736 , QueryHasChildQuery <$> arbitrary
737 , QueryHasParentQuery <$> arbitrary
738 , IdsQuery <$> arbitrary <*> arbitrary
739 , QueryIndicesQuery <$> arbitrary
740 , MatchAllQuery <$> arbitrary
741 , QueryMoreLikeThisQuery <$> arbitrary
742 , QueryMoreLikeThisFieldQuery <$> arbitrary
743 , QueryNestedQuery <$> arbitrary
744 , QueryPrefixQuery <$> arbitrary
745 , QueryQueryStringQuery <$> arbitrary
746 , QuerySimpleQueryStringQuery <$> arbitrary
747 , QueryRangeQuery <$> arbitrary
748 , QueryRegexpQuery <$> arbitrary
749 ]
750 shrink = genericShrink
752instance Arbitrary Filter where
753 arbitrary = reduceSize $ oneof [ AndFilter <$> arbitrary <*> arbitrary
754 , OrFilter <$> arbitrary <*> arbitrary
755 , NotFilter <$> arbitrary <*> arbitrary
756 , pure IdentityFilter
757 , BoolFilter <$> arbitrary
758 , ExistsFilter <$> arbitrary
759 , GeoBoundingBoxFilter <$> arbitrary
760 , GeoDistanceFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
761 , GeoDistanceRangeFilter <$> arbitrary <*> arbitrary
762 , GeoPolygonFilter <$> arbitrary <*> arbitrary
763 , IdsFilter <$> arbitrary <*> arbitrary
764 , LimitFilter <$> arbitrary
765 , MissingFilter <$> arbitrary <*> arbitrary <*> arbitrary
766 , PrefixFilter <$> arbitrary <*> arbitrary <*> arbitrary
767 , QueryFilter <$> arbitrary <*> arbitrary
768 , RangeFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
769 , RegexpFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
770 , TermFilter <$> arbitrary <*> arbitrary]
771 shrink = genericShrink
773instance Arbitrary ReplicaBounds where
774 arbitrary = oneof [ replicasBounded
775 , replicasLowerBounded
776 , pure ReplicasUnbounded
777 ]
778 where replicasBounded = do Positive a <- arbitrary
779 Positive b <- arbitrary
780 return (ReplicasBounded a b)
781 replicasLowerBounded = do Positive a <- arbitrary
782 return (ReplicasLowerBounded a)
784instance Arbitrary NodeAttrName where
785 arbitrary = NodeAttrName . T.pack <$> listOf1 arbitraryAlphaNum
788instance Arbitrary NodeAttrFilter where
789 arbitrary = do
790 n <- arbitrary
791 s:ss <- listOf1 (listOf1 arbitraryAlphaNum)
792 let ts = T.pack <$> s :| ss
793 return (NodeAttrFilter n ts)
794 shrink = genericShrink
796instance Arbitrary VersionNumber where
797 arbitrary = mk . fmap getPositive . getNonEmpty <$> arbitrary
798 where
799 mk versions = VersionNumber (Vers.Version versions [])
801instance Arbitrary IndexName where arbitrary = sopArbitrary; shrink = genericShrink
802instance Arbitrary MappingName where arbitrary = sopArbitrary; shrink = genericShrink
803instance Arbitrary DocId where arbitrary = sopArbitrary; shrink = genericShrink
804instance Arbitrary Version where arbitrary = sopArbitrary; shrink = genericShrink
805instance Arbitrary BuildHash where arbitrary = sopArbitrary; shrink = genericShrink
806instance Arbitrary IndexAliasRouting where arbitrary = sopArbitrary; shrink = genericShrink
807instance Arbitrary ShardCount where arbitrary = sopArbitrary; shrink = genericShrink
808instance Arbitrary ReplicaCount where arbitrary = sopArbitrary; shrink = genericShrink
809instance Arbitrary TemplateName where arbitrary = sopArbitrary; shrink = genericShrink
810instance Arbitrary TemplatePattern where arbitrary = sopArbitrary; shrink = genericShrink
811instance Arbitrary QueryString where arbitrary = sopArbitrary; shrink = genericShrink
812instance Arbitrary CacheName where arbitrary = sopArbitrary; shrink = genericShrink
813instance Arbitrary CacheKey where arbitrary = sopArbitrary; shrink = genericShrink
814instance Arbitrary Existence where arbitrary = sopArbitrary; shrink = genericShrink
815instance Arbitrary CutoffFrequency where arbitrary = sopArbitrary; shrink = genericShrink
816instance Arbitrary Analyzer where arbitrary = sopArbitrary; shrink = genericShrink
817instance Arbitrary MaxExpansions where arbitrary = sopArbitrary; shrink = genericShrink
818instance Arbitrary Lenient where arbitrary = sopArbitrary; shrink = genericShrink
819instance Arbitrary Tiebreaker where arbitrary = sopArbitrary; shrink = genericShrink
820instance Arbitrary Boost where arbitrary = sopArbitrary; shrink = genericShrink
821instance Arbitrary BoostTerms where arbitrary = sopArbitrary; shrink = genericShrink
822instance Arbitrary MinimumMatch where arbitrary = sopArbitrary; shrink = genericShrink
823instance Arbitrary DisableCoord where arbitrary = sopArbitrary; shrink = genericShrink
824instance Arbitrary IgnoreTermFrequency where arbitrary = sopArbitrary; shrink = genericShrink
825instance Arbitrary MinimumTermFrequency where arbitrary = sopArbitrary; shrink = genericShrink
826instance Arbitrary MaxQueryTerms where arbitrary = sopArbitrary; shrink = genericShrink
827instance Arbitrary Fuzziness where arbitrary = sopArbitrary; shrink = genericShrink
828instance Arbitrary PrefixLength where arbitrary = sopArbitrary; shrink = genericShrink
829instance Arbitrary TypeName where arbitrary = sopArbitrary; shrink = genericShrink
830instance Arbitrary PercentMatch where arbitrary = sopArbitrary; shrink = genericShrink
831instance Arbitrary StopWord where arbitrary = sopArbitrary; shrink = genericShrink
832instance Arbitrary QueryPath where arbitrary = sopArbitrary; shrink = genericShrink
833instance Arbitrary AllowLeadingWildcard where arbitrary = sopArbitrary; shrink = genericShrink
834instance Arbitrary LowercaseExpanded where arbitrary = sopArbitrary; shrink = genericShrink
835instance Arbitrary EnablePositionIncrements where arbitrary = sopArbitrary; shrink = genericShrink
836instance Arbitrary AnalyzeWildcard where arbitrary = sopArbitrary; shrink = genericShrink
837instance Arbitrary GeneratePhraseQueries where arbitrary = sopArbitrary; shrink = genericShrink
838instance Arbitrary Locale where arbitrary = sopArbitrary; shrink = genericShrink
839instance Arbitrary MaxWordLength where arbitrary = sopArbitrary; shrink = genericShrink
840instance Arbitrary MinWordLength where arbitrary = sopArbitrary; shrink = genericShrink
841instance Arbitrary PhraseSlop where arbitrary = sopArbitrary; shrink = genericShrink
842instance Arbitrary MinDocFrequency where arbitrary = sopArbitrary; shrink = genericShrink
843instance Arbitrary MaxDocFrequency where arbitrary = sopArbitrary; shrink = genericShrink
844instance Arbitrary Regexp where arbitrary = sopArbitrary; shrink = genericShrink
845instance Arbitrary SimpleQueryStringQuery where arbitrary = sopArbitrary; shrink = genericShrink
846instance Arbitrary FieldOrFields where arbitrary = sopArbitrary; shrink = genericShrink
847instance Arbitrary SimpleQueryFlag where arbitrary = sopArbitrary; shrink = genericShrink
848instance Arbitrary RegexpQuery where arbitrary = sopArbitrary; shrink = genericShrink
849instance Arbitrary QueryStringQuery where arbitrary = sopArbitrary; shrink = genericShrink
850instance Arbitrary RangeQuery where arbitrary = sopArbitrary; shrink = genericShrink
851instance Arbitrary RangeValue where arbitrary = sopArbitrary; shrink = genericShrink
852instance Arbitrary PrefixQuery where arbitrary = sopArbitrary; shrink = genericShrink
853instance Arbitrary NestedQuery where arbitrary = sopArbitrary; shrink = genericShrink
854instance Arbitrary MoreLikeThisFieldQuery where arbitrary = sopArbitrary; shrink = genericShrink
855instance Arbitrary MoreLikeThisQuery where arbitrary = sopArbitrary; shrink = genericShrink
856instance Arbitrary IndicesQuery where arbitrary = sopArbitrary; shrink = genericShrink
857instance Arbitrary HasParentQuery where arbitrary = sopArbitrary; shrink = genericShrink
858instance Arbitrary HasChildQuery where arbitrary = sopArbitrary; shrink = genericShrink
859instance Arbitrary FuzzyQuery where arbitrary = sopArbitrary; shrink = genericShrink
860instance Arbitrary FuzzyLikeFieldQuery where arbitrary = sopArbitrary; shrink = genericShrink
861instance Arbitrary FuzzyLikeThisQuery where arbitrary = sopArbitrary; shrink = genericShrink
862instance Arbitrary FilteredQuery where arbitrary = sopArbitrary; shrink = genericShrink
863instance Arbitrary DisMaxQuery where arbitrary = sopArbitrary; shrink = genericShrink
864instance Arbitrary CommonTermsQuery where arbitrary = sopArbitrary; shrink = genericShrink
865instance Arbitrary DistanceRange where arbitrary = sopArbitrary; shrink = genericShrink
866instance Arbitrary MultiMatchQuery where arbitrary = sopArbitrary; shrink = genericShrink
867instance Arbitrary LessThanD where arbitrary = sopArbitrary; shrink = genericShrink
868instance Arbitrary LessThanEqD where arbitrary = sopArbitrary; shrink = genericShrink
869instance Arbitrary GreaterThanD where arbitrary = sopArbitrary; shrink = genericShrink
870instance Arbitrary GreaterThanEqD where arbitrary = sopArbitrary; shrink = genericShrink
871instance Arbitrary LessThan where arbitrary = sopArbitrary; shrink = genericShrink
872instance Arbitrary LessThanEq where arbitrary = sopArbitrary; shrink = genericShrink
873instance Arbitrary GreaterThan where arbitrary = sopArbitrary; shrink = genericShrink
874instance Arbitrary GreaterThanEq where arbitrary = sopArbitrary; shrink = genericShrink
875instance Arbitrary GeoPoint where arbitrary = sopArbitrary; shrink = genericShrink
876instance Arbitrary NullValue where arbitrary = sopArbitrary; shrink = genericShrink
877instance Arbitrary MinimumMatchHighLow where arbitrary = sopArbitrary; shrink = genericShrink
878instance Arbitrary CommonMinimumMatch where arbitrary = sopArbitrary; shrink = genericShrink
879instance Arbitrary BoostingQuery where arbitrary = sopArbitrary; shrink = genericShrink
880instance Arbitrary BoolQuery where arbitrary = sopArbitrary; shrink = genericShrink
881instance Arbitrary MatchQuery where arbitrary = sopArbitrary; shrink = genericShrink
882instance Arbitrary MultiMatchQueryType where arbitrary = sopArbitrary; shrink = genericShrink
883instance Arbitrary BooleanOperator where arbitrary = sopArbitrary; shrink = genericShrink
884instance Arbitrary ZeroTermsQuery where arbitrary = sopArbitrary; shrink = genericShrink
885instance Arbitrary MatchQueryType where arbitrary = sopArbitrary; shrink = genericShrink
886instance Arbitrary SearchAliasRouting where arbitrary = sopArbitrary; shrink = genericShrink
887instance Arbitrary ScoreType where arbitrary = sopArbitrary; shrink = genericShrink
888instance Arbitrary Distance where arbitrary = sopArbitrary; shrink = genericShrink
889instance Arbitrary DistanceUnit where arbitrary = sopArbitrary; shrink = genericShrink
890instance Arbitrary DistanceType where arbitrary = sopArbitrary; shrink = genericShrink
891instance Arbitrary OptimizeBbox where arbitrary = sopArbitrary; shrink = genericShrink
892instance Arbitrary GeoBoundingBoxConstraint where arbitrary = sopArbitrary; shrink = genericShrink
893instance Arbitrary GeoFilterType where arbitrary = sopArbitrary; shrink = genericShrink
894instance Arbitrary GeoBoundingBox where arbitrary = sopArbitrary; shrink = genericShrink
895instance Arbitrary LatLon where arbitrary = sopArbitrary; shrink = genericShrink
896instance Arbitrary RangeExecution where arbitrary = sopArbitrary; shrink = genericShrink
897instance Arbitrary RegexpFlag where arbitrary = sopArbitrary; shrink = genericShrink
898instance Arbitrary BoolMatch where arbitrary = sopArbitrary; shrink = genericShrink
899instance Arbitrary Term where arbitrary = sopArbitrary; shrink = genericShrink
900instance Arbitrary IndexSettings where arbitrary = sopArbitrary; shrink = genericShrink
901instance Arbitrary UpdatableIndexSetting where arbitrary = sopArbitrary; shrink = genericShrink
902instance Arbitrary Bytes where arbitrary = sopArbitrary; shrink = genericShrink
903instance Arbitrary AllocationPolicy where arbitrary = sopArbitrary; shrink = genericShrink
904instance Arbitrary InitialShardCount where arbitrary = sopArbitrary; shrink = genericShrink
905instance Arbitrary FSType where arbitrary = sopArbitrary; shrink = genericShrink
906instance Arbitrary CompoundFormat where arbitrary = sopArbitrary; shrink = genericShrink
907instance Arbitrary FsSnapshotRepo where arbitrary = sopArbitrary; shrink = genericShrink
908instance Arbitrary SnapshotRepoName where arbitrary = sopArbitrary; shrink = genericShrink
910newtype UpdatableIndexSetting' = UpdatableIndexSetting' UpdatableIndexSetting
911 deriving (Show, Eq, ToJSON, FromJSON, ApproxEq, Typeable)
913instance Arbitrary UpdatableIndexSetting' where
914 arbitrary = do
915 settings <- arbitrary
916 return $ UpdatableIndexSetting' $ case settings of
917 RoutingAllocationInclude xs -> RoutingAllocationInclude (dropDuplicateAttrNames xs)
918 RoutingAllocationExclude xs -> RoutingAllocationExclude (dropDuplicateAttrNames xs)
919 RoutingAllocationRequire xs -> RoutingAllocationRequire (dropDuplicateAttrNames xs)
920 x -> x
921 where
922 dropDuplicateAttrNames = NE.fromList . L.nubBy sameAttrName . NE.toList
923 sameAttrName a b = nodeAttrFilterName a == nodeAttrFilterName b
925main :: IO ()
926main = hspec $ do
928 describe "index create/delete API" $ do
929 it "creates and then deletes the requested index" $ withTestEnv $ do
930 -- priming state.
931 _ <- deleteExampleIndex
932 resp <- createExampleIndex
933 deleteResp <- deleteExampleIndex
934 liftIO $ do
935 validateStatus resp 200
936 validateStatus deleteResp 200
938 describe "error parsing" $ do
939 it "can parse EsErrors for < 2.0" $ when' (atmost es16) $ withTestEnv $ do
940 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
941 let errorResp = eitherDecode (responseBody res)
942 liftIO (errorResp `shouldBe` Right (EsError 404 "IndexMissingException[[bogus] missing]"))
944 it "can parse EsErrors for >= 2.0" $ when' (atleast es20) $ withTestEnv $ do
945 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
946 let errorResp = eitherDecode (responseBody res)
947 liftIO (errorResp `shouldBe` Right (EsError 404 "no such index"))
949 describe "document API" $ do
950 it "indexes, updates, gets, and then deletes the generated document" $ withTestEnv $ do
951 _ <- insertData
952 _ <- updateData
953 docInserted <- getDocument testIndex testMapping (DocId "1")
954 let newTweet = eitherDecode
955 (responseBody docInserted) :: Either String (EsResult Tweet)
956 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just patchedTweet))
958 it "indexes, gets, and then deletes the generated document with a DocId containing a space" $ withTestEnv $ do
959 _ <- insertWithSpaceInId
960 docInserted <- getDocument testIndex testMapping (DocId "Hello World")
961 let newTweet = eitherDecode
962 (responseBody docInserted) :: Either String (EsResult Tweet)
963 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))
965 it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do
966 doc <- getDocument testIndex testMapping (DocId "bogus")
967 let noTweet = eitherDecode
968 (responseBody doc) :: Either String (EsResult Tweet)
969 liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing
971 it "can use optimistic concurrency control" $ withTestEnv $ do
972 let ev = ExternalDocVersion minBound
973 let cfg = defaultIndexDocumentSettings { idsVersionControl = ExternalGT ev }
974 resetIndex
975 res <- insertData' cfg
976 liftIO $ isCreated res `shouldBe` True
977 res' <- insertData' cfg
978 liftIO $ isVersionConflict res' `shouldBe` True
980 it "indexes two documents in a parent/child relationship and checks that the child exists" $ withTestEnv $ do
981 resetIndex
982 _ <- putMapping testIndex (MappingName "child") ChildMapping
983 _ <- putMapping testIndex (MappingName "parent") ParentMapping
984 _ <- indexDocument testIndex (MappingName "parent") defaultIndexDocumentSettings exampleTweet (DocId "1")
985 let parent = (Just . DocumentParent . DocId) "1"
986 ids = IndexDocumentSettings NoVersionControl parent
987 _ <- indexDocument testIndex (MappingName "child") ids otherTweet (DocId "2")
988 _ <- refreshIndex testIndex
989 exists <- documentExists testIndex (MappingName "child") parent (DocId "2")
990 liftIO $ exists `shouldBe` True
992 describe "template API" $ do
993 it "can create a template" $ withTestEnv $ do
994 let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
995 resp <- putTemplate idxTpl (TemplateName "tweet-tpl")
996 liftIO $ validateStatus resp 200
998 it "can detect if a template exists" $ withTestEnv $ do
999 exists <- templateExists (TemplateName "tweet-tpl")
1000 liftIO $ exists `shouldBe` True
1002 it "can delete a template" $ withTestEnv $ do
1003 resp <- deleteTemplate (TemplateName "tweet-tpl")
1004 liftIO $ validateStatus resp 200
1006 it "can detect if a template doesn't exist" $ withTestEnv $ do
1007 exists <- templateExists (TemplateName "tweet-tpl")
1008 liftIO $ exists `shouldBe` False
1010 describe "bulk API" $ do
1011 it "inserts all documents we request" $ withTestEnv $ do
1012 _ <- insertData
1013 let firstTest = BulkTest "blah"
1014 let secondTest = BulkTest "bloo"
1015 let firstDoc = BulkIndex testIndex
1016 testMapping (DocId "2") (toJSON firstTest)
1017 let secondDoc = BulkCreate testIndex
1018 testMapping (DocId "3") (toJSON secondTest)
1019 let stream = V.fromList [firstDoc, secondDoc]
1020 _ <- bulk stream
1021 _ <- refreshIndex testIndex
1022 fDoc <- getDocument testIndex testMapping (DocId "2")
1023 sDoc <- getDocument testIndex testMapping (DocId "3")
1024 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
1025 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
1026 liftIO $ do
1027 fmap getSource maybeFirst `shouldBe` Right (Just firstTest)
1028 fmap getSource maybeSecond `shouldBe` Right (Just secondTest)
1031 describe "query API" $ do
1032 it "returns document for term query and identity filter" $ withTestEnv $ do
1033 _ <- insertData
1034 let query = TermQuery (Term "user" "bitemyapp") Nothing
1035 let filter = IdentityFilter <&&> IdentityFilter
1036 let search = mkSearch (Just query) (Just filter)
1037 myTweet <- searchTweet search
1038 liftIO $
1039 myTweet `shouldBe` Right exampleTweet
1041 it "handles constant score queries" $ withTestEnv $ do
1042 _ <- insertData
1043 let query = TermsQuery "user" ("bitemyapp" :| [])
1044 let cfQuery = ConstantScoreQuery query (Boost 1.0)
1045 let filter = IdentityFilter
1046 let search = mkSearch (Just cfQuery) (Just filter)
1047 myTweet <- searchTweet search
1048 liftIO $
1049 myTweet `shouldBe` Right exampleTweet
1050 it "handles constant score filters" $ withTestEnv $ do
1051 _ <- insertData
1052 let query = TermsQuery "user" ("bitemyapp" :| [])
1053 let cfFilter = ConstantScoreFilter IdentityFilter (Boost 1.0)
1054 let boolQuery = mkBoolQuery [query, cfFilter] [] []
1055 let search = mkSearch (Just (QueryBoolQuery boolQuery)) Nothing
1056 myTweet <- searchTweet search
1057 liftIO $
1058 myTweet `shouldBe` Right exampleTweet
1061 it "returns document for terms query and identity filter" $ withTestEnv $ do
1062 _ <- insertData
1063 let query = TermsQuery "user" ("bitemyapp" :| [])
1064 let filter = IdentityFilter <&&> IdentityFilter
1065 let search = mkSearch (Just query) (Just filter)
1066 myTweet <- searchTweet search
1067 liftIO $
1068 myTweet `shouldBe` Right exampleTweet
1070 it "returns document for match query" $ withTestEnv $ do
1071 _ <- insertData
1072 let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1073 let search = mkSearch (Just query) Nothing
1074 myTweet <- searchTweet search
1075 liftIO $
1076 myTweet `shouldBe` Right exampleTweet
1078 it "returns document for multi-match query" $ withTestEnv $ do
1079 _ <- insertData
1080 let flds = [FieldName "user", FieldName "message"]
1081 let query = QueryMultiMatchQuery $ mkMultiMatchQuery flds (QueryString "bitemyapp")
1082 let search = mkSearch (Just query) Nothing
1083 myTweet <- searchTweet search
1084 liftIO $
1085 myTweet `shouldBe` Right exampleTweet
1087 it "returns document for bool query" $ withTestEnv $ do
1088 _ <- insertData
1089 let innerQuery = QueryMatchQuery $
1090 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1091 let query = QueryBoolQuery $
1092 mkBoolQuery [innerQuery] [] []
1093 let search = mkSearch (Just query) Nothing
1094 myTweet <- searchTweet search
1095 liftIO $
1096 myTweet `shouldBe` Right exampleTweet
1098 it "returns document for boosting query" $ withTestEnv $ do
1099 _ <- insertData
1100 let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1101 let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
1102 let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
1103 let search = mkSearch (Just query) Nothing
1104 myTweet <- searchTweet search
1105 liftIO $
1106 myTweet `shouldBe` Right exampleTweet
1108 it "returns document for common terms query" $ withTestEnv $ do
1109 _ <- insertData
1110 let query = QueryCommonTermsQuery $
1111 CommonTermsQuery (FieldName "user")
1112 (QueryString "bitemyapp")
1113 (CutoffFrequency 0.0001)
1114 Or Or Nothing Nothing Nothing Nothing
1115 let search = mkSearch (Just query) Nothing
1116 myTweet <- searchTweet search
1117 liftIO $
1118 myTweet `shouldBe` Right exampleTweet
1121 describe "sorting" $ do
1122 it "returns documents in the right order" $ withTestEnv $ do
1123 _ <- insertData
1124 _ <- insertOther
1125 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
1126 let search = Search Nothing
1127 (Just IdentityFilter) (Just [sortSpec]) Nothing Nothing
1128 False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
1129 result <- searchTweets search
1130 let myTweet = grabFirst result
1131 liftIO $
1132 myTweet `shouldBe` Right otherTweet
1135 describe "filtering API" $ do
1136 it "returns document for composed boolmatch and identity" $ withTestEnv $ do
1137 _ <- insertData
1138 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
1139 <&&> IdentityFilter
1140 let search = mkSearch Nothing (Just queryFilter)
1141 myTweet <- searchTweet search
1142 liftIO $
1143 myTweet `shouldBe` Right exampleTweet
1145 it "returns document for term filter" $ withTestEnv $ do
1146 _ <- insertData
1147 let termFilter = TermFilter (Term "user" "bitemyapp") False
1148 let search = mkSearch Nothing (Just termFilter)
1149 myTweet <- searchTweet search
1150 liftIO $
1151 myTweet `shouldBe` Right exampleTweet
1153 it "returns document for existential filter" $ withTestEnv $ do
1154 _ <- insertData
1155 let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
1156 myTweet <- searchTweet search
1157 liftIO $
1158 myTweet `shouldBe` Right exampleTweet
1160 it "returns document for geo boundingbox filter" $ withTestEnv $ do
1161 _ <- insertData
1162 let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
1163 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
1164 let geoFilter = GeoBoundingBoxFilter bbConstraint
1165 let search = mkSearch Nothing (Just geoFilter)
1166 myTweet <- searchTweet search
1167 liftIO $
1168 myTweet `shouldBe` Right exampleTweet
1170 it "doesn't return document for nonsensical boundingbox filter" $ withTestEnv $ do
1171 _ <- insertData
1172 let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
1173 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
1174 let geoFilter = GeoBoundingBoxFilter bbConstraint
1175 let search = mkSearch Nothing (Just geoFilter)
1176 searchExpectNoResults search
1178 it "returns document for geo distance filter" $ withTestEnv $ do
1179 _ <- insertData
1180 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1181 let distance = Distance 10.0 Miles
1182 let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
1183 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
1184 let search = mkSearch Nothing (Just geoFilter)
1185 myTweet <- searchTweet search
1186 liftIO $
1187 myTweet `shouldBe` Right exampleTweet
1189 it "returns document for geo distance range filter" $ withTestEnv $ do
1190 _ <- insertData
1191 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1192 let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
1193 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
1194 let search = mkSearch Nothing (Just geoFilter)
1195 myTweet <- searchTweet search
1196 liftIO $
1197 myTweet `shouldBe` Right exampleTweet
1199 it "doesn't return document for wild geo distance range filter" $ withTestEnv $ do
1200 _ <- insertData
1201 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1202 let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
1203 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
1204 let search = mkSearch Nothing (Just geoFilter)
1205 searchExpectNoResults search
1207 it "returns document for geo polygon filter" $ withTestEnv $ do
1208 _ <- insertData
1209 let points = [LatLon 40.0 (-70.00),
1210 LatLon 40.0 (-72.00),
1211 LatLon 41.0 (-70.00),
1212 LatLon 41.0 (-72.00)]
1213 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
1214 let search = mkSearch Nothing (Just geoFilter)
1215 myTweet <- searchTweet search
1216 liftIO $
1217 myTweet `shouldBe` Right exampleTweet
1219 it "doesn't return document for bad geo polygon filter" $ withTestEnv $ do
1220 _ <- insertData
1221 let points = [LatLon 40.0 (-70.00),
1222 LatLon 40.0 (-71.00),
1223 LatLon 41.0 (-70.00),
1224 LatLon 41.0 (-71.00)]
1225 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
1226 let search = mkSearch Nothing (Just geoFilter)
1227 searchExpectNoResults search
1229 it "returns document for ids filter" $ withTestEnv $ do
1230 _ <- insertData
1231 let filter = IdsFilter (MappingName "tweet") [DocId "1"]
1232 let search = mkSearch Nothing (Just filter)
1233 myTweet <- searchTweet search
1234 liftIO $
1235 myTweet `shouldBe` Right exampleTweet
1237 it "returns document for Double range filter" $ withTestEnv $ do
1238 _ <- insertData
1239 let filter = RangeFilter (FieldName "age")
1240 (RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))
1241 RangeExecutionIndex False
1242 let search = mkSearch Nothing (Just filter)
1243 myTweet <- searchTweet search
1244 liftIO $
1245 myTweet `shouldBe` Right exampleTweet
1247 it "returns document for UTCTime date filter" $ withTestEnv $ do
1248 _ <- insertData
1249 let filter = RangeFilter (FieldName "postDate")
1250 (RangeDateGtLt
1251 (GreaterThanD (UTCTime
1252 (ModifiedJulianDay 54000)
1253 (secondsToDiffTime 0)))
1254 (LessThanD (UTCTime
1255 (ModifiedJulianDay 55000)
1256 (secondsToDiffTime 11))))
1257 RangeExecutionIndex False
1258 let search = mkSearch Nothing (Just filter)
1259 myTweet <- searchTweet search
1260 liftIO $
1261 myTweet `shouldBe` Right exampleTweet
1263 it "returns document for regexp filter" $ withTestEnv $ do
1264 _ <- insertData
1265 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
1266 AllRegexpFlags (CacheName "test") False (CacheKey "key")
1267 let search = mkSearch Nothing (Just filter)
1268 myTweet <- searchTweet search
1269 liftIO $
1270 myTweet `shouldBe` Right exampleTweet
1272 it "doesn't return document for non-matching regexp filter" $ withTestEnv $ do
1273 _ <- insertData
1274 let filter = RegexpFilter (FieldName "user")
1275 (Regexp "boy") AllRegexpFlags
1276 (CacheName "test") False (CacheKey "key")
1277 let search = mkSearch Nothing (Just filter)
1278 searchExpectNoResults search
1280 it "returns document for query filter, uncached" $ withTestEnv $ do
1281 _ <- insertData
1282 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) True
1283 search = mkSearch Nothing (Just filter)
1284 myTweet <- searchTweet search
1285 liftIO $ myTweet `shouldBe` Right exampleTweet
1287 it "returns document for query filter, cached" $ withTestEnv $ do
1288 _ <- insertData
1289 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) False
1290 search = mkSearch Nothing (Just filter)
1291 myTweet <- searchTweet search
1292 liftIO $ myTweet `shouldBe` Right exampleTweet
1294 describe "Aggregation API" $ do
1295 it "returns term aggregation results" $ withTestEnv $ do
1296 _ <- insertData
1297 let terms = TermsAgg $ mkTermsAggregation "user"
1298 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1299 searchExpectAggs search
1300 searchValidBucketAgg search "users" toTerms
1302 it "returns cardinality aggregation results" $ withTestEnv $ do
1303 _ <- insertData
1304 let cardinality = CardinalityAgg $ mkCardinalityAggregation $ FieldName "user"
1305 let search = mkAggregateSearch Nothing $ mkAggregations "users" cardinality
1306 let search' = search { Database.Bloodhound.from = From 0, size = Size 0 }
1307 searchExpectAggs search'
1308 let docCountPair k n = (k, object ["value" .= Number n])
1309 res <- searchTweets search'
1310 liftIO $
1311 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "users" 1]))
1313 it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
1314 _ <- insertData
1315 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
1316 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1317 searchExpectAggs search
1318 searchValidBucketAgg search "users" toTerms
1320 -- One of these fails with 1.7.3
1321 it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
1322 _ <- insertData
1323 searchTermsAggHint [Map, Ordinals]
1325 it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do
1326 _ <- insertData
1327 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
1329 it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
1330 _ <- insertData
1331 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
1332 -- One of the above.
1334 it "can execute value_count aggregations" $ withTestEnv $ do
1335 _ <- insertData
1336 _ <- insertOther
1337 let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>
1338 mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))
1339 let search = mkAggregateSearch Nothing ags
1340 let docCountPair k n = (k, object ["value" .= Number n])
1341 res <- searchTweets search
1342 liftIO $
1343 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2
1344 , docCountPair "bogus_count" 0
1345 ]))
1347 it "can execute filter aggregations" $ withTestEnv $ do
1348 _ <- insertData
1349 _ <- insertOther
1350 let ags = mkAggregations "bitemyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "bitemyapp") defaultCache) Nothing)) <>
1351 mkAggregations "notmyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "notmyapp") defaultCache) Nothing))
1352 let search = mkAggregateSearch Nothing ags
1353 let docCountPair k n = (k, object ["doc_count" .= Number n])
1354 res <- searchTweets search
1355 liftIO $
1356 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "bitemyapps" 1
1357 , docCountPair "notmyapps" 1
1358 ]))
1359 it "can execute date_range aggregations" $ withTestEnv $ do
1360 let now = fromGregorian 2015 3 14
1361 let ltAMonthAgo = UTCTime (fromGregorian 2015 3 1) 0
1362 let ltAWeekAgo = UTCTime (fromGregorian 2015 3 10) 0
1363 let oldDoc = exampleTweet { postDate = ltAMonthAgo }
1364 let newDoc = exampleTweet { postDate = ltAWeekAgo }
1365 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings oldDoc (DocId "1")
1366 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings newDoc (DocId "2")
1367 _ <- refreshIndex testIndex
1368 let thisMonth = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMMonth])
1369 let thisWeek = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMWeek])
1370 let agg = DateRangeAggregation (FieldName "postDate") Nothing (thisMonth :| [thisWeek])
1371 let ags = mkAggregations "date_ranges" (DateRangeAgg agg)
1372 let search = mkAggregateSearch Nothing ags
1373 res <- searchTweets search
1374 liftIO $ hitsTotal . searchHits <$> res `shouldBe` Right 2
1375 let bucks = do magrs <- fmapL show (aggregations <$> res)
1376 agrs <- note "no aggregations returned" magrs
1377 rawBucks <- note "no date_ranges aggregation" $ M.lookup "date_ranges" agrs
1378 parseEither parseJSON rawBucks
1379 let fromMonthT = UTCTime (fromGregorian 2015 2 14) 0
1380 let fromWeekT = UTCTime (fromGregorian 2015 3 7) 0
1381 liftIO $ buckets <$> bucks `shouldBe` Right [ DateRangeResult "2015-02-14T00:00:00.000Z-*"
1382 (Just fromMonthT)
1383 (Just "2015-02-14T00:00:00.000Z")
1384 Nothing
1385 Nothing
1387 Nothing
1388 , DateRangeResult "2015-03-07T00:00:00.000Z-*"
1389 (Just fromWeekT)
1390 (Just "2015-03-07T00:00:00.000Z")
1391 Nothing
1392 Nothing
1394 Nothing
1397 it "returns date histogram aggregation results" $ withTestEnv $ do
1398 _ <- insertData
1399 let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
1400 let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
1401 searchExpectAggs search
1402 searchValidBucketAgg search "byDate" toDateHistogram
1404 it "returns date histogram using fractional date" $ withTestEnv $ do
1405 _ <- insertData
1406 let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]
1407 let fractionals = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]
1408 let intervals = periods ++ fractionals
1409 let histogram = mkDateHistogram (FieldName "postDate")
1410 let search interval = mkAggregateSearch Nothing $ mkAggregations "byDate" $ DateHistogramAgg (histogram interval)
1411 let expect interval = searchExpectAggs (search interval)
1412 let valid interval = searchValidBucketAgg (search interval) "byDate" toDateHistogram
1413 forM_ intervals expect
1414 forM_ intervals valid
1416 it "can execute missing aggregations" $ withTestEnv $ do
1417 _ <- insertData
1418 _ <- insertExtra
1419 let ags = mkAggregations "missing_agg" (MissingAgg (MissingAggregation "extra"))
1420 let search = mkAggregateSearch Nothing ags
1421 let docCountPair k n = (k, object ["doc_count" .= Number n])
1422 res <- searchTweets search
1423 liftIO $
1424 fmap aggregations res `shouldBe` Right (Just (M.fromList [docCountPair "missing_agg" 1]))
1426 describe "Highlights API" $ do
1428 it "returns highlight from query when there should be one" $ withTestEnv $ do
1429 _ <- insertData
1430 _ <- insertOther
1431 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1432 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
1434 let search = mkHighlightSearch (Just query) testHighlight
1435 myHighlight <- searchTweetHighlight search
1436 liftIO $
1437 myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
1439 it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
1440 _ <- insertData
1441 _ <- insertOther
1442 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1443 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "user") Nothing]
1445 let search = mkHighlightSearch (Just query) testHighlight
1446 myHighlight <- searchTweetHighlight search
1447 liftIO $
1448 myHighlight `shouldBe` Right Nothing
1450 describe "Source filtering" $ do
1452 it "doesn't include source when sources are disabled" $ withTestEnv $ do
1453 searchExpectSource
1454 NoSource
1455 (Left (EsError 500 "Source was missing"))
1457 it "includes a source" $ withTestEnv $ do
1458 searchExpectSource
1459 (SourcePatterns (PopPattern (Pattern "message")))
1460 (Right (Object (HM.fromList [("message", String "Use haskell!")])))
1462 it "includes sources" $ withTestEnv $ do
1463 searchExpectSource
1464 (SourcePatterns (PopPatterns [Pattern "user", Pattern "message"]))
1465 (Right (Object (HM.fromList [("user",String "bitemyapp"),("message", String "Use haskell!")])))
1467 it "includes source patterns" $ withTestEnv $ do
1468 searchExpectSource
1469 (SourcePatterns (PopPattern (Pattern "*ge")))
1470 (Right (Object (HM.fromList [("age", Number 10000),("message", String "Use haskell!")])))
1472 it "excludes source patterns" $ withTestEnv $ do
1473 searchExpectSource
1474 (SourceIncludeExclude (Include [])
1475 (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate", Pattern "extra"]))
1476 (Right (Object (HM.fromList [("user",String "bitemyapp")])))
1478 describe "ToJSON RegexpFlags" $ do
1479 it "generates the correct JSON for AllRegexpFlags" $
1480 toJSON AllRegexpFlags `shouldBe` String "ALL"
1482 it "generates the correct JSON for NoRegexpFlags" $
1483 toJSON NoRegexpFlags `shouldBe` String "NONE"
1485 it "generates the correct JSON for SomeRegexpFlags" $
1486 let flags = AnyString :| [ Automaton
1487 , Complement
1488 , Empty
1489 , Intersection
1490 , Interval ]
1491 in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
1493 prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
1494 let String str = toJSON flags
1495 flagStrs = T.splitOn "|" str
1496 in noDuplicates flagStrs
1498 describe "omitNulls" $ do
1499 it "checks that omitNulls drops list elements when it should" $
1500 let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))
1501 , "test2" .= (toJSON ("some value" :: Text))]
1502 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1504 it "checks that omitNulls doesn't drop list elements when it shouldn't" $
1505 let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))
1506 , "test2" .= (toJSON ("some value" :: Text))]
1507 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))
1508 , ("test2", String "some value")])
1509 it "checks that omitNulls drops non list elements when it should" $
1510 let dropped = omitNulls $ [ "test1" .= (toJSON Null)
1511 , "test2" .= (toJSON ("some value" :: Text))]
1512 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1513 it "checks that omitNulls doesn't drop non list elements when it shouldn't" $
1514 let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
1515 , "test2" .= (toJSON ("some value" :: Text))]
1516 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
1517 , ("test2", String "some value")])
1518 describe "Monoid (SearchHits a)" $ do
1519 prop "abides the monoid laws" $ eq $
1520 prop_Monoid (T :: T (SearchHits ()))
1522 describe "mkDocVersion" $ do
1523 prop "can never construct an out of range docVersion" $ \i ->
1524 let res = mkDocVersion i
1525 in case res of
1526 Nothing -> property True
1527 Just dv -> (dv >= minBound) .&&.
1528 (dv <= maxBound) .&&.
1529 docVersionNumber dv === i
1531 describe "FsSnapshotRepo" $ do
1532 prop "SnapshotRepo laws" $ \fsr ->
1533 fromGSnapshotRepo (toGSnapshotRepo fsr) === Right (fsr :: FsSnapshotRepo)
1535 describe "snapshot repos" $ do
1536 it "always parses all snapshot repos API" $ when' canSnapshot $ withTestEnv $ do
1537 res <- getSnapshotRepos AllSnapshotRepos
1538 liftIO $ case res of
1539 Left e -> expectationFailure ("Expected a right but got Left " <> show e)
1540 Right _ -> return ()
1542 it "finds an existing list of repos" $ when' canSnapshot $ withTestEnv $ do
1543 let r1n = SnapshotRepoName "bloodhound-repo1"
1544 let r2n = SnapshotRepoName "bloodhound-repo2"
1545 withSnapshotRepo r1n $ \r1 ->
1546 withSnapshotRepo r2n $ \r2 -> do
1547 repos <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| [ExactRepo r2n]))
1548 liftIO $ case repos of
1549 Right xs -> do
1550 let srt = L.sortBy (comparing gSnapshotRepoName)
1551 srt xs `shouldBe` srt [r1, r2]
1552 Left e -> expectationFailure (show e)
1554 it "creates and updates with updateSnapshotRepo" $ when' canSnapshot $ withTestEnv $ do
1555 let r1n = SnapshotRepoName "bloodhound-repo1"
1556 withSnapshotRepo r1n $ \r1 -> do
1557 let Just (String dir) = HM.lookup "location" (gSnapshotRepoSettingsObject (gSnapshotRepoSettings r1))
1558 let noCompression = FsSnapshotRepo r1n (T.unpack dir) False Nothing Nothing Nothing
1559 resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings noCompression
1560 liftIO (validateStatus resp 200)
1561 Right [roundtrippedNoCompression] <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| []))
1562 liftIO (roundtrippedNoCompression `shouldBe` toGSnapshotRepo noCompression)
1564 -- verify came around in 1.4 it seems
1565 it "can verify existing repos" $ when' canSnapshot $ when' (atleast es14) $ withTestEnv $ do
1566 let r1n = SnapshotRepoName "bloodhound-repo1"
1567 withSnapshotRepo r1n $ \_ -> do
1568 res <- verifySnapshotRepo r1n
1569 liftIO $ case res of
1570 Right (SnapshotVerification vs)
1571 | null vs -> expectationFailure "Expected nonempty set of verifying nodes"
1572 | otherwise -> return ()
1573 Left e -> expectationFailure (show e)
1575 describe "snapshots" $ do
1576 it "always parses all snapshots API" $ when' canSnapshot $ withTestEnv $ do
1577 let r1n = SnapshotRepoName "bloodhound-repo1"
1578 withSnapshotRepo r1n $ \_ -> do
1579 res <- getSnapshots r1n AllSnapshots
1580 liftIO $ case res of
1581 Left e -> expectationFailure ("Expected a right but got Left " <> show e)
1582 Right _ -> return ()
1584 it "can parse a snapshot that it created" $ when' canSnapshot $ withTestEnv $ do
1585 let r1n = SnapshotRepoName "bloodhound-repo1"
1586 withSnapshotRepo r1n $ \_ -> do
1587 let s1n = SnapshotName "example-snapshot"
1588 withSnapshot r1n s1n $ do
1589 res <- getSnapshots r1n (SnapshotList (ExactSnap s1n :| []))
1590 liftIO $ case res of
1591 Right [snap]
1592 | snapInfoState snap == SnapshotSuccess &&
1593 snapInfoName snap == s1n -> return ()
1594 | otherwise -> expectationFailure (show snap)
1595 Right [] -> expectationFailure "There were no snapshots"
1596 Right snaps -> expectationFailure ("Expected 1 snapshot but got" <> show (length snaps))
1597 Left e -> expectationFailure (show e)
1599 describe "snapshot restore" $ do
1600 it "can restore a snapshot that we create" $ when' canSnapshot $ withTestEnv $ do
1601 let r1n = SnapshotRepoName "bloodhound-repo1"
1602 withSnapshotRepo r1n $ \_ -> do
1603 let s1n = SnapshotName "example-snapshot"
1604 withSnapshot r1n s1n $ do
1605 let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True }
1606 -- have to close an index to restore it
1607 resp1 <- closeIndex testIndex
1608 liftIO (validateStatus resp1 200)
1609 resp2 <- restoreSnapshot r1n s1n settings
1610 liftIO (validateStatus resp2 200)
1612 it "can restore and rename" $ when' canSnapshot $ withTestEnv $ do
1613 let r1n = SnapshotRepoName "bloodhound-repo1"
1614 withSnapshotRepo r1n $ \_ -> do
1615 let s1n = SnapshotName "example-snapshot"
1616 withSnapshot r1n s1n $ do
1617 let pat = RestoreRenamePattern "bloodhound-tests-twitter-(\\d+)"
1618 let replace = RRTLit "restored-" :| [RRSubWholeMatch]
1619 let expectedIndex = IndexName "restored-bloodhound-tests-twitter-1"
1620 oldEnoughForOverrides <- liftIO (atleast es15)
1621 let overrides = RestoreIndexSettings { restoreOverrideReplicas = Just (ReplicaCount 0) }
1622 let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True
1623 , snapRestoreRenamePattern = Just pat
1624 , snapRestoreRenameReplacement = Just replace
1625 , snapRestoreIndexSettingsOverrides = if oldEnoughForOverrides
1626 then Just overrides
1627 else Nothing
1629 -- have to close an index to restore it
1630 let go = do
1631 resp <- restoreSnapshot r1n s1n settings
1632 liftIO (validateStatus resp 200)
1633 exists <- indexExists expectedIndex
1634 liftIO (exists `shouldBe` True)
1635 go `finally` deleteIndex expectedIndex
1637 describe "getNodesInfo" $ do
1638 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
1639 res <- getNodesInfo LocalNode
1640 liftIO $ case res of
1641 -- This is really just a smoke test for response
1642 -- parsing. Node info is so variable, there's not much I can
1643 -- assert here.
1644 Right NodesInfo {..} -> length nodesInfo `shouldBe` 1
1645 Left e -> expectationFailure ("Expected NodesInfo but got " <> show e)
1647 describe "getNodesStats" $ do
1648 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
1649 res <- getNodesStats LocalNode
1650 liftIO $ case res of
1651 -- This is really just a smoke test for response
1652 -- parsing. Node stats is so variable, there's not much I can
1653 -- assert here.
1654 Right NodesStats {..} -> length nodesStats `shouldBe` 1
1655 Left e -> expectationFailure ("Expected NodesStats but got " <> show e)
1657 describe "Enum DocVersion" $ do
1658 it "follows the laws of Enum, Bounded" $ do
1659 evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall
1660 evaluate (pred minBound :: DocVersion) `shouldThrow` anyErrorCall
1661 evaluate (toEnum 0 :: DocVersion) `shouldThrow` anyErrorCall
1662 evaluate (toEnum 9200000000000000001 :: DocVersion) `shouldThrow` anyErrorCall
1663 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1664 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1665 enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]
1667 describe "scan&scroll API" $ do
1668 it "returns documents using the scan&scroll API" $ withTestEnv $ do
1669 _ <- insertData
1670 _ <- insertOther
1671 let search = (mkSearch (Just $ MatchAllQuery Nothing) Nothing) { size = (Size 1) }
1672 regular_search <- searchTweet search
1673 scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet]
1674 let scan_search = map hitSource scan_search'
1675 liftIO $
1676 regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored
1677 liftIO $
1678 scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]
1680 describe "index aliases" $ do
1681 it "handles the simple case of aliasing an existing index" $ do
1682 let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1683 let create = IndexAliasCreate Nothing Nothing
1684 let action = AddAlias alias create
1686 withTestEnv $ do
1687 resetIndex
1688 resp <- updateIndexAliases (action :| [])
1689 liftIO $ validateStatus resp 200
1690 let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1691 (do aliases <- withTestEnv getIndexAliases
1692 let expected = IndexAliasSummary alias create
1693 case aliases of
1694 Right (IndexAliasesSummary summs) ->
1695 L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1696 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1698 it "handles an alias with routing and a filter" $ do
1699 let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1700 let sar = SearchAliasRouting (RoutingValue "search val" :| [])
1701 let iar = IndexAliasRouting (RoutingValue "index val")
1702 let routing = GranularAliasRouting (Just sar) (Just iar)
1703 let filter = LimitFilter 42
1704 let create = IndexAliasCreate (Just routing) (Just filter)
1705 let action = AddAlias alias create
1707 withTestEnv $ do
1708 resetIndex
1709 resp <- updateIndexAliases (action :| [])
1710 liftIO $ validateStatus resp 200
1711 let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1712 (do aliases <- withTestEnv getIndexAliases
1713 let expected = IndexAliasSummary alias create
1714 case aliases of
1715 Right (IndexAliasesSummary summs) ->
1716 L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1717 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1719 describe "Index Listing" $ do
1720 it "returns a list of index names" $ withTestEnv $ do
1721 _ <- createExampleIndex
1722 ixns <- listIndices
1723 liftIO (ixns `shouldContain` [testIndex])
1725 describe "Index Settings" $ do
1726 it "persists settings" $ withTestEnv $ do
1727 _ <- deleteExampleIndex
1728 _ <- createExampleIndex
1729 let updates = BlocksWrite False :| []
1730 updateResp <- updateIndexSettings updates testIndex
1731 liftIO $ validateStatus updateResp 200
1732 getResp <- getIndexSettings testIndex
1733 liftIO $
1734 getResp `shouldBe` Right (IndexSettingsSummary
1735 testIndex
1736 (IndexSettings (ShardCount 1) (ReplicaCount 0))
1737 (NE.toList updates))
1739 describe "Index Optimization" $ do
1740 it "returns a successful response upon completion" $ withTestEnv $ do
1741 _ <- createExampleIndex
1742 resp <- optimizeIndex (IndexList (testIndex :| [])) defaultIndexOptimizationSettings
1743 liftIO $ validateStatus resp 200
1745 describe "JSON instances" $ do
1746 propJSON (Proxy :: Proxy Version)
1747 propJSON (Proxy :: Proxy IndexName)
1748 propJSON (Proxy :: Proxy MappingName)
1749 propJSON (Proxy :: Proxy DocId)
1750 propJSON (Proxy :: Proxy IndexAliasRouting)
1751 propJSON (Proxy :: Proxy RoutingValue)
1752 propJSON (Proxy :: Proxy ShardCount)
1753 propJSON (Proxy :: Proxy ReplicaCount)
1754 propJSON (Proxy :: Proxy TemplateName)
1755 propJSON (Proxy :: Proxy TemplatePattern)
1756 propJSON (Proxy :: Proxy QueryString)
1757 propJSON (Proxy :: Proxy FieldName)
1758 propJSON (Proxy :: Proxy CacheName)
1759 propJSON (Proxy :: Proxy CacheKey)
1760 propJSON (Proxy :: Proxy Existence)
1761 propJSON (Proxy :: Proxy CutoffFrequency)
1762 propJSON (Proxy :: Proxy Analyzer)
1763 propJSON (Proxy :: Proxy MaxExpansions)
1764 propJSON (Proxy :: Proxy Lenient)
1765 propJSON (Proxy :: Proxy Tiebreaker)
1766 propJSON (Proxy :: Proxy Boost)
1767 propJSON (Proxy :: Proxy BoostTerms)
1768 propJSON (Proxy :: Proxy MinimumMatch)
1769 propJSON (Proxy :: Proxy DisableCoord)
1770 propJSON (Proxy :: Proxy IgnoreTermFrequency)
1771 propJSON (Proxy :: Proxy MinimumTermFrequency)
1772 propJSON (Proxy :: Proxy MaxQueryTerms)
1773 propJSON (Proxy :: Proxy Fuzziness)
1774 propJSON (Proxy :: Proxy PrefixLength)
1775 propJSON (Proxy :: Proxy TypeName)
1776 propJSON (Proxy :: Proxy PercentMatch)
1777 propJSON (Proxy :: Proxy StopWord)
1778 propJSON (Proxy :: Proxy QueryPath)
1779 propJSON (Proxy :: Proxy AllowLeadingWildcard)
1780 propJSON (Proxy :: Proxy LowercaseExpanded)
1781 propJSON (Proxy :: Proxy EnablePositionIncrements)
1782 propJSON (Proxy :: Proxy AnalyzeWildcard)
1783 propJSON (Proxy :: Proxy GeneratePhraseQueries)
1784 propJSON (Proxy :: Proxy Locale)
1785 propJSON (Proxy :: Proxy MaxWordLength)
1786 propJSON (Proxy :: Proxy MinWordLength)
1787 propJSON (Proxy :: Proxy PhraseSlop)
1788 propJSON (Proxy :: Proxy MinDocFrequency)
1789 propJSON (Proxy :: Proxy MaxDocFrequency)
1790 propJSON (Proxy :: Proxy Filter)
1791 propJSON (Proxy :: Proxy Query)
1792 propJSON (Proxy :: Proxy SimpleQueryStringQuery)
1793 propJSON (Proxy :: Proxy FieldOrFields)
1794 propJSON (Proxy :: Proxy SimpleQueryFlag)
1795 propJSON (Proxy :: Proxy RegexpQuery)
1796 propJSON (Proxy :: Proxy QueryStringQuery)
1797 propJSON (Proxy :: Proxy RangeQuery)
1798 propJSON (Proxy :: Proxy PrefixQuery)
1799 propJSON (Proxy :: Proxy NestedQuery)
1800 propJSON (Proxy :: Proxy MoreLikeThisFieldQuery)
1801 propJSON (Proxy :: Proxy MoreLikeThisQuery)
1802 propJSON (Proxy :: Proxy IndicesQuery)
1803 propJSON (Proxy :: Proxy HasParentQuery)
1804 propJSON (Proxy :: Proxy HasChildQuery)
1805 propJSON (Proxy :: Proxy FuzzyQuery)
1806 propJSON (Proxy :: Proxy FuzzyLikeFieldQuery)
1807 propJSON (Proxy :: Proxy FuzzyLikeThisQuery)
1808 propJSON (Proxy :: Proxy FilteredQuery)
1809 propJSON (Proxy :: Proxy DisMaxQuery)
1810 propJSON (Proxy :: Proxy CommonTermsQuery)
1811 propJSON (Proxy :: Proxy CommonMinimumMatch)
1812 propJSON (Proxy :: Proxy BoostingQuery)
1813 propJSON (Proxy :: Proxy BoolQuery)
1814 propJSON (Proxy :: Proxy MatchQuery)
1815 propJSON (Proxy :: Proxy MultiMatchQueryType)
1816 propJSON (Proxy :: Proxy BooleanOperator)
1817 propJSON (Proxy :: Proxy ZeroTermsQuery)
1818 propJSON (Proxy :: Proxy MatchQueryType)
1819 propJSON (Proxy :: Proxy AliasRouting)
1820 propJSON (Proxy :: Proxy IndexAliasCreate)
1821 propJSON (Proxy :: Proxy SearchAliasRouting)
1822 propJSON (Proxy :: Proxy ScoreType)
1823 propJSON (Proxy :: Proxy Distance)
1824 propJSON (Proxy :: Proxy DistanceUnit)
1825 propJSON (Proxy :: Proxy DistanceType)
1826 propJSON (Proxy :: Proxy OptimizeBbox)
1827 propJSON (Proxy :: Proxy GeoBoundingBoxConstraint)
1828 propJSON (Proxy :: Proxy GeoFilterType)
1829 propJSON (Proxy :: Proxy GeoBoundingBox)
1830 propJSON (Proxy :: Proxy LatLon)
1831 propJSON (Proxy :: Proxy RangeExecution)
1832 prop "RegexpFlags FromJSON/ToJSON roundtrips, removing dups " $ \rfs ->
1833 let expected = case rfs of
1834 SomeRegexpFlags fs -> SomeRegexpFlags (NE.fromList (nub (NE.toList fs)))
1835 x -> x
1836 in parseEither parseJSON (toJSON rfs) === Right expected
1837 propJSON (Proxy :: Proxy BoolMatch)
1838 propJSON (Proxy :: Proxy Term)
1839 propJSON (Proxy :: Proxy MultiMatchQuery)
1840 propJSON (Proxy :: Proxy IndexSettings)
1841 propJSON (Proxy :: Proxy UpdatableIndexSetting')
1842 propJSON (Proxy :: Proxy ReplicaBounds)
1843 propJSON (Proxy :: Proxy Bytes)
1844 propJSON (Proxy :: Proxy AllocationPolicy)
1845 propJSON (Proxy :: Proxy InitialShardCount)
1846 propJSON (Proxy :: Proxy FSType)
1847 propJSON (Proxy :: Proxy CompoundFormat)
1849-- Temporary solution for lacking of generic derivation of Arbitrary
1850-- We use generics-sop, as it's much more concise than directly using GHC.Generics
1852-- This will be unneeded after https://github.com/nick8325/quickcheck/pull/112
1853-- is merged and released
1854sopArbitrary :: forall a. (Generic a, SOP.GTo a, SOP.All SOP.SListI (SOP.GCode a), SOP.All2 Arbitrary (SOP.GCode a)) => Gen a
1855sopArbitrary = fmap SOP.gto sopArbitrary'
1857sopArbitrary' :: forall xss. (SOP.All SOP.SListI xss, SOP.All2 Arbitrary xss) => Gen (SOP.SOP SOP.I xss)
1858sopArbitrary' = SOP.hsequence =<< elements (SOP.apInjs_POP $ SOP.hcpure p arbitrary)
1859 where
1860 p :: Proxy Arbitrary
1861 p = Proxy