git.iko.soy/typeable/bloodhound
on 6029754 help sign in
typeable/bloodhound/tests/V1/tests.hs
1880 lines 87 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
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
876 arbitrary = GeoPoint <$> (arbitrary `suchThat` reasonableFieldName) <*> arbitrary
877 where
878 -- These are problematic for geopoint for obvious reasons
879 reasonableFieldName (FieldName "from") = False
880 reasonableFieldName (FieldName "to") = False
881 reasonableFieldName _ = True
882 shrink = genericShrink
883instance Arbitrary NullValue where arbitrary = sopArbitrary; shrink = genericShrink
884instance Arbitrary MinimumMatchHighLow where arbitrary = sopArbitrary; shrink = genericShrink
885instance Arbitrary CommonMinimumMatch where arbitrary = sopArbitrary; shrink = genericShrink
886instance Arbitrary BoostingQuery where arbitrary = sopArbitrary; shrink = genericShrink
887instance Arbitrary BoolQuery where arbitrary = sopArbitrary; shrink = genericShrink
888instance Arbitrary MatchQuery where arbitrary = sopArbitrary; shrink = genericShrink
889instance Arbitrary MultiMatchQueryType where arbitrary = sopArbitrary; shrink = genericShrink
890instance Arbitrary BooleanOperator where arbitrary = sopArbitrary; shrink = genericShrink
891instance Arbitrary ZeroTermsQuery where arbitrary = sopArbitrary; shrink = genericShrink
892instance Arbitrary MatchQueryType where arbitrary = sopArbitrary; shrink = genericShrink
893instance Arbitrary SearchAliasRouting where arbitrary = sopArbitrary; shrink = genericShrink
894instance Arbitrary ScoreType where arbitrary = sopArbitrary; shrink = genericShrink
895instance Arbitrary Distance where arbitrary = sopArbitrary; shrink = genericShrink
896instance Arbitrary DistanceUnit where arbitrary = sopArbitrary; shrink = genericShrink
897instance Arbitrary DistanceType where arbitrary = sopArbitrary; shrink = genericShrink
898instance Arbitrary OptimizeBbox where arbitrary = sopArbitrary; shrink = genericShrink
899instance Arbitrary GeoBoundingBoxConstraint where arbitrary = sopArbitrary; shrink = genericShrink
900instance Arbitrary GeoFilterType where arbitrary = sopArbitrary; shrink = genericShrink
901instance Arbitrary GeoBoundingBox where arbitrary = sopArbitrary; shrink = genericShrink
902instance Arbitrary LatLon where arbitrary = sopArbitrary; shrink = genericShrink
903instance Arbitrary RangeExecution where arbitrary = sopArbitrary; shrink = genericShrink
904instance Arbitrary RegexpFlag where arbitrary = sopArbitrary; shrink = genericShrink
905instance Arbitrary BoolMatch where arbitrary = sopArbitrary; shrink = genericShrink
906instance Arbitrary Term where arbitrary = sopArbitrary; shrink = genericShrink
907instance Arbitrary IndexSettings where arbitrary = sopArbitrary; shrink = genericShrink
908instance Arbitrary UpdatableIndexSetting where arbitrary = sopArbitrary; shrink = genericShrink
909instance Arbitrary Bytes where arbitrary = sopArbitrary; shrink = genericShrink
910instance Arbitrary AllocationPolicy where arbitrary = sopArbitrary; shrink = genericShrink
911instance Arbitrary InitialShardCount where arbitrary = sopArbitrary; shrink = genericShrink
912instance Arbitrary FSType where arbitrary = sopArbitrary; shrink = genericShrink
913instance Arbitrary CompoundFormat where arbitrary = sopArbitrary; shrink = genericShrink
914instance Arbitrary FsSnapshotRepo where arbitrary = sopArbitrary; shrink = genericShrink
915instance Arbitrary SnapshotRepoName where arbitrary = sopArbitrary; shrink = genericShrink
917newtype UpdatableIndexSetting' = UpdatableIndexSetting' UpdatableIndexSetting
918 deriving (Show, Eq, ToJSON, FromJSON, ApproxEq, Typeable)
920instance Arbitrary UpdatableIndexSetting' where
921 arbitrary = do
922 settings <- arbitrary
923 return $ UpdatableIndexSetting' $ case settings of
924 RoutingAllocationInclude xs -> RoutingAllocationInclude (dropDuplicateAttrNames xs)
925 RoutingAllocationExclude xs -> RoutingAllocationExclude (dropDuplicateAttrNames xs)
926 RoutingAllocationRequire xs -> RoutingAllocationRequire (dropDuplicateAttrNames xs)
927 x -> x
928 where
929 dropDuplicateAttrNames = NE.fromList . L.nubBy sameAttrName . NE.toList
930 sameAttrName a b = nodeAttrFilterName a == nodeAttrFilterName b
932main :: IO ()
933main = hspec $ do
935 describe "index create/delete API" $ do
936 it "creates and then deletes the requested index" $ withTestEnv $ do
937 -- priming state.
938 _ <- deleteExampleIndex
939 resp <- createExampleIndex
940 deleteResp <- deleteExampleIndex
941 liftIO $ do
942 validateStatus resp 200
943 validateStatus deleteResp 200
945 describe "error parsing" $ do
946 it "can parse EsErrors for < 2.0" $ when' (atmost es16) $ withTestEnv $ do
947 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
948 let errorResp = eitherDecode (responseBody res)
949 liftIO (errorResp `shouldBe` Right (EsError 404 "IndexMissingException[[bogus] missing]"))
951 it "can parse EsErrors for >= 2.0" $ when' (atleast es20) $ withTestEnv $ do
952 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
953 let errorResp = eitherDecode (responseBody res)
954 liftIO (errorResp `shouldBe` Right (EsError 404 "no such index"))
956 describe "document API" $ do
957 it "indexes, updates, gets, and then deletes the generated document" $ withTestEnv $ do
958 _ <- insertData
959 _ <- updateData
960 docInserted <- getDocument testIndex testMapping (DocId "1")
961 let newTweet = eitherDecode
962 (responseBody docInserted) :: Either String (EsResult Tweet)
963 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just patchedTweet))
965 it "indexes, gets, and then deletes the generated document with a DocId containing a space" $ withTestEnv $ do
966 _ <- insertWithSpaceInId
967 docInserted <- getDocument testIndex testMapping (DocId "Hello World")
968 let newTweet = eitherDecode
969 (responseBody docInserted) :: Either String (EsResult Tweet)
970 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))
972 it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do
973 doc <- getDocument testIndex testMapping (DocId "bogus")
974 let noTweet = eitherDecode
975 (responseBody doc) :: Either String (EsResult Tweet)
976 liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing
978 it "can use optimistic concurrency control" $ withTestEnv $ do
979 let ev = ExternalDocVersion minBound
980 let cfg = defaultIndexDocumentSettings { idsVersionControl = ExternalGT ev }
981 resetIndex
982 res <- insertData' cfg
983 liftIO $ isCreated res `shouldBe` True
984 res' <- insertData' cfg
985 liftIO $ isVersionConflict res' `shouldBe` True
987 it "indexes two documents in a parent/child relationship and checks that the child exists" $ withTestEnv $ do
988 resetIndex
989 _ <- putMapping testIndex (MappingName "child") ChildMapping
990 _ <- putMapping testIndex (MappingName "parent") ParentMapping
991 _ <- indexDocument testIndex (MappingName "parent") defaultIndexDocumentSettings exampleTweet (DocId "1")
992 let parent = (Just . DocumentParent . DocId) "1"
993 ids = IndexDocumentSettings NoVersionControl parent
994 _ <- indexDocument testIndex (MappingName "child") ids otherTweet (DocId "2")
995 _ <- refreshIndex testIndex
996 exists <- documentExists testIndex (MappingName "child") parent (DocId "2")
997 liftIO $ exists `shouldBe` True
999 describe "template API" $ do
1000 it "can create a template" $ withTestEnv $ do
1001 let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
1002 resp <- putTemplate idxTpl (TemplateName "tweet-tpl")
1003 liftIO $ validateStatus resp 200
1005 it "can detect if a template exists" $ withTestEnv $ do
1006 exists <- templateExists (TemplateName "tweet-tpl")
1007 liftIO $ exists `shouldBe` True
1009 it "can delete a template" $ withTestEnv $ do
1010 resp <- deleteTemplate (TemplateName "tweet-tpl")
1011 liftIO $ validateStatus resp 200
1013 it "can detect if a template doesn't exist" $ withTestEnv $ do
1014 exists <- templateExists (TemplateName "tweet-tpl")
1015 liftIO $ exists `shouldBe` False
1017 describe "bulk API" $ do
1018 it "inserts all documents we request" $ withTestEnv $ do
1019 _ <- insertData
1020 let firstTest = BulkTest "blah"
1021 let secondTest = BulkTest "bloo"
1022 let firstDoc = BulkIndex testIndex
1023 testMapping (DocId "2") (toJSON firstTest)
1024 let secondDoc = BulkCreate testIndex
1025 testMapping (DocId "3") (toJSON secondTest)
1026 let stream = V.fromList [firstDoc, secondDoc]
1027 _ <- bulk stream
1028 _ <- refreshIndex testIndex
1029 fDoc <- getDocument testIndex testMapping (DocId "2")
1030 sDoc <- getDocument testIndex testMapping (DocId "3")
1031 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
1032 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
1033 liftIO $ do
1034 fmap getSource maybeFirst `shouldBe` Right (Just firstTest)
1035 fmap getSource maybeSecond `shouldBe` Right (Just secondTest)
1038 describe "query API" $ do
1039 it "returns document for term query and identity filter" $ withTestEnv $ do
1040 _ <- insertData
1041 let query = TermQuery (Term "user" "bitemyapp") Nothing
1042 let filter = IdentityFilter <&&> IdentityFilter
1043 let search = mkSearch (Just query) (Just filter)
1044 myTweet <- searchTweet search
1045 liftIO $
1046 myTweet `shouldBe` Right exampleTweet
1048 it "handles constant score queries" $ withTestEnv $ do
1049 _ <- insertData
1050 let query = TermsQuery "user" ("bitemyapp" :| [])
1051 let cfQuery = ConstantScoreQuery query (Boost 1.0)
1052 let filter = IdentityFilter
1053 let search = mkSearch (Just cfQuery) (Just filter)
1054 myTweet <- searchTweet search
1055 liftIO $
1056 myTweet `shouldBe` Right exampleTweet
1057 it "handles constant score filters" $ withTestEnv $ do
1058 _ <- insertData
1059 let query = TermsQuery "user" ("bitemyapp" :| [])
1060 let cfFilter = ConstantScoreFilter IdentityFilter (Boost 1.0)
1061 let boolQuery = mkBoolQuery [query, cfFilter] [] []
1062 let search = mkSearch (Just (QueryBoolQuery boolQuery)) Nothing
1063 myTweet <- searchTweet search
1064 liftIO $
1065 myTweet `shouldBe` Right exampleTweet
1068 it "returns document for terms query and identity filter" $ withTestEnv $ do
1069 _ <- insertData
1070 let query = TermsQuery "user" ("bitemyapp" :| [])
1071 let filter = IdentityFilter <&&> IdentityFilter
1072 let search = mkSearch (Just query) (Just filter)
1073 myTweet <- searchTweet search
1074 liftIO $
1075 myTweet `shouldBe` Right exampleTweet
1077 it "returns document for match query" $ withTestEnv $ do
1078 _ <- insertData
1079 let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1080 let search = mkSearch (Just query) Nothing
1081 myTweet <- searchTweet search
1082 liftIO $
1083 myTweet `shouldBe` Right exampleTweet
1085 it "returns document for multi-match query" $ withTestEnv $ do
1086 _ <- insertData
1087 let flds = [FieldName "user", FieldName "message"]
1088 let query = QueryMultiMatchQuery $ mkMultiMatchQuery flds (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 bool query" $ withTestEnv $ do
1095 _ <- insertData
1096 let innerQuery = QueryMatchQuery $
1097 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1098 let query = QueryBoolQuery $
1099 mkBoolQuery [innerQuery] [] []
1100 let search = mkSearch (Just query) Nothing
1101 myTweet <- searchTweet search
1102 liftIO $
1103 myTweet `shouldBe` Right exampleTweet
1105 it "returns document for boosting query" $ withTestEnv $ do
1106 _ <- insertData
1107 let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1108 let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
1109 let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
1110 let search = mkSearch (Just query) Nothing
1111 myTweet <- searchTweet search
1112 liftIO $
1113 myTweet `shouldBe` Right exampleTweet
1115 it "returns document for common terms query" $ withTestEnv $ do
1116 _ <- insertData
1117 let query = QueryCommonTermsQuery $
1118 CommonTermsQuery (FieldName "user")
1119 (QueryString "bitemyapp")
1120 (CutoffFrequency 0.0001)
1121 Or Or Nothing Nothing Nothing Nothing
1122 let search = mkSearch (Just query) Nothing
1123 myTweet <- searchTweet search
1124 liftIO $
1125 myTweet `shouldBe` Right exampleTweet
1128 describe "sorting" $ do
1129 it "returns documents in the right order" $ withTestEnv $ do
1130 _ <- insertData
1131 _ <- insertOther
1132 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
1133 let search = Search Nothing
1134 (Just IdentityFilter) (Just [sortSpec]) Nothing Nothing
1135 False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
1136 result <- searchTweets search
1137 let myTweet = grabFirst result
1138 liftIO $
1139 myTweet `shouldBe` Right otherTweet
1142 describe "filtering API" $ do
1143 it "returns document for composed boolmatch and identity" $ withTestEnv $ do
1144 _ <- insertData
1145 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
1146 <&&> IdentityFilter
1147 let search = mkSearch Nothing (Just queryFilter)
1148 myTweet <- searchTweet search
1149 liftIO $
1150 myTweet `shouldBe` Right exampleTweet
1152 it "returns document for term filter" $ withTestEnv $ do
1153 _ <- insertData
1154 let termFilter = TermFilter (Term "user" "bitemyapp") False
1155 let search = mkSearch Nothing (Just termFilter)
1156 myTweet <- searchTweet search
1157 liftIO $
1158 myTweet `shouldBe` Right exampleTweet
1160 it "returns document for existential filter" $ withTestEnv $ do
1161 _ <- insertData
1162 let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
1163 myTweet <- searchTweet search
1164 liftIO $
1165 myTweet `shouldBe` Right exampleTweet
1167 it "returns document for geo boundingbox filter" $ withTestEnv $ do
1168 _ <- insertData
1169 let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
1170 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
1171 let geoFilter = GeoBoundingBoxFilter bbConstraint
1172 let search = mkSearch Nothing (Just geoFilter)
1173 myTweet <- searchTweet search
1174 liftIO $
1175 myTweet `shouldBe` Right exampleTweet
1177 it "doesn't return document for nonsensical boundingbox filter" $ withTestEnv $ do
1178 _ <- insertData
1179 let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
1180 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
1181 let geoFilter = GeoBoundingBoxFilter bbConstraint
1182 let search = mkSearch Nothing (Just geoFilter)
1183 searchExpectNoResults search
1185 it "returns document for geo distance filter" $ withTestEnv $ do
1186 _ <- insertData
1187 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1188 let distance = Distance 10.0 Miles
1189 let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
1190 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
1191 let search = mkSearch Nothing (Just geoFilter)
1192 myTweet <- searchTweet search
1193 liftIO $
1194 myTweet `shouldBe` Right exampleTweet
1196 it "returns document for geo distance range filter" $ withTestEnv $ do
1197 _ <- insertData
1198 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1199 let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
1200 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
1201 let search = mkSearch Nothing (Just geoFilter)
1202 myTweet <- searchTweet search
1203 liftIO $
1204 myTweet `shouldBe` Right exampleTweet
1206 it "doesn't return document for wild geo distance range filter" $ withTestEnv $ do
1207 _ <- insertData
1208 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1209 let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
1210 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
1211 let search = mkSearch Nothing (Just geoFilter)
1212 searchExpectNoResults search
1214 it "returns document for geo polygon filter" $ withTestEnv $ do
1215 _ <- insertData
1216 let points = [LatLon 40.0 (-70.00),
1217 LatLon 40.0 (-72.00),
1218 LatLon 41.0 (-70.00),
1219 LatLon 41.0 (-72.00)]
1220 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
1221 let search = mkSearch Nothing (Just geoFilter)
1222 myTweet <- searchTweet search
1223 liftIO $
1224 myTweet `shouldBe` Right exampleTweet
1226 it "doesn't return document for bad geo polygon filter" $ withTestEnv $ do
1227 _ <- insertData
1228 let points = [LatLon 40.0 (-70.00),
1229 LatLon 40.0 (-71.00),
1230 LatLon 41.0 (-70.00),
1231 LatLon 41.0 (-71.00)]
1232 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
1233 let search = mkSearch Nothing (Just geoFilter)
1234 searchExpectNoResults search
1236 it "returns document for ids filter" $ withTestEnv $ do
1237 _ <- insertData
1238 let filter = IdsFilter (MappingName "tweet") [DocId "1"]
1239 let search = mkSearch Nothing (Just filter)
1240 myTweet <- searchTweet search
1241 liftIO $
1242 myTweet `shouldBe` Right exampleTweet
1244 it "returns document for Double range filter" $ withTestEnv $ do
1245 _ <- insertData
1246 let filter = RangeFilter (FieldName "age")
1247 (RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))
1248 RangeExecutionIndex False
1249 let search = mkSearch Nothing (Just filter)
1250 myTweet <- searchTweet search
1251 liftIO $
1252 myTweet `shouldBe` Right exampleTweet
1254 it "returns document for UTCTime date filter" $ withTestEnv $ do
1255 _ <- insertData
1256 let filter = RangeFilter (FieldName "postDate")
1257 (RangeDateGtLt
1258 (GreaterThanD (UTCTime
1259 (ModifiedJulianDay 54000)
1260 (secondsToDiffTime 0)))
1261 (LessThanD (UTCTime
1262 (ModifiedJulianDay 55000)
1263 (secondsToDiffTime 11))))
1264 RangeExecutionIndex False
1265 let search = mkSearch Nothing (Just filter)
1266 myTweet <- searchTweet search
1267 liftIO $
1268 myTweet `shouldBe` Right exampleTweet
1270 it "returns document for regexp filter" $ withTestEnv $ do
1271 _ <- insertData
1272 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
1273 AllRegexpFlags (CacheName "test") False (CacheKey "key")
1274 let search = mkSearch Nothing (Just filter)
1275 myTweet <- searchTweet search
1276 liftIO $
1277 myTweet `shouldBe` Right exampleTweet
1279 it "doesn't return document for non-matching regexp filter" $ withTestEnv $ do
1280 _ <- insertData
1281 let filter = RegexpFilter (FieldName "user")
1282 (Regexp "boy") AllRegexpFlags
1283 (CacheName "test") False (CacheKey "key")
1284 let search = mkSearch Nothing (Just filter)
1285 searchExpectNoResults search
1287 it "returns document for query filter, uncached" $ withTestEnv $ do
1288 _ <- insertData
1289 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) True
1290 search = mkSearch Nothing (Just filter)
1291 myTweet <- searchTweet search
1292 liftIO $ myTweet `shouldBe` Right exampleTweet
1294 it "returns document for query filter, cached" $ withTestEnv $ do
1295 _ <- insertData
1296 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) False
1297 search = mkSearch Nothing (Just filter)
1298 myTweet <- searchTweet search
1299 liftIO $ myTweet `shouldBe` Right exampleTweet
1301 describe "Aggregation API" $ do
1302 it "returns term aggregation results" $ withTestEnv $ do
1303 _ <- insertData
1304 let terms = TermsAgg $ mkTermsAggregation "user"
1305 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1306 searchExpectAggs search
1307 searchValidBucketAgg search "users" toTerms
1309 it "return sub-aggregation results" $ withTestEnv $ do
1310 _ <- insertData
1311 let subaggs = mkAggregations "age_agg" . TermsAgg $ mkTermsAggregation "age"
1312 agg = TermsAgg $ (mkTermsAggregation "user") { termAggs = Just subaggs}
1313 search = mkAggregateSearch Nothing $ mkAggregations "users" agg
1314 reply <- searchByIndex testIndex search
1315 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
1316 usersAggResults = result >>= aggregations >>= toTerms "users"
1317 subAggResults = usersAggResults >>= (listToMaybe . buckets) >>= termsAggs >>= toTerms "age_agg"
1318 subAddResultsExists = isJust subAggResults
1319 liftIO $ (subAddResultsExists) `shouldBe` True
1321 it "returns cardinality aggregation results" $ withTestEnv $ do
1322 _ <- insertData
1323 let cardinality = CardinalityAgg $ mkCardinalityAggregation $ FieldName "user"
1324 let search = mkAggregateSearch Nothing $ mkAggregations "users" cardinality
1325 let search' = search { Database.V1.Bloodhound.from = From 0, size = Size 0 }
1326 searchExpectAggs search'
1327 let docCountPair k n = (k, object ["value" .= Number n])
1328 res <- searchTweets search'
1329 liftIO $
1330 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "users" 1]))
1332 it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
1333 _ <- insertData
1334 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
1335 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1336 searchExpectAggs search
1337 searchValidBucketAgg search "users" toTerms
1339 -- One of these fails with 1.7.3
1340 it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
1341 _ <- insertData
1342 searchTermsAggHint [Map, Ordinals]
1344 it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do
1345 _ <- insertData
1346 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
1348 it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
1349 _ <- insertData
1350 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
1351 -- One of the above.
1353 it "can execute value_count aggregations" $ withTestEnv $ do
1354 _ <- insertData
1355 _ <- insertOther
1356 let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>
1357 mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))
1358 let search = mkAggregateSearch Nothing ags
1359 let docCountPair k n = (k, object ["value" .= Number n])
1360 res <- searchTweets search
1361 liftIO $
1362 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2
1363 , docCountPair "bogus_count" 0
1364 ]))
1366 it "can execute filter aggregations" $ withTestEnv $ do
1367 _ <- insertData
1368 _ <- insertOther
1369 let ags = mkAggregations "bitemyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "bitemyapp") defaultCache) Nothing)) <>
1370 mkAggregations "notmyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "notmyapp") defaultCache) Nothing))
1371 let search = mkAggregateSearch Nothing ags
1372 let docCountPair k n = (k, object ["doc_count" .= Number n])
1373 res <- searchTweets search
1374 liftIO $
1375 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "bitemyapps" 1
1376 , docCountPair "notmyapps" 1
1377 ]))
1378 it "can execute date_range aggregations" $ withTestEnv $ do
1379 let now = fromGregorian 2015 3 14
1380 let ltAMonthAgo = UTCTime (fromGregorian 2015 3 1) 0
1381 let ltAWeekAgo = UTCTime (fromGregorian 2015 3 10) 0
1382 let oldDoc = exampleTweet { postDate = ltAMonthAgo }
1383 let newDoc = exampleTweet { postDate = ltAWeekAgo }
1384 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings oldDoc (DocId "1")
1385 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings newDoc (DocId "2")
1386 _ <- refreshIndex testIndex
1387 let thisMonth = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMMonth])
1388 let thisWeek = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMWeek])
1389 let agg = DateRangeAggregation (FieldName "postDate") Nothing (thisMonth :| [thisWeek])
1390 let ags = mkAggregations "date_ranges" (DateRangeAgg agg)
1391 let search = mkAggregateSearch Nothing ags
1392 res <- searchTweets search
1393 liftIO $ hitsTotal . searchHits <$> res `shouldBe` Right 2
1394 let bucks = do magrs <- fmapL show (aggregations <$> res)
1395 agrs <- note "no aggregations returned" magrs
1396 rawBucks <- note "no date_ranges aggregation" $ M.lookup "date_ranges" agrs
1397 parseEither parseJSON rawBucks
1398 let fromMonthT = UTCTime (fromGregorian 2015 2 14) 0
1399 let fromWeekT = UTCTime (fromGregorian 2015 3 7) 0
1400 liftIO $ buckets <$> bucks `shouldBe` Right [ DateRangeResult "2015-02-14T00:00:00.000Z-*"
1401 (Just fromMonthT)
1402 (Just "2015-02-14T00:00:00.000Z")
1403 Nothing
1404 Nothing
1406 Nothing
1407 , DateRangeResult "2015-03-07T00:00:00.000Z-*"
1408 (Just fromWeekT)
1409 (Just "2015-03-07T00:00:00.000Z")
1410 Nothing
1411 Nothing
1413 Nothing
1416 it "returns date histogram aggregation results" $ withTestEnv $ do
1417 _ <- insertData
1418 let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
1419 let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
1420 searchExpectAggs search
1421 searchValidBucketAgg search "byDate" toDateHistogram
1423 it "returns date histogram using fractional date" $ withTestEnv $ do
1424 _ <- insertData
1425 let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]
1426 let fractionals = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]
1427 let intervals = periods ++ fractionals
1428 let histogram = mkDateHistogram (FieldName "postDate")
1429 let search interval = mkAggregateSearch Nothing $ mkAggregations "byDate" $ DateHistogramAgg (histogram interval)
1430 let expect interval = searchExpectAggs (search interval)
1431 let valid interval = searchValidBucketAgg (search interval) "byDate" toDateHistogram
1432 forM_ intervals expect
1433 forM_ intervals valid
1435 it "can execute missing aggregations" $ withTestEnv $ do
1436 _ <- insertData
1437 _ <- insertExtra
1438 let ags = mkAggregations "missing_agg" (MissingAgg (MissingAggregation "extra"))
1439 let search = mkAggregateSearch Nothing ags
1440 let docCountPair k n = (k, object ["doc_count" .= Number n])
1441 res <- searchTweets search
1442 liftIO $
1443 fmap aggregations res `shouldBe` Right (Just (M.fromList [docCountPair "missing_agg" 1]))
1445 describe "Highlights API" $ do
1447 it "returns highlight from query when there should be one" $ withTestEnv $ do
1448 _ <- insertData
1449 _ <- insertOther
1450 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1451 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
1453 let search = mkHighlightSearch (Just query) testHighlight
1454 myHighlight <- searchTweetHighlight search
1455 liftIO $
1456 myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
1458 it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
1459 _ <- insertData
1460 _ <- insertOther
1461 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1462 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "user") Nothing]
1464 let search = mkHighlightSearch (Just query) testHighlight
1465 myHighlight <- searchTweetHighlight search
1466 liftIO $
1467 myHighlight `shouldBe` Right Nothing
1469 describe "Source filtering" $ do
1471 it "doesn't include source when sources are disabled" $ withTestEnv $ do
1472 searchExpectSource
1473 NoSource
1474 (Left (EsError 500 "Source was missing"))
1476 it "includes a source" $ withTestEnv $ do
1477 searchExpectSource
1478 (SourcePatterns (PopPattern (Pattern "message")))
1479 (Right (Object (HM.fromList [("message", String "Use haskell!")])))
1481 it "includes sources" $ withTestEnv $ do
1482 searchExpectSource
1483 (SourcePatterns (PopPatterns [Pattern "user", Pattern "message"]))
1484 (Right (Object (HM.fromList [("user",String "bitemyapp"),("message", String "Use haskell!")])))
1486 it "includes source patterns" $ withTestEnv $ do
1487 searchExpectSource
1488 (SourcePatterns (PopPattern (Pattern "*ge")))
1489 (Right (Object (HM.fromList [("age", Number 10000),("message", String "Use haskell!")])))
1491 it "excludes source patterns" $ withTestEnv $ do
1492 searchExpectSource
1493 (SourceIncludeExclude (Include [])
1494 (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate", Pattern "extra"]))
1495 (Right (Object (HM.fromList [("user",String "bitemyapp")])))
1497 describe "ToJSON RegexpFlags" $ do
1498 it "generates the correct JSON for AllRegexpFlags" $
1499 toJSON AllRegexpFlags `shouldBe` String "ALL"
1501 it "generates the correct JSON for NoRegexpFlags" $
1502 toJSON NoRegexpFlags `shouldBe` String "NONE"
1504 it "generates the correct JSON for SomeRegexpFlags" $
1505 let flags = AnyString :| [ Automaton
1506 , Complement
1507 , Empty
1508 , Intersection
1509 , Interval ]
1510 in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
1512 prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
1513 let String str = toJSON flags
1514 flagStrs = T.splitOn "|" str
1515 in noDuplicates flagStrs
1517 describe "omitNulls" $ do
1518 it "checks that omitNulls drops list elements when it should" $
1519 let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))
1520 , "test2" .= (toJSON ("some value" :: Text))]
1521 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1523 it "checks that omitNulls doesn't drop list elements when it shouldn't" $
1524 let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))
1525 , "test2" .= (toJSON ("some value" :: Text))]
1526 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))
1527 , ("test2", String "some value")])
1528 it "checks that omitNulls drops non list elements when it should" $
1529 let dropped = omitNulls $ [ "test1" .= (toJSON Null)
1530 , "test2" .= (toJSON ("some value" :: Text))]
1531 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1532 it "checks that omitNulls doesn't drop non list elements when it shouldn't" $
1533 let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
1534 , "test2" .= (toJSON ("some value" :: Text))]
1535 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
1536 , ("test2", String "some value")])
1537 describe "Monoid (SearchHits a)" $ do
1538 prop "abides the monoid laws" $ eq $
1539 prop_Monoid (T :: T (SearchHits ()))
1541 describe "mkDocVersion" $ do
1542 prop "can never construct an out of range docVersion" $ \i ->
1543 let res = mkDocVersion i
1544 in case res of
1545 Nothing -> property True
1546 Just dv -> (dv >= minBound) .&&.
1547 (dv <= maxBound) .&&.
1548 docVersionNumber dv === i
1550 describe "FsSnapshotRepo" $ do
1551 prop "SnapshotRepo laws" $ \fsr ->
1552 fromGSnapshotRepo (toGSnapshotRepo fsr) === Right (fsr :: FsSnapshotRepo)
1554 describe "snapshot repos" $ do
1555 it "always parses all snapshot repos API" $ when' canSnapshot $ withTestEnv $ do
1556 res <- getSnapshotRepos AllSnapshotRepos
1557 liftIO $ case res of
1558 Left e -> expectationFailure ("Expected a right but got Left " <> show e)
1559 Right _ -> return ()
1561 it "finds an existing list of repos" $ when' canSnapshot $ withTestEnv $ do
1562 let r1n = SnapshotRepoName "bloodhound-repo1"
1563 let r2n = SnapshotRepoName "bloodhound-repo2"
1564 withSnapshotRepo r1n $ \r1 ->
1565 withSnapshotRepo r2n $ \r2 -> do
1566 repos <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| [ExactRepo r2n]))
1567 liftIO $ case repos of
1568 Right xs -> do
1569 let srt = L.sortBy (comparing gSnapshotRepoName)
1570 srt xs `shouldBe` srt [r1, r2]
1571 Left e -> expectationFailure (show e)
1573 it "creates and updates with updateSnapshotRepo" $ when' canSnapshot $ withTestEnv $ do
1574 let r1n = SnapshotRepoName "bloodhound-repo1"
1575 withSnapshotRepo r1n $ \r1 -> do
1576 let Just (String dir) = HM.lookup "location" (gSnapshotRepoSettingsObject (gSnapshotRepoSettings r1))
1577 let noCompression = FsSnapshotRepo r1n (T.unpack dir) False Nothing Nothing Nothing
1578 resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings noCompression
1579 liftIO (validateStatus resp 200)
1580 Right [roundtrippedNoCompression] <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| []))
1581 liftIO (roundtrippedNoCompression `shouldBe` toGSnapshotRepo noCompression)
1583 -- verify came around in 1.4 it seems
1584 it "can verify existing repos" $ when' canSnapshot $ when' (atleast es14) $ withTestEnv $ do
1585 let r1n = SnapshotRepoName "bloodhound-repo1"
1586 withSnapshotRepo r1n $ \_ -> do
1587 res <- verifySnapshotRepo r1n
1588 liftIO $ case res of
1589 Right (SnapshotVerification vs)
1590 | null vs -> expectationFailure "Expected nonempty set of verifying nodes"
1591 | otherwise -> return ()
1592 Left e -> expectationFailure (show e)
1594 describe "snapshots" $ do
1595 it "always parses all snapshots API" $ when' canSnapshot $ withTestEnv $ do
1596 let r1n = SnapshotRepoName "bloodhound-repo1"
1597 withSnapshotRepo r1n $ \_ -> do
1598 res <- getSnapshots r1n AllSnapshots
1599 liftIO $ case res of
1600 Left e -> expectationFailure ("Expected a right but got Left " <> show e)
1601 Right _ -> return ()
1603 it "can parse a snapshot that it created" $ when' canSnapshot $ withTestEnv $ do
1604 let r1n = SnapshotRepoName "bloodhound-repo1"
1605 withSnapshotRepo r1n $ \_ -> do
1606 let s1n = SnapshotName "example-snapshot"
1607 withSnapshot r1n s1n $ do
1608 res <- getSnapshots r1n (SnapshotList (ExactSnap s1n :| []))
1609 liftIO $ case res of
1610 Right [snap]
1611 | snapInfoState snap == SnapshotSuccess &&
1612 snapInfoName snap == s1n -> return ()
1613 | otherwise -> expectationFailure (show snap)
1614 Right [] -> expectationFailure "There were no snapshots"
1615 Right snaps -> expectationFailure ("Expected 1 snapshot but got" <> show (length snaps))
1616 Left e -> expectationFailure (show e)
1618 describe "snapshot restore" $ do
1619 it "can restore a snapshot that we create" $ when' canSnapshot $ withTestEnv $ do
1620 let r1n = SnapshotRepoName "bloodhound-repo1"
1621 withSnapshotRepo r1n $ \_ -> do
1622 let s1n = SnapshotName "example-snapshot"
1623 withSnapshot r1n s1n $ do
1624 let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True }
1625 -- have to close an index to restore it
1626 resp1 <- closeIndex testIndex
1627 liftIO (validateStatus resp1 200)
1628 resp2 <- restoreSnapshot r1n s1n settings
1629 liftIO (validateStatus resp2 200)
1631 it "can restore and rename" $ when' canSnapshot $ withTestEnv $ do
1632 let r1n = SnapshotRepoName "bloodhound-repo1"
1633 withSnapshotRepo r1n $ \_ -> do
1634 let s1n = SnapshotName "example-snapshot"
1635 withSnapshot r1n s1n $ do
1636 let pat = RestoreRenamePattern "bloodhound-tests-twitter-(\\d+)"
1637 let replace = RRTLit "restored-" :| [RRSubWholeMatch]
1638 let expectedIndex = IndexName "restored-bloodhound-tests-twitter-1"
1639 oldEnoughForOverrides <- liftIO (atleast es15)
1640 let overrides = RestoreIndexSettings { restoreOverrideReplicas = Just (ReplicaCount 0) }
1641 let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True
1642 , snapRestoreRenamePattern = Just pat
1643 , snapRestoreRenameReplacement = Just replace
1644 , snapRestoreIndexSettingsOverrides = if oldEnoughForOverrides
1645 then Just overrides
1646 else Nothing
1648 -- have to close an index to restore it
1649 let go = do
1650 resp <- restoreSnapshot r1n s1n settings
1651 liftIO (validateStatus resp 200)
1652 exists <- indexExists expectedIndex
1653 liftIO (exists `shouldBe` True)
1654 go `finally` deleteIndex expectedIndex
1656 describe "getNodesInfo" $ do
1657 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
1658 res <- getNodesInfo LocalNode
1659 liftIO $ case res of
1660 -- This is really just a smoke test for response
1661 -- parsing. Node info is so variable, there's not much I can
1662 -- assert here.
1663 Right NodesInfo {..} -> length nodesInfo `shouldBe` 1
1664 Left e -> expectationFailure ("Expected NodesInfo but got " <> show e)
1666 describe "getNodesStats" $ do
1667 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
1668 res <- getNodesStats LocalNode
1669 liftIO $ case res of
1670 -- This is really just a smoke test for response
1671 -- parsing. Node stats is so variable, there's not much I can
1672 -- assert here.
1673 Right NodesStats {..} -> length nodesStats `shouldBe` 1
1674 Left e -> expectationFailure ("Expected NodesStats but got " <> show e)
1676 describe "Enum DocVersion" $ do
1677 it "follows the laws of Enum, Bounded" $ do
1678 evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall
1679 evaluate (pred minBound :: DocVersion) `shouldThrow` anyErrorCall
1680 evaluate (toEnum 0 :: DocVersion) `shouldThrow` anyErrorCall
1681 evaluate (toEnum 9200000000000000001 :: DocVersion) `shouldThrow` anyErrorCall
1682 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1683 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1684 enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]
1686 describe "scan&scroll API" $ do
1687 it "returns documents using the scan&scroll API" $ withTestEnv $ do
1688 _ <- insertData
1689 _ <- insertOther
1690 let search = (mkSearch (Just $ MatchAllQuery Nothing) Nothing) { size = (Size 1) }
1691 regular_search <- searchTweet search
1692 scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet]
1693 let scan_search = map hitSource scan_search'
1694 liftIO $
1695 regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored
1696 liftIO $
1697 scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]
1699 describe "index aliases" $ do
1700 it "handles the simple case of aliasing an existing index" $ do
1701 let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1702 let create = IndexAliasCreate Nothing Nothing
1703 let action = AddAlias alias create
1705 withTestEnv $ do
1706 resetIndex
1707 resp <- updateIndexAliases (action :| [])
1708 liftIO $ validateStatus resp 200
1709 let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1710 (do aliases <- withTestEnv getIndexAliases
1711 let expected = IndexAliasSummary alias create
1712 case aliases of
1713 Right (IndexAliasesSummary summs) ->
1714 L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1715 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1717 it "handles an alias with routing and a filter" $ do
1718 let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1719 let sar = SearchAliasRouting (RoutingValue "search val" :| [])
1720 let iar = IndexAliasRouting (RoutingValue "index val")
1721 let routing = GranularAliasRouting (Just sar) (Just iar)
1722 let filter = LimitFilter 42
1723 let create = IndexAliasCreate (Just routing) (Just filter)
1724 let action = AddAlias alias create
1726 withTestEnv $ do
1727 resetIndex
1728 resp <- updateIndexAliases (action :| [])
1729 liftIO $ validateStatus resp 200
1730 let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1731 (do aliases <- withTestEnv getIndexAliases
1732 let expected = IndexAliasSummary alias create
1733 case aliases of
1734 Right (IndexAliasesSummary summs) ->
1735 L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1736 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1738 describe "Index Listing" $ do
1739 it "returns a list of index names" $ withTestEnv $ do
1740 _ <- createExampleIndex
1741 ixns <- listIndices
1742 liftIO (ixns `shouldContain` [testIndex])
1744 describe "Index Settings" $ do
1745 it "persists settings" $ withTestEnv $ do
1746 _ <- deleteExampleIndex
1747 _ <- createExampleIndex
1748 let updates = BlocksWrite False :| []
1749 updateResp <- updateIndexSettings updates testIndex
1750 liftIO $ validateStatus updateResp 200
1751 getResp <- getIndexSettings testIndex
1752 liftIO $
1753 getResp `shouldBe` Right (IndexSettingsSummary
1754 testIndex
1755 (IndexSettings (ShardCount 1) (ReplicaCount 0))
1756 (NE.toList updates))
1758 describe "Index Optimization" $ do
1759 it "returns a successful response upon completion" $ withTestEnv $ do
1760 _ <- createExampleIndex
1761 resp <- optimizeIndex (IndexList (testIndex :| [])) defaultIndexOptimizationSettings
1762 liftIO $ validateStatus resp 200
1764 describe "JSON instances" $ do
1765 propJSON (Proxy :: Proxy Version)
1766 propJSON (Proxy :: Proxy IndexName)
1767 propJSON (Proxy :: Proxy MappingName)
1768 propJSON (Proxy :: Proxy DocId)
1769 propJSON (Proxy :: Proxy IndexAliasRouting)
1770 propJSON (Proxy :: Proxy RoutingValue)
1771 propJSON (Proxy :: Proxy ShardCount)
1772 propJSON (Proxy :: Proxy ReplicaCount)
1773 propJSON (Proxy :: Proxy TemplateName)
1774 propJSON (Proxy :: Proxy TemplatePattern)
1775 propJSON (Proxy :: Proxy QueryString)
1776 propJSON (Proxy :: Proxy FieldName)
1777 propJSON (Proxy :: Proxy CacheName)
1778 propJSON (Proxy :: Proxy CacheKey)
1779 propJSON (Proxy :: Proxy Existence)
1780 propJSON (Proxy :: Proxy CutoffFrequency)
1781 propJSON (Proxy :: Proxy Analyzer)
1782 propJSON (Proxy :: Proxy MaxExpansions)
1783 propJSON (Proxy :: Proxy Lenient)
1784 propJSON (Proxy :: Proxy Tiebreaker)
1785 propJSON (Proxy :: Proxy Boost)
1786 propJSON (Proxy :: Proxy BoostTerms)
1787 propJSON (Proxy :: Proxy MinimumMatch)
1788 propJSON (Proxy :: Proxy DisableCoord)
1789 propJSON (Proxy :: Proxy IgnoreTermFrequency)
1790 propJSON (Proxy :: Proxy MinimumTermFrequency)
1791 propJSON (Proxy :: Proxy MaxQueryTerms)
1792 propJSON (Proxy :: Proxy Fuzziness)
1793 propJSON (Proxy :: Proxy PrefixLength)
1794 propJSON (Proxy :: Proxy TypeName)
1795 propJSON (Proxy :: Proxy PercentMatch)
1796 propJSON (Proxy :: Proxy StopWord)
1797 propJSON (Proxy :: Proxy QueryPath)
1798 propJSON (Proxy :: Proxy AllowLeadingWildcard)
1799 propJSON (Proxy :: Proxy LowercaseExpanded)
1800 propJSON (Proxy :: Proxy EnablePositionIncrements)
1801 propJSON (Proxy :: Proxy AnalyzeWildcard)
1802 propJSON (Proxy :: Proxy GeneratePhraseQueries)
1803 propJSON (Proxy :: Proxy Locale)
1804 propJSON (Proxy :: Proxy MaxWordLength)
1805 propJSON (Proxy :: Proxy MinWordLength)
1806 propJSON (Proxy :: Proxy PhraseSlop)
1807 propJSON (Proxy :: Proxy MinDocFrequency)
1808 propJSON (Proxy :: Proxy MaxDocFrequency)
1809 propJSON (Proxy :: Proxy Filter)
1810 propJSON (Proxy :: Proxy Query)
1811 propJSON (Proxy :: Proxy SimpleQueryStringQuery)
1812 propJSON (Proxy :: Proxy FieldOrFields)
1813 propJSON (Proxy :: Proxy SimpleQueryFlag)
1814 propJSON (Proxy :: Proxy RegexpQuery)
1815 propJSON (Proxy :: Proxy QueryStringQuery)
1816 propJSON (Proxy :: Proxy RangeQuery)
1817 propJSON (Proxy :: Proxy PrefixQuery)
1818 propJSON (Proxy :: Proxy NestedQuery)
1819 propJSON (Proxy :: Proxy MoreLikeThisFieldQuery)
1820 propJSON (Proxy :: Proxy MoreLikeThisQuery)
1821 propJSON (Proxy :: Proxy IndicesQuery)
1822 propJSON (Proxy :: Proxy HasParentQuery)
1823 propJSON (Proxy :: Proxy HasChildQuery)
1824 propJSON (Proxy :: Proxy FuzzyQuery)
1825 propJSON (Proxy :: Proxy FuzzyLikeFieldQuery)
1826 propJSON (Proxy :: Proxy FuzzyLikeThisQuery)
1827 propJSON (Proxy :: Proxy FilteredQuery)
1828 propJSON (Proxy :: Proxy DisMaxQuery)
1829 propJSON (Proxy :: Proxy CommonTermsQuery)
1830 propJSON (Proxy :: Proxy CommonMinimumMatch)
1831 propJSON (Proxy :: Proxy BoostingQuery)
1832 propJSON (Proxy :: Proxy BoolQuery)
1833 propJSON (Proxy :: Proxy MatchQuery)
1834 propJSON (Proxy :: Proxy MultiMatchQueryType)
1835 propJSON (Proxy :: Proxy BooleanOperator)
1836 propJSON (Proxy :: Proxy ZeroTermsQuery)
1837 propJSON (Proxy :: Proxy MatchQueryType)
1838 propJSON (Proxy :: Proxy AliasRouting)
1839 propJSON (Proxy :: Proxy IndexAliasCreate)
1840 propJSON (Proxy :: Proxy SearchAliasRouting)
1841 propJSON (Proxy :: Proxy ScoreType)
1842 propJSON (Proxy :: Proxy Distance)
1843 propJSON (Proxy :: Proxy DistanceUnit)
1844 propJSON (Proxy :: Proxy DistanceType)
1845 propJSON (Proxy :: Proxy OptimizeBbox)
1846 propJSON (Proxy :: Proxy GeoBoundingBoxConstraint)
1847 propJSON (Proxy :: Proxy GeoFilterType)
1848 propJSON (Proxy :: Proxy GeoBoundingBox)
1849 propJSON (Proxy :: Proxy LatLon)
1850 propJSON (Proxy :: Proxy RangeExecution)
1851 prop "RegexpFlags FromJSON/ToJSON roundtrips, removing dups " $ \rfs ->
1852 let expected = case rfs of
1853 SomeRegexpFlags fs -> SomeRegexpFlags (NE.fromList (nub (NE.toList fs)))
1854 x -> x
1855 in parseEither parseJSON (toJSON rfs) === Right expected
1856 propJSON (Proxy :: Proxy BoolMatch)
1857 propJSON (Proxy :: Proxy Term)
1858 propJSON (Proxy :: Proxy MultiMatchQuery)
1859 propJSON (Proxy :: Proxy IndexSettings)
1860 propJSON (Proxy :: Proxy UpdatableIndexSetting')
1861 propJSON (Proxy :: Proxy ReplicaBounds)
1862 propJSON (Proxy :: Proxy Bytes)
1863 propJSON (Proxy :: Proxy AllocationPolicy)
1864 propJSON (Proxy :: Proxy InitialShardCount)
1865 propJSON (Proxy :: Proxy FSType)
1866 propJSON (Proxy :: Proxy CompoundFormat)
1868-- Temporary solution for lacking of generic derivation of Arbitrary
1869-- We use generics-sop, as it's much more concise than directly using GHC.Generics
1871-- This will be unneeded after https://github.com/nick8325/quickcheck/pull/112
1872-- is merged and released
1873sopArbitrary :: forall a. (Generic a, SOP.GTo a, SOP.All SOP.SListI (SOP.GCode a), SOP.All2 Arbitrary (SOP.GCode a)) => Gen a
1874sopArbitrary = fmap SOP.gto sopArbitrary'
1876sopArbitrary' :: forall xss. (SOP.All SOP.SListI xss, SOP.All2 Arbitrary xss) => Gen (SOP.SOP SOP.I xss)
1877sopArbitrary' = SOP.hsequence =<< elements (SOP.apInjs_POP $ SOP.hcpure p arbitrary)
1878 where
1879 p :: Proxy Arbitrary
1880 p = Proxy