git.iko.soy/typeable/bloodhound
on fc6fe99 help sign in
typeable/bloodhound/tests/V5/tests.hs
1689 lines 77 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.V5.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] []
106es50 :: Vers.Version
107es50 = Vers.Version [5, 0, 0] []
109getServerVersion :: IO (Maybe Vers.Version)
110getServerVersion = fmap extractVersion <$> withTestEnv getStatus
111 where
112 extractVersion = versionNumber . number . version
114-- | Get configured repo paths for snapshotting. Note that by default
115-- this is not enabled and if we are over es 1.5, we won't be able to
116-- test snapshotting. Note that this can and should be part of the
117-- client functionality in a much less ad-hoc incarnation.
118getRepoPaths :: IO [FilePath]
119getRepoPaths = withTestEnv $ do
120 bhe <- getBHEnv
121 let Server s = bhServer bhe
122 let tUrl = s <> "/" <> "_nodes"
123 initReq <- parseRequest (URI.escapeURIString URI.isAllowedInURI (T.unpack tUrl))
124 let req = setRequestIgnoreStatus $ initReq { method = NHTM.methodGet }
125 Right (Object o) <- parseEsResponse =<< liftIO (httpLbs req (bhManager bhe))
126 return $ fromMaybe mempty $ do
127 Object nodes <- HM.lookup "nodes" o
128 Object firstNode <- snd <$> headMay (HM.toList nodes)
129 Object settings <- HM.lookup "settings" firstNode
130 Object path <- HM.lookup "path" settings
131 Array repo <- HM.lookup "repo" path
132 return [ T.unpack t | String t <- V.toList repo]
134-- | 1.5 and earlier don't care about repo paths
135canSnapshot :: IO Bool
136canSnapshot = do
137 caresAboutRepos <- atleast es16
138 repoPaths <- getRepoPaths
139 return (not caresAboutRepos || not (null (repoPaths)))
141atleast :: Vers.Version -> IO Bool
142atleast v = getServerVersion >>= \x -> return $ x >= Just v
144atmost :: Vers.Version -> IO Bool
145atmost v = getServerVersion >>= \x -> return $ x <= Just v
147is :: Vers.Version -> IO Bool
148is v = getServerVersion >>= \x -> return $ x == Just v
150when' :: Monad m => m Bool -> m () -> m ()
151when' b f = b >>= \x -> when x f
153(==~) :: (ApproxEq a) => a -> a -> Property
154a ==~ b = counterexample (showApproxEq a ++ " !=~ " ++ showApproxEq b) (a =~ b)
156propJSON :: forall a. (Arbitrary a, ToJSON a, FromJSON a, Show a, ApproxEq a, Typeable a) => Proxy a -> Spec
157propJSON _ = prop testName $ \(a :: a) ->
158 let jsonStr = "via " <> BL8.unpack (encode a)
159 in counterexample jsonStr (parseEither parseJSON (toJSON a) ==~ Right a)
160 where testName = show ty <> " FromJSON/ToJSON roundtrips"
161 ty = typeOf (undefined :: a)
163data Location = Location { lat :: Double
164 , lon :: Double } deriving (Eq, Generic, Show)
166data Tweet = Tweet { user :: Text
167 , postDate :: UTCTime
168 , message :: Text
169 , age :: Int
170 , location :: Location
171 , extra :: Maybe Text }
172 deriving (Eq, Generic, Show)
174instance ToJSON Tweet where
175 toJSON = genericToJSON defaultOptions
176instance FromJSON Tweet where
177 parseJSON = genericParseJSON defaultOptions
178instance ToJSON Location where
179 toJSON = genericToJSON defaultOptions
180instance FromJSON Location where
181 parseJSON = genericParseJSON defaultOptions
183data ParentMapping = ParentMapping deriving (Eq, Show)
185instance ToJSON ParentMapping where
186 toJSON ParentMapping =
187 object ["properties" .=
188 object [ "user" .= object ["type" .= ("string" :: Text)
189 , "fielddata" .= True
190 ]
191 -- Serializing the date as a date is breaking other tests, mysteriously.
192 -- , "postDate" .= object [ "type" .= ("date" :: Text)
193 -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
194 , "message" .= object ["type" .= ("string" :: Text)]
195 , "age" .= object ["type" .= ("integer" :: Text)]
196 , "location" .= object ["type" .= ("geo_point" :: Text)]
197 , "extra" .= object ["type" .= ("keyword" :: Text)]
198 ]]
200data ChildMapping = ChildMapping deriving (Eq, Show)
202instance ToJSON ChildMapping where
203 toJSON ChildMapping =
204 object ["_parent" .= object ["type" .= ("parent" :: Text)]
205 , "properties" .=
206 object [ "user" .= object ["type" .= ("string" :: Text)
207 , "fielddata" .= True
208 ]
209 -- Serializing the date as a date is breaking other tests, mysteriously.
210 -- , "postDate" .= object [ "type" .= ("date" :: Text)
211 -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
212 , "message" .= object ["type" .= ("string" :: Text)]
213 , "age" .= object ["type" .= ("integer" :: Text)]
214 , "location" .= object ["type" .= ("geo_point" :: Text)]
215 , "extra" .= object ["type" .= ("keyword" :: Text)]
216 ]]
218data TweetMapping = TweetMapping deriving (Eq, Show)
220instance ToJSON TweetMapping where
221 toJSON TweetMapping =
222 object ["tweet" .=
223 object ["properties" .=
224 object [ "user" .= object [ "type" .= ("string" :: Text)
225 , "fielddata" .= True
226 ]
227 -- Serializing the date as a date is breaking other tests, mysteriously.
228 -- , "postDate" .= object [ "type" .= ("date" :: Text)
229 -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
230 , "message" .= object ["type" .= ("string" :: Text)]
231 , "age" .= object ["type" .= ("integer" :: Text)]
232 , "location" .= object ["type" .= ("geo_point" :: Text)]
233 , "extra" .= object ["type" .= ("keyword" :: Text)]
234 ]]]
236exampleTweet :: Tweet
237exampleTweet = Tweet { user = "bitemyapp"
238 , postDate = UTCTime
239 (ModifiedJulianDay 55000)
240 (secondsToDiffTime 10)
241 , message = "Use haskell!"
242 , age = 10000
243 , location = Location 40.12 (-71.34)
244 , extra = Nothing }
246tweetWithExtra :: Tweet
247tweetWithExtra = Tweet { user = "bitemyapp"
248 , postDate = UTCTime
249 (ModifiedJulianDay 55000)
250 (secondsToDiffTime 10)
251 , message = "Use haskell!"
252 , age = 10000
253 , location = Location 40.12 (-71.34)
254 , extra = Just "blah blah" }
256newAge :: Int
257newAge = 31337
259newUser :: Text
260newUser = "someotherapp"
262tweetPatch :: Value
263tweetPatch =
264 object [ "age" .= newAge
265 , "user" .= newUser
266 ]
268patchedTweet :: Tweet
269patchedTweet = exampleTweet{age = newAge, user = newUser}
271otherTweet :: Tweet
272otherTweet = Tweet { user = "notmyapp"
273 , postDate = UTCTime
274 (ModifiedJulianDay 55000)
275 (secondsToDiffTime 11)
276 , message = "Use haskell!"
277 , age = 1000
278 , location = Location 40.12 (-71.34)
279 , extra = Nothing }
281resetIndex :: BH IO ()
282resetIndex = do
283 _ <- deleteExampleIndex
284 _ <- createExampleIndex
285 _ <- putMapping testIndex testMapping TweetMapping
286 return ()
288insertData :: BH IO Reply
289insertData = do
290 resetIndex
291 insertData' defaultIndexDocumentSettings
293insertData' :: IndexDocumentSettings -> BH IO Reply
294insertData' ids = do
295 r <- indexDocument testIndex testMapping ids exampleTweet (DocId "1")
296 _ <- refreshIndex testIndex
297 return r
299updateData :: BH IO Reply
300updateData = do
301 r <- updateDocument testIndex testMapping defaultIndexDocumentSettings tweetPatch (DocId "1")
302 _ <- refreshIndex testIndex
303 return r
305insertOther :: BH IO ()
306insertOther = do
307 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings otherTweet (DocId "2")
308 _ <- refreshIndex testIndex
309 return ()
311insertExtra :: BH IO ()
312insertExtra = do
313 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings tweetWithExtra (DocId "4")
314 _ <- refreshIndex testIndex
315 return ()
317insertWithSpaceInId :: BH IO ()
318insertWithSpaceInId = do
319 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "Hello World")
320 _ <- refreshIndex testIndex
321 return ()
323searchTweet :: Search -> BH IO (Either EsError Tweet)
324searchTweet search = do
325 result <- searchTweets search
326 let myTweet :: Either EsError Tweet
327 myTweet = grabFirst result
328 return myTweet
330searchTweets :: Search -> BH IO (Either EsError (SearchResult Tweet))
331searchTweets search = parseEsResponse =<< searchByIndex testIndex search
333searchExpectNoResults :: Search -> BH IO ()
334searchExpectNoResults search = do
335 result <- searchTweets search
336 let emptyHits = fmap (hits . searchHits) result
337 liftIO $
338 emptyHits `shouldBe` Right []
340searchExpectAggs :: Search -> BH IO ()
341searchExpectAggs search = do
342 reply <- searchByIndex testIndex search
343 let isEmpty x = return (M.null x)
344 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
345 liftIO $
346 (result >>= aggregations >>= isEmpty) `shouldBe` Just False
348searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) =>
349 Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> BH IO ()
350searchValidBucketAgg search aggKey extractor = do
351 reply <- searchByIndex testIndex search
352 let bucketDocs = docCount . head . buckets
353 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
354 let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)
355 liftIO $
356 count `shouldBe` Just 1
358searchTermsAggHint :: [ExecutionHint] -> BH IO ()
359searchTermsAggHint hints = do
360 let terms hint = TermsAgg $ (mkTermsAggregation "user") { termExecutionHint = Just hint }
361 let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint
362 forM_ hints $ searchExpectAggs . search
363 forM_ hints (\x -> searchValidBucketAgg (search x) "users" toTerms)
365searchTweetHighlight :: Search -> BH IO (Either EsError (Maybe HitHighlight))
366searchTweetHighlight search = do
367 result <- searchTweets search
368 let myHighlight = fmap (hitHighlight . head . hits . searchHits) result
369 return myHighlight
371searchExpectSource :: Source -> Either EsError Value -> BH IO ()
372searchExpectSource src expected = do
373 _ <- insertData
374 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
375 let search = (mkSearch (Just query) Nothing) { source = Just src }
376 reply <- searchByIndex testIndex search
377 result <- parseEsResponse reply
378 let value = grabFirst result
379 liftIO $
380 value `shouldBe` expected
382withSnapshotRepo
383 :: ( MonadMask m
384 , MonadBH m
385 )
386 => SnapshotRepoName
387 -> (GenericSnapshotRepo -> m a)
388 -> m a
389withSnapshotRepo srn@(SnapshotRepoName n) f = do
390 repoPaths <- liftIO getRepoPaths
391 -- we'll use the first repo path if available, otherwise system temp
392 -- dir. Note that this will fail on ES > 1.6, so be sure you use
393 -- @when' canSnapshot@.
394 case repoPaths of
395 (firstRepoPath:_) -> withTempDirectory firstRepoPath (T.unpack n) $ \dir -> bracket (alloc dir) free f
396 [] -> withSystemTempDirectory (T.unpack n) $ \dir -> bracket (alloc dir) free f
397 where
398 alloc dir = do
399 liftIO (setFileMode dir mode)
400 let repo = FsSnapshotRepo srn "bloodhound-tests-backups" True Nothing Nothing Nothing
401 resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings repo
402 liftIO (validateStatus resp 200)
403 return (toGSnapshotRepo repo)
404 mode = ownerModes `unionFileModes` groupModes `unionFileModes` otherModes
405 free GenericSnapshotRepo {..} = do
406 resp <- deleteSnapshotRepo gSnapshotRepoName
407 liftIO (validateStatus resp 200)
410withSnapshot
411 :: ( MonadMask m
412 , MonadBH m
413 )
414 => SnapshotRepoName
415 -> SnapshotName
416 -> m a
417 -> m a
418withSnapshot srn sn = bracket_ alloc free
419 where
420 alloc = do
421 resp <- createSnapshot srn sn createSettings
422 liftIO (validateStatus resp 200)
423 -- We'll make this synchronous for testing purposes
424 createSettings = defaultSnapshotCreateSettings { snapWaitForCompletion = True
425 , snapIndices = Just (IndexList (testIndex :| []))
426 -- We don't actually need to back up any data
427 }
428 free = do
429 deleteSnapshot srn sn
433data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
434instance FromJSON BulkTest where
435 parseJSON = genericParseJSON defaultOptions
436instance ToJSON BulkTest where
437 toJSON = genericToJSON defaultOptions
439class GApproxEq f where
440 gApproxEq :: f a -> f a -> Bool
442-- | Unit type
443instance GApproxEq U1 where
444 gApproxEq U1 U1 = True
446-- | Sum type, ensure same constructors, recurse
447instance (GApproxEq a, GApproxEq b) => GApproxEq (a :+: b) where
448 gApproxEq (L1 a) (L1 b) = gApproxEq a b
449 gApproxEq (R1 a) (R1 b) = gApproxEq a b
450 gApproxEq _ _ = False
452-- | Product type, ensure each field is approx eq
453instance (GApproxEq a, GApproxEq b) => GApproxEq (a :*: b) where
454 gApproxEq (a1 :*: b1) (a2 :*: b2) = gApproxEq a1 a2 && gApproxEq b1 b2
456-- | Value type, actually check the values for approx equality
457instance (ApproxEq a) => GApproxEq (K1 i a) where
458 gApproxEq (K1 a) (K1 b) = a =~ b
460instance (GApproxEq f) => GApproxEq (M1 i t f) where
461 gApproxEq (M1 a) (M1 b) = gApproxEq a b
463-- | Typeclass for "equal where it matters". Use this to specify
464-- less-strict equivalence for things such as lists that can wind up
465-- in an unpredictable order
466class ApproxEq a where
467 (=~) :: a -> a -> Bool
468 default (=~) :: (Generic a, GApproxEq (Rep a)) => a -> a -> Bool
469 a =~ b = gApproxEq (G.from a) (G.from b)
471 showApproxEq :: a -> String
472 default showApproxEq :: (Show a) => a -> String
473 showApproxEq = show
475instance ApproxEq NominalDiffTime where (=~) = (==)
476instance ApproxEq UTCTime where (=~) = (==)
477instance ApproxEq Text where (=~) = (==)
478instance ApproxEq Bool where (=~) = (==)
479instance ApproxEq Int where (=~) = (==)
480instance ApproxEq Double where (=~) = (==)
481instance (ApproxEq a, Show a) => ApproxEq (NonEmpty a)
482instance (ApproxEq a, Show a) => ApproxEq (Maybe a)
483instance ApproxEq GeoPoint
484instance ApproxEq Regexp
485instance ApproxEq RangeValue
486instance ApproxEq LessThan
487instance ApproxEq LessThanEq
488instance ApproxEq LessThanD
489instance ApproxEq LessThanEqD
490instance ApproxEq GreaterThan
491instance ApproxEq GreaterThanEq
492instance ApproxEq GreaterThanD
493instance ApproxEq GreaterThanEqD
494instance ApproxEq MinimumMatchHighLow
495instance ApproxEq RegexpFlag
496instance ApproxEq RegexpFlags
497instance ApproxEq NullValue
498instance ApproxEq Version
499instance ApproxEq VersionNumber
500instance ApproxEq DistanceRange
501instance ApproxEq IndexName
502instance ApproxEq MappingName
503instance ApproxEq DocId
504instance ApproxEq IndexAliasRouting
505instance ApproxEq RoutingValue
506instance ApproxEq ShardCount
507instance ApproxEq ReplicaCount
508instance ApproxEq TemplateName
509instance ApproxEq TemplatePattern
510instance ApproxEq QueryString
511instance ApproxEq FieldName
512instance ApproxEq CacheName
513instance ApproxEq CacheKey
514instance ApproxEq Existence
515instance ApproxEq CutoffFrequency
516instance ApproxEq Analyzer
517instance ApproxEq Lenient
518instance ApproxEq Tiebreaker
519instance ApproxEq Boost
520instance ApproxEq BoostTerms
521instance ApproxEq MaxExpansions
522instance ApproxEq MinimumMatch
523instance ApproxEq DisableCoord
524instance ApproxEq IgnoreTermFrequency
525instance ApproxEq MinimumTermFrequency
526instance ApproxEq MaxQueryTerms
527instance ApproxEq Fuzziness
528instance ApproxEq PrefixLength
529instance ApproxEq TypeName
530instance ApproxEq PercentMatch
531instance ApproxEq StopWord
532instance ApproxEq QueryPath
533instance ApproxEq AllowLeadingWildcard
534instance ApproxEq LowercaseExpanded
535instance ApproxEq EnablePositionIncrements
536instance ApproxEq AnalyzeWildcard
537instance ApproxEq GeneratePhraseQueries
538instance ApproxEq Locale
539instance ApproxEq MaxWordLength
540instance ApproxEq MinWordLength
541instance ApproxEq PhraseSlop
542instance ApproxEq MinDocFrequency
543instance ApproxEq MaxDocFrequency
544instance ApproxEq Filter
545instance ApproxEq Query
546instance ApproxEq SimpleQueryStringQuery
547instance ApproxEq FieldOrFields
548instance ApproxEq SimpleQueryFlag
549instance ApproxEq RegexpQuery
550instance ApproxEq QueryStringQuery
551instance ApproxEq RangeQuery
552instance ApproxEq PrefixQuery
553instance ApproxEq NestedQuery
554instance ApproxEq MoreLikeThisFieldQuery
555instance ApproxEq MoreLikeThisQuery
556instance ApproxEq IndicesQuery
557instance ApproxEq HasParentQuery
558instance ApproxEq HasChildQuery
559instance ApproxEq FuzzyQuery
560instance ApproxEq FuzzyLikeFieldQuery
561instance ApproxEq FuzzyLikeThisQuery
562instance ApproxEq DisMaxQuery
563instance ApproxEq CommonTermsQuery
564instance ApproxEq CommonMinimumMatch
565instance ApproxEq BoostingQuery
566instance ApproxEq BoolQuery
567instance ApproxEq MatchQuery
568instance ApproxEq MultiMatchQueryType
569instance ApproxEq BooleanOperator
570instance ApproxEq ZeroTermsQuery
571instance ApproxEq MatchQueryType
572instance ApproxEq AliasRouting
573instance ApproxEq IndexAliasCreate
574instance ApproxEq SearchAliasRouting
575instance ApproxEq ScoreType
576instance ApproxEq Distance
577instance ApproxEq DistanceUnit
578instance ApproxEq DistanceType
579instance ApproxEq OptimizeBbox
580instance ApproxEq GeoBoundingBoxConstraint
581instance ApproxEq GeoFilterType
582instance ApproxEq GeoBoundingBox
583instance ApproxEq LatLon
584instance ApproxEq RangeExecution
585instance ApproxEq FSType
586instance ApproxEq CompoundFormat
587instance ApproxEq InitialShardCount
588instance ApproxEq Bytes
589instance ApproxEq ReplicaBounds
590instance ApproxEq Term
591instance ApproxEq BoolMatch
592instance ApproxEq MultiMatchQuery
593instance ApproxEq IndexSettings
594instance ApproxEq AllocationPolicy
595instance ApproxEq Char where
596 (=~) = (==)
597instance ApproxEq Vers.Version where
598 (=~) = (==)
599instance (ApproxEq a, Show a) => ApproxEq [a] where
600 as =~ bs = and (zipWith (=~) as bs)
601instance (ApproxEq l, Show l, ApproxEq r, Show r) => ApproxEq (Either l r) where
602 Left a =~ Left b = a =~ b
603 Right a =~ Right b = a =~ b
604 _ =~ _ = False
605 showApproxEq (Left x) = "Left " <> showApproxEq x
606 showApproxEq (Right x) = "Right " <> showApproxEq x
607instance ApproxEq NodeAttrFilter
608instance ApproxEq NodeAttrName
609instance ApproxEq BuildHash
610instance ApproxEq TemplateQueryKeyValuePairs where
611 (=~) = (==)
612instance ApproxEq TemplateQueryInline
614-- | Due to the way nodeattrfilters get serialized here, they may come
615-- out in a different order, but they are morally equivalent
616instance ApproxEq UpdatableIndexSetting where
617 RoutingAllocationInclude a =~ RoutingAllocationInclude b =
618 NE.sort a =~ NE.sort b
619 RoutingAllocationExclude a =~ RoutingAllocationExclude b =
620 NE.sort a =~ NE.sort b
621 RoutingAllocationRequire a =~ RoutingAllocationRequire b =
622 NE.sort a =~ NE.sort b
623 a =~ b = a == b
624 showApproxEq (RoutingAllocationInclude xs) = show (RoutingAllocationInclude (NE.sort xs))
625 showApproxEq (RoutingAllocationExclude xs) = show (RoutingAllocationExclude (NE.sort xs))
626 showApproxEq (RoutingAllocationRequire xs) = show (RoutingAllocationRequire (NE.sort xs))
627 showApproxEq x = show x
630noDuplicates :: Eq a => [a] -> Bool
631noDuplicates xs = nub xs == xs
633instance Arbitrary NominalDiffTime where
634 arbitrary = fromInteger <$> arbitrary
636#if !MIN_VERSION_QuickCheck(2,8,0)
637instance (Arbitrary k, Ord k, Arbitrary v) => Arbitrary (M.Map k v) where
638 arbitrary = M.fromList <$> arbitrary
639#endif
641instance Arbitrary Text where
642 arbitrary = T.pack <$> arbitrary
644instance Arbitrary UTCTime where
645 arbitrary = UTCTime
646 <$> arbitrary
647 <*> (fromRational . toRational <$> choose (0::Double, 86400))
649instance Arbitrary Day where
650 arbitrary = ModifiedJulianDay <$> (2000 +) <$> arbitrary
651 shrink = (ModifiedJulianDay <$>) . shrink . toModifiedJulianDay
653#if !MIN_VERSION_QuickCheck(2,9,0)
654instance Arbitrary a => Arbitrary (NonEmpty a) where
655 arbitrary = liftA2 (:|) arbitrary arbitrary
656#endif
658arbitraryScore :: Gen Score
659arbitraryScore = fmap getPositive <$> arbitrary
661instance (Arbitrary a, Typeable a) => Arbitrary (Hit a) where
662 arbitrary = Hit <$> arbitrary
663 <*> arbitrary
664 <*> arbitrary
665 <*> arbitraryScore
666 <*> arbitrary
667 <*> arbitrary
668 shrink = genericShrink
671instance (Arbitrary a, Typeable a) => Arbitrary (SearchHits a) where
672 arbitrary = reduceSize $ do
673 tot <- getPositive <$> arbitrary
674 score <- arbitraryScore
675 hs <- arbitrary
676 return $ SearchHits tot score hs
677 shrink = genericShrink
679reduceSize :: Gen a -> Gen a
680reduceSize f = sized $ \n -> resize (n `div` 2) f
682getSource :: EsResult a -> Maybe a
683getSource = fmap _source . foundResult
685grabFirst :: Either EsError (SearchResult a) -> Either EsError a
686grabFirst r =
687 case fmap (hitSource . head . hits . searchHits) r of
688 (Left e) -> Left e
689 (Right Nothing) -> Left (EsError 500 "Source was missing")
690 (Right (Just x)) -> Right x
692-------------------------------------------------------------------------------
693arbitraryAlphaNum :: Gen Char
694arbitraryAlphaNum = oneof [choose ('a', 'z')
695 ,choose ('A','Z')
696 , choose ('0', '9')]
698instance Arbitrary RoutingValue where
699 arbitrary = RoutingValue . T.pack <$> listOf1 arbitraryAlphaNum
701instance Arbitrary AliasRouting where
702 arbitrary = oneof [allAlias
703 ,one
704 ,theOther
705 ,both]
706 where one = GranularAliasRouting
707 <$> (Just <$> arbitrary)
708 <*> pure Nothing
709 theOther = GranularAliasRouting Nothing
710 <$> (Just <$> arbitrary)
711 both = GranularAliasRouting
712 <$> (Just <$> arbitrary)
713 <*> (Just <$> arbitrary)
714 allAlias = AllAliasRouting <$> arbitrary
715 shrink = genericShrink
718instance Arbitrary FieldName where
719 arbitrary = FieldName . T.pack <$> listOf1 arbitraryAlphaNum
720 shrink = genericShrink
723instance Arbitrary RegexpFlags where
724 arbitrary = oneof [ pure AllRegexpFlags
725 , pure NoRegexpFlags
726 , SomeRegexpFlags <$> genUniqueFlags
727 ]
728 where genUniqueFlags = NE.fromList . nub <$> listOf1 arbitrary
729 shrink = genericShrink
732instance Arbitrary IndexAliasCreate where
733 arbitrary = IndexAliasCreate <$> arbitrary <*> reduceSize arbitrary
734 shrink = genericShrink
736instance Arbitrary Query where
737 arbitrary = reduceSize $ oneof [ TermQuery <$> arbitrary <*> arbitrary
738 , TermsQuery <$> arbitrary <*> arbitrary
739 , QueryMatchQuery <$> arbitrary
740 , QueryMultiMatchQuery <$> arbitrary
741 , QueryBoolQuery <$> arbitrary
742 , QueryBoostingQuery <$> arbitrary
743 , QueryCommonTermsQuery <$> arbitrary
744 , ConstantScoreQuery <$> arbitrary <*> arbitrary
745 , QueryDisMaxQuery <$> arbitrary
746 , QueryFuzzyLikeThisQuery <$> arbitrary
747 , QueryFuzzyLikeFieldQuery <$> arbitrary
748 , QueryFuzzyQuery <$> arbitrary
749 , QueryHasChildQuery <$> arbitrary
750 , QueryHasParentQuery <$> arbitrary
751 , IdsQuery <$> arbitrary <*> arbitrary
752 , QueryIndicesQuery <$> arbitrary
753 , MatchAllQuery <$> arbitrary
754 , QueryMoreLikeThisQuery <$> arbitrary
755 , QueryMoreLikeThisFieldQuery <$> arbitrary
756 , QueryNestedQuery <$> arbitrary
757 , QueryPrefixQuery <$> arbitrary
758 , QueryQueryStringQuery <$> arbitrary
759 , QuerySimpleQueryStringQuery <$> arbitrary
760 , QueryRangeQuery <$> arbitrary
761 , QueryRegexpQuery <$> arbitrary
762 , QueryTemplateQueryInline <$> arbitrary
763 ]
764 shrink = genericShrink
766instance Arbitrary Filter where
767 arbitrary = Filter <$> arbitrary
768 shrink = genericShrink
770instance Arbitrary ReplicaBounds where
771 arbitrary = oneof [ replicasBounded
772 , replicasLowerBounded
773 , pure ReplicasUnbounded
774 ]
775 where replicasBounded = do Positive a <- arbitrary
776 Positive b <- arbitrary
777 return (ReplicasBounded a b)
778 replicasLowerBounded = do Positive a <- arbitrary
779 return (ReplicasLowerBounded a)
781instance Arbitrary NodeAttrName where
782 arbitrary = NodeAttrName . T.pack <$> listOf1 arbitraryAlphaNum
785instance Arbitrary NodeAttrFilter where
786 arbitrary = do
787 n <- arbitrary
788 s:ss <- listOf1 (listOf1 arbitraryAlphaNum)
789 let ts = T.pack <$> s :| ss
790 return (NodeAttrFilter n ts)
791 shrink = genericShrink
793instance Arbitrary VersionNumber where
794 arbitrary = mk . fmap getPositive . getNonEmpty <$> arbitrary
795 where
796 mk versions = VersionNumber (Vers.Version versions [])
798instance Arbitrary TemplateQueryKeyValuePairs where
799 arbitrary = TemplateQueryKeyValuePairs . HM.fromList <$> arbitrary
800 shrink (TemplateQueryKeyValuePairs x) = map (TemplateQueryKeyValuePairs . HM.fromList) . shrink $ HM.toList x
802instance Arbitrary IndexName where arbitrary = sopArbitrary; shrink = genericShrink
803instance Arbitrary MappingName where arbitrary = sopArbitrary; shrink = genericShrink
804instance Arbitrary DocId where arbitrary = sopArbitrary; shrink = genericShrink
805instance Arbitrary Version where arbitrary = sopArbitrary; shrink = genericShrink
806instance Arbitrary BuildHash where arbitrary = sopArbitrary; shrink = genericShrink
807instance Arbitrary IndexAliasRouting where arbitrary = sopArbitrary; shrink = genericShrink
808instance Arbitrary ShardCount where arbitrary = sopArbitrary; shrink = genericShrink
809instance Arbitrary ReplicaCount where arbitrary = sopArbitrary; shrink = genericShrink
810instance Arbitrary TemplateName where arbitrary = sopArbitrary; shrink = genericShrink
811instance Arbitrary TemplatePattern where arbitrary = sopArbitrary; shrink = genericShrink
812instance Arbitrary QueryString where arbitrary = sopArbitrary; shrink = genericShrink
813instance Arbitrary CacheName where arbitrary = sopArbitrary; shrink = genericShrink
814instance Arbitrary CacheKey where arbitrary = sopArbitrary; shrink = genericShrink
815instance Arbitrary Existence where arbitrary = sopArbitrary; shrink = genericShrink
816instance Arbitrary CutoffFrequency where arbitrary = sopArbitrary; shrink = genericShrink
817instance Arbitrary Analyzer where arbitrary = sopArbitrary; shrink = genericShrink
818instance Arbitrary MaxExpansions where arbitrary = sopArbitrary; shrink = genericShrink
819instance Arbitrary Lenient where arbitrary = sopArbitrary; shrink = genericShrink
820instance Arbitrary Tiebreaker where arbitrary = sopArbitrary; shrink = genericShrink
821instance Arbitrary Boost where arbitrary = sopArbitrary; shrink = genericShrink
822instance Arbitrary BoostTerms where arbitrary = sopArbitrary; shrink = genericShrink
823instance Arbitrary MinimumMatch where arbitrary = sopArbitrary; shrink = genericShrink
824instance Arbitrary DisableCoord where arbitrary = sopArbitrary; shrink = genericShrink
825instance Arbitrary IgnoreTermFrequency where arbitrary = sopArbitrary; shrink = genericShrink
826instance Arbitrary MinimumTermFrequency where arbitrary = sopArbitrary; shrink = genericShrink
827instance Arbitrary MaxQueryTerms where arbitrary = sopArbitrary; shrink = genericShrink
828instance Arbitrary Fuzziness where arbitrary = sopArbitrary; shrink = genericShrink
829instance Arbitrary PrefixLength where arbitrary = sopArbitrary; shrink = genericShrink
830instance Arbitrary TypeName where arbitrary = sopArbitrary; shrink = genericShrink
831instance Arbitrary PercentMatch where arbitrary = sopArbitrary; shrink = genericShrink
832instance Arbitrary StopWord where arbitrary = sopArbitrary; shrink = genericShrink
833instance Arbitrary QueryPath where arbitrary = sopArbitrary; shrink = genericShrink
834instance Arbitrary AllowLeadingWildcard where arbitrary = sopArbitrary; shrink = genericShrink
835instance Arbitrary LowercaseExpanded where arbitrary = sopArbitrary; shrink = genericShrink
836instance Arbitrary EnablePositionIncrements where arbitrary = sopArbitrary; shrink = genericShrink
837instance Arbitrary AnalyzeWildcard where arbitrary = sopArbitrary; shrink = genericShrink
838instance Arbitrary GeneratePhraseQueries where arbitrary = sopArbitrary; shrink = genericShrink
839instance Arbitrary Locale where arbitrary = sopArbitrary; shrink = genericShrink
840instance Arbitrary MaxWordLength where arbitrary = sopArbitrary; shrink = genericShrink
841instance Arbitrary MinWordLength where arbitrary = sopArbitrary; shrink = genericShrink
842instance Arbitrary PhraseSlop where arbitrary = sopArbitrary; shrink = genericShrink
843instance Arbitrary MinDocFrequency where arbitrary = sopArbitrary; shrink = genericShrink
844instance Arbitrary MaxDocFrequency where arbitrary = sopArbitrary; shrink = genericShrink
845instance Arbitrary Regexp where arbitrary = sopArbitrary; shrink = genericShrink
846instance Arbitrary SimpleQueryStringQuery where arbitrary = sopArbitrary; shrink = genericShrink
847instance Arbitrary FieldOrFields where arbitrary = sopArbitrary; shrink = genericShrink
848instance Arbitrary SimpleQueryFlag where arbitrary = sopArbitrary; shrink = genericShrink
849instance Arbitrary RegexpQuery where arbitrary = sopArbitrary; shrink = genericShrink
850instance Arbitrary QueryStringQuery where arbitrary = sopArbitrary; shrink = genericShrink
851instance Arbitrary RangeQuery where arbitrary = sopArbitrary; shrink = genericShrink
852instance Arbitrary RangeValue where arbitrary = sopArbitrary; shrink = genericShrink
853instance Arbitrary PrefixQuery where arbitrary = sopArbitrary; shrink = genericShrink
854instance Arbitrary NestedQuery where arbitrary = sopArbitrary; shrink = genericShrink
855instance Arbitrary MoreLikeThisFieldQuery where arbitrary = sopArbitrary; shrink = genericShrink
856instance Arbitrary MoreLikeThisQuery where arbitrary = sopArbitrary; shrink = genericShrink
857instance Arbitrary IndicesQuery where arbitrary = sopArbitrary; shrink = genericShrink
858instance Arbitrary HasParentQuery where arbitrary = sopArbitrary; shrink = genericShrink
859instance Arbitrary HasChildQuery where arbitrary = sopArbitrary; shrink = genericShrink
860instance Arbitrary FuzzyQuery where arbitrary = sopArbitrary; shrink = genericShrink
861instance Arbitrary FuzzyLikeFieldQuery where arbitrary = sopArbitrary; shrink = genericShrink
862instance Arbitrary FuzzyLikeThisQuery 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
909instance Arbitrary TemplateQueryInline where arbitrary = sopArbitrary; shrink = genericShrink
911newtype UpdatableIndexSetting' = UpdatableIndexSetting' UpdatableIndexSetting
912 deriving (Show, Eq, ToJSON, FromJSON, ApproxEq, Typeable)
914instance Arbitrary UpdatableIndexSetting' where
915 arbitrary = do
916 settings <- arbitrary
917 return $ UpdatableIndexSetting' $ case settings of
918 RoutingAllocationInclude xs -> RoutingAllocationInclude (dropDuplicateAttrNames xs)
919 RoutingAllocationExclude xs -> RoutingAllocationExclude (dropDuplicateAttrNames xs)
920 RoutingAllocationRequire xs -> RoutingAllocationRequire (dropDuplicateAttrNames xs)
921 x -> x
922 where
923 dropDuplicateAttrNames = NE.fromList . L.nubBy sameAttrName . NE.toList
924 sameAttrName a b = nodeAttrFilterName a == nodeAttrFilterName b
926main :: IO ()
927main = hspec $ do
929 describe "index create/delete API" $ do
930 it "creates and then deletes the requested index" $ withTestEnv $ do
931 -- priming state.
932 _ <- deleteExampleIndex
933 resp <- createExampleIndex
934 deleteResp <- deleteExampleIndex
935 liftIO $ do
936 validateStatus resp 200
937 validateStatus deleteResp 200
939 describe "error parsing" $ do
940 it "can parse EsErrors for < 2.0" $ when' (atmost es16) $ withTestEnv $ do
941 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
942 let errorResp = eitherDecode (responseBody res)
943 liftIO (errorResp `shouldBe` Right (EsError 404 "IndexMissingException[[bogus] missing]"))
945 it "can parse EsErrors for >= 2.0" $ when' (atleast es20) $ withTestEnv $ do
946 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
947 let errorResp = eitherDecode (responseBody res)
948 liftIO (errorResp `shouldBe` Right (EsError 404 "no such index"))
950 describe "document API" $ do
951 it "indexes, updates, gets, and then deletes the generated document" $ withTestEnv $ do
952 _ <- insertData
953 _ <- updateData
954 docInserted <- getDocument testIndex testMapping (DocId "1")
955 let newTweet = eitherDecode
956 (responseBody docInserted) :: Either String (EsResult Tweet)
957 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just patchedTweet))
959 it "indexes, gets, and then deletes the generated document with a DocId containing a space" $ withTestEnv $ do
960 _ <- insertWithSpaceInId
961 docInserted <- getDocument testIndex testMapping (DocId "Hello World")
962 let newTweet = eitherDecode
963 (responseBody docInserted) :: Either String (EsResult Tweet)
964 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))
966 it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do
967 doc <- getDocument testIndex testMapping (DocId "bogus")
968 let noTweet = eitherDecode
969 (responseBody doc) :: Either String (EsResult Tweet)
970 liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing
972 it "can use optimistic concurrency control" $ withTestEnv $ do
973 let ev = ExternalDocVersion minBound
974 let cfg = defaultIndexDocumentSettings { idsVersionControl = ExternalGT ev }
975 resetIndex
976 res <- insertData' cfg
977 liftIO $ isCreated res `shouldBe` True
978 res' <- insertData' cfg
979 liftIO $ isVersionConflict res' `shouldBe` True
981 it "indexes two documents in a parent/child relationship and checks that the child exists" $ withTestEnv $ do
982 resetIndex
983 _ <- putMapping testIndex (MappingName "child") ChildMapping
984 _ <- putMapping testIndex (MappingName "parent") ParentMapping
985 _ <- indexDocument testIndex (MappingName "parent") defaultIndexDocumentSettings exampleTweet (DocId "1")
986 let parent = (Just . DocumentParent . DocId) "1"
987 ids = IndexDocumentSettings NoVersionControl parent
988 _ <- indexDocument testIndex (MappingName "child") ids otherTweet (DocId "2")
989 _ <- refreshIndex testIndex
990 exists <- documentExists testIndex (MappingName "child") parent (DocId "2")
991 liftIO $ exists `shouldBe` True
993 describe "template API" $ do
994 it "can create a template" $ withTestEnv $ do
995 let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
996 resp <- putTemplate idxTpl (TemplateName "tweet-tpl")
997 liftIO $ validateStatus resp 200
999 it "can detect if a template exists" $ withTestEnv $ do
1000 exists <- templateExists (TemplateName "tweet-tpl")
1001 liftIO $ exists `shouldBe` True
1003 it "can delete a template" $ withTestEnv $ do
1004 resp <- deleteTemplate (TemplateName "tweet-tpl")
1005 liftIO $ validateStatus resp 200
1007 it "can detect if a template doesn't exist" $ withTestEnv $ do
1008 exists <- templateExists (TemplateName "tweet-tpl")
1009 liftIO $ exists `shouldBe` False
1011 describe "bulk API" $ do
1012 it "inserts all documents we request" $ withTestEnv $ do
1013 _ <- insertData
1014 let firstTest = BulkTest "blah"
1015 let secondTest = BulkTest "bloo"
1016 let firstDoc = BulkIndex testIndex
1017 testMapping (DocId "2") (toJSON firstTest)
1018 let secondDoc = BulkCreate testIndex
1019 testMapping (DocId "3") (toJSON secondTest)
1020 let stream = V.fromList [firstDoc, secondDoc]
1021 _ <- bulk stream
1022 _ <- refreshIndex testIndex
1023 fDoc <- getDocument testIndex testMapping (DocId "2")
1024 sDoc <- getDocument testIndex testMapping (DocId "3")
1025 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
1026 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
1027 liftIO $ do
1028 fmap getSource maybeFirst `shouldBe` Right (Just firstTest)
1029 fmap getSource maybeSecond `shouldBe` Right (Just secondTest)
1032 describe "query API" $ do
1033 it "returns document for term query and identity filter" $ withTestEnv $ do
1034 _ <- insertData
1035 let query = TermQuery (Term "user" "bitemyapp") Nothing
1036 let filter = Filter $ MatchAllQuery Nothing
1037 let search = mkSearch (Just query) (Just filter)
1038 myTweet <- searchTweet search
1039 liftIO $
1040 myTweet `shouldBe` Right exampleTweet
1042 it "handles constant score queries" $ withTestEnv $ do
1043 _ <- insertData
1044 let query = TermsQuery "user" ("bitemyapp" :| [])
1045 let cfQuery = ConstantScoreQuery query (Boost 1.0)
1046 let filter = Filter $ MatchAllQuery Nothing
1047 let search = mkSearch (Just cfQuery) (Just filter)
1048 myTweet <- searchTweet search
1049 liftIO $
1050 myTweet `shouldBe` Right exampleTweet
1052 it "returns document for terms query and identity filter" $ withTestEnv $ do
1053 _ <- insertData
1054 let query = TermsQuery "user" ("bitemyapp" :| [])
1055 let filter = Filter $ MatchAllQuery Nothing
1056 let search = mkSearch (Just query) (Just filter)
1057 myTweet <- searchTweet search
1058 liftIO $
1059 myTweet `shouldBe` Right exampleTweet
1061 it "returns document for match query" $ withTestEnv $ do
1062 _ <- insertData
1063 let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1064 let search = mkSearch (Just query) Nothing
1065 myTweet <- searchTweet search
1066 liftIO $
1067 myTweet `shouldBe` Right exampleTweet
1069 it "returns document for multi-match query" $ withTestEnv $ do
1070 _ <- insertData
1071 let flds = [FieldName "user", FieldName "message"]
1072 let query = QueryMultiMatchQuery $ mkMultiMatchQuery flds (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 bool query" $ withTestEnv $ do
1079 _ <- insertData
1080 let innerQuery = QueryMatchQuery $
1081 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1082 let query = QueryBoolQuery $
1083 mkBoolQuery [innerQuery] [] [] []
1084 let search = mkSearch (Just query) Nothing
1085 myTweet <- searchTweet search
1086 liftIO $
1087 myTweet `shouldBe` Right exampleTweet
1089 it "returns document for boosting query" $ withTestEnv $ do
1090 _ <- insertData
1091 let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1092 let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
1093 let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
1094 let search = mkSearch (Just query) Nothing
1095 myTweet <- searchTweet search
1096 liftIO $
1097 myTweet `shouldBe` Right exampleTweet
1099 it "returns document for common terms query" $ withTestEnv $ do
1100 _ <- insertData
1101 let query = QueryCommonTermsQuery $
1102 CommonTermsQuery (FieldName "user")
1103 (QueryString "bitemyapp")
1104 (CutoffFrequency 0.0001)
1105 Or Or Nothing Nothing Nothing Nothing
1106 let search = mkSearch (Just query) Nothing
1107 myTweet <- searchTweet search
1108 liftIO $
1109 myTweet `shouldBe` Right exampleTweet
1111 it "returns document for for inline template query" $ withTestEnv $ do
1112 _ <- insertData
1113 let innerQuery = QueryMatchQuery $
1114 mkMatchQuery (FieldName "{{userKey}}")
1115 (QueryString "{{bitemyappKey}}")
1116 templateParams = TemplateQueryKeyValuePairs $ HM.fromList
1117 [ ("userKey", "user")
1118 , ("bitemyappKey", "bitemyapp")
1120 templateQuery = QueryTemplateQueryInline $
1121 TemplateQueryInline innerQuery templateParams
1122 search = mkSearch (Just templateQuery) Nothing
1123 myTweet <- searchTweet search
1124 liftIO $ myTweet `shouldBe` Right exampleTweet
1127 describe "sorting" $ do
1128 it "returns documents in the right order" $ withTestEnv $ do
1129 _ <- insertData
1130 _ <- insertOther
1131 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
1132 let search = Search Nothing
1133 Nothing (Just [sortSpec]) Nothing Nothing
1134 False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
1135 result <- searchTweets search
1136 let myTweet = grabFirst result
1137 liftIO $
1138 myTweet `shouldBe` Right otherTweet
1140 describe "Aggregation API" $ do
1141 it "returns term aggregation results" $ withTestEnv $ do
1142 _ <- insertData
1143 let terms = TermsAgg $ mkTermsAggregation "user"
1144 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1145 searchExpectAggs search
1146 searchValidBucketAgg search "users" toTerms
1148 it "return sub-aggregation results" $ withTestEnv $ do
1149 _ <- insertData
1150 let subaggs = mkAggregations "age_agg" . TermsAgg $ mkTermsAggregation "age"
1151 agg = TermsAgg $ (mkTermsAggregation "user") { termAggs = Just subaggs}
1152 search = mkAggregateSearch Nothing $ mkAggregations "users" agg
1153 reply <- searchByIndex testIndex search
1154 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
1155 usersAggResults = result >>= aggregations >>= toTerms "users"
1156 subAggResults = usersAggResults >>= (listToMaybe . buckets) >>= termsAggs >>= toTerms "age_agg"
1157 subAddResultsExists = isJust subAggResults
1158 liftIO $ (subAddResultsExists) `shouldBe` True
1160 it "returns cardinality aggregation results" $ withTestEnv $ do
1161 _ <- insertData
1162 let cardinality = CardinalityAgg $ mkCardinalityAggregation $ FieldName "user"
1163 let search = mkAggregateSearch Nothing $ mkAggregations "users" cardinality
1164 let search' = search { Database.V5.Bloodhound.from = From 0, size = Size 0 }
1165 searchExpectAggs search'
1166 let docCountPair k n = (k, object ["value" .= Number n])
1167 res <- searchTweets search'
1168 liftIO $
1169 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "users" 1]))
1171 it "returns stats aggregation results" $ withTestEnv $ do
1172 _ <- insertData
1173 let stats = StatsAgg $ mkStatsAggregation $ FieldName "age"
1174 let search = mkAggregateSearch Nothing $ mkAggregations "users" stats
1175 let search' = search { Database.V5.Bloodhound.from = From 0, size = Size 0 }
1176 searchExpectAggs search'
1177 let statsAggRes k n = (k, object [ "max" .= Number n
1178 , "avg" .= Number n
1179 , "count" .= Number 1
1180 , "min" .= Number n
1181 , "sum" .= Number n])
1182 res <- searchTweets search'
1183 liftIO $
1184 fmap aggregations res `shouldBe` Right (Just (M.fromList [ statsAggRes "users" 10000]))
1186 it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
1187 _ <- insertData
1188 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
1189 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1190 searchExpectAggs search
1191 searchValidBucketAgg search "users" toTerms
1193 -- One of these fails with 1.7.3
1194 it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
1195 _ <- insertData
1196 searchTermsAggHint [Map, Ordinals]
1198 it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do
1199 _ <- insertData
1200 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
1202 it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
1203 _ <- insertData
1204 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
1205 -- One of the above.
1207 it "can execute value_count aggregations" $ withTestEnv $ do
1208 _ <- insertData
1209 _ <- insertOther
1210 let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>
1211 mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))
1212 let search = mkAggregateSearch Nothing ags
1213 let docCountPair k n = (k, object ["value" .= Number n])
1214 res <- searchTweets search
1215 liftIO $
1216 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2
1217 , docCountPair "bogus_count" 0
1218 ]))
1220 it "can execute date_range aggregations" $ withTestEnv $ do
1221 let now = fromGregorian 2015 3 14
1222 let ltAMonthAgo = UTCTime (fromGregorian 2015 3 1) 0
1223 let ltAWeekAgo = UTCTime (fromGregorian 2015 3 10) 0
1224 let oldDoc = exampleTweet { postDate = ltAMonthAgo }
1225 let newDoc = exampleTweet { postDate = ltAWeekAgo }
1226 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings oldDoc (DocId "1")
1227 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings newDoc (DocId "2")
1228 _ <- refreshIndex testIndex
1229 let thisMonth = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMMonth])
1230 let thisWeek = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMWeek])
1231 let agg = DateRangeAggregation (FieldName "postDate") Nothing (thisMonth :| [thisWeek])
1232 let ags = mkAggregations "date_ranges" (DateRangeAgg agg)
1233 let search = mkAggregateSearch Nothing ags
1234 res <- searchTweets search
1235 liftIO $ hitsTotal . searchHits <$> res `shouldBe` Right 2
1236 let bucks = do magrs <- fmapL show (aggregations <$> res)
1237 agrs <- note "no aggregations returned" magrs
1238 rawBucks <- note "no date_ranges aggregation" $ M.lookup "date_ranges" agrs
1239 parseEither parseJSON rawBucks
1240 let fromMonthT = UTCTime (fromGregorian 2015 2 14) 0
1241 let fromWeekT = UTCTime (fromGregorian 2015 3 7) 0
1242 liftIO $ buckets <$> bucks `shouldBe` Right [ DateRangeResult "2015-02-14T00:00:00.000Z-*"
1243 (Just fromMonthT)
1244 (Just "2015-02-14T00:00:00.000Z")
1245 Nothing
1246 Nothing
1248 Nothing
1249 , DateRangeResult "2015-03-07T00:00:00.000Z-*"
1250 (Just fromWeekT)
1251 (Just "2015-03-07T00:00:00.000Z")
1252 Nothing
1253 Nothing
1255 Nothing
1258 it "returns date histogram aggregation results" $ withTestEnv $ do
1259 _ <- insertData
1260 let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
1261 let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
1262 searchExpectAggs search
1263 searchValidBucketAgg search "byDate" toDateHistogram
1265 it "can execute missing aggregations" $ withTestEnv $ do
1266 _ <- insertData
1267 _ <- insertExtra
1268 let ags = mkAggregations "missing_agg" (MissingAgg (MissingAggregation "extra"))
1269 let search = mkAggregateSearch Nothing ags
1270 let docCountPair k n = (k, object ["doc_count" .= Number n])
1271 res <- searchTweets search
1272 liftIO $
1273 fmap aggregations res `shouldBe` Right (Just (M.fromList [docCountPair "missing_agg" 1]))
1275 describe "Highlights API" $ do
1277 it "returns highlight from query when there should be one" $ withTestEnv $ do
1278 _ <- insertData
1279 _ <- insertOther
1280 let query = QueryMatchQuery $ mkMatchQuery (FieldName "message") (QueryString "haskell")
1281 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
1283 let search = mkHighlightSearch (Just query) testHighlight
1284 myHighlight <- searchTweetHighlight search
1285 liftIO $
1286 myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
1288 it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
1289 _ <- insertData
1290 _ <- insertOther
1291 let query = QueryMatchQuery $ mkMatchQuery (FieldName "message") (QueryString "haskell")
1292 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "user") Nothing]
1294 let search = mkHighlightSearch (Just query) testHighlight
1295 myHighlight <- searchTweetHighlight search
1296 liftIO $
1297 myHighlight `shouldBe` Right Nothing
1299 describe "Source filtering" $ do
1301 it "doesn't include source when sources are disabled" $ withTestEnv $ do
1302 searchExpectSource
1303 NoSource
1304 (Left (EsError 500 "Source was missing"))
1306 it "includes a source" $ withTestEnv $ do
1307 searchExpectSource
1308 (SourcePatterns (PopPattern (Pattern "message")))
1309 (Right (Object (HM.fromList [("message", String "Use haskell!")])))
1311 it "includes sources" $ withTestEnv $ do
1312 searchExpectSource
1313 (SourcePatterns (PopPatterns [Pattern "user", Pattern "message"]))
1314 (Right (Object (HM.fromList [("user",String "bitemyapp"),("message", String "Use haskell!")])))
1316 it "includes source patterns" $ withTestEnv $ do
1317 searchExpectSource
1318 (SourcePatterns (PopPattern (Pattern "*ge")))
1319 (Right (Object (HM.fromList [("age", Number 10000),("message", String "Use haskell!")])))
1321 it "excludes source patterns" $ withTestEnv $ do
1322 searchExpectSource
1323 (SourceIncludeExclude (Include [])
1324 (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate", Pattern "extra"]))
1325 (Right (Object (HM.fromList [("user",String "bitemyapp")])))
1327 describe "ToJSON RegexpFlags" $ do
1328 it "generates the correct JSON for AllRegexpFlags" $
1329 toJSON AllRegexpFlags `shouldBe` String "ALL"
1331 it "generates the correct JSON for NoRegexpFlags" $
1332 toJSON NoRegexpFlags `shouldBe` String "NONE"
1334 it "generates the correct JSON for SomeRegexpFlags" $
1335 let flags = AnyString :| [ Automaton
1336 , Complement
1337 , Empty
1338 , Intersection
1339 , Interval ]
1340 in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
1342 prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
1343 let String str = toJSON flags
1344 flagStrs = T.splitOn "|" str
1345 in noDuplicates flagStrs
1347 describe "omitNulls" $ do
1348 it "checks that omitNulls drops list elements when it should" $
1349 let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))
1350 , "test2" .= (toJSON ("some value" :: Text))]
1351 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1353 it "checks that omitNulls doesn't drop list elements when it shouldn't" $
1354 let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))
1355 , "test2" .= (toJSON ("some value" :: Text))]
1356 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))
1357 , ("test2", String "some value")])
1358 it "checks that omitNulls drops non list elements when it should" $
1359 let dropped = omitNulls $ [ "test1" .= (toJSON Null)
1360 , "test2" .= (toJSON ("some value" :: Text))]
1361 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1362 it "checks that omitNulls doesn't drop non list elements when it shouldn't" $
1363 let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
1364 , "test2" .= (toJSON ("some value" :: Text))]
1365 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
1366 , ("test2", String "some value")])
1367 describe "Monoid (SearchHits a)" $ do
1368 prop "abides the monoid laws" $ eq $
1369 prop_Monoid (T :: T (SearchHits ()))
1371 describe "mkDocVersion" $ do
1372 prop "can never construct an out of range docVersion" $ \i ->
1373 let res = mkDocVersion i
1374 in case res of
1375 Nothing -> property True
1376 Just dv -> (dv >= minBound) .&&.
1377 (dv <= maxBound) .&&.
1378 docVersionNumber dv === i
1380 describe "FsSnapshotRepo" $ do
1381 prop "SnapshotRepo laws" $ \fsr ->
1382 fromGSnapshotRepo (toGSnapshotRepo fsr) === Right (fsr :: FsSnapshotRepo)
1384 describe "snapshot repos" $ do
1385 it "always parses all snapshot repos API" $ when' canSnapshot $ withTestEnv $ do
1386 res <- getSnapshotRepos AllSnapshotRepos
1387 liftIO $ case res of
1388 Left e -> expectationFailure ("Expected a right but got Left " <> show e)
1389 Right _ -> return ()
1391 it "finds an existing list of repos" $ when' canSnapshot $ withTestEnv $ do
1392 let r1n = SnapshotRepoName "bloodhound-repo1"
1393 let r2n = SnapshotRepoName "bloodhound-repo2"
1394 withSnapshotRepo r1n $ \r1 ->
1395 withSnapshotRepo r2n $ \r2 -> do
1396 repos <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| [ExactRepo r2n]))
1397 liftIO $ case repos of
1398 Right xs -> do
1399 let srt = L.sortBy (comparing gSnapshotRepoName)
1400 srt xs `shouldBe` srt [r1, r2]
1401 Left e -> expectationFailure (show e)
1403 it "creates and updates with updateSnapshotRepo" $ when' canSnapshot $ withTestEnv $ do
1404 let r1n = SnapshotRepoName "bloodhound-repo1"
1405 withSnapshotRepo r1n $ \r1 -> do
1406 let Just (String dir) = HM.lookup "location" (gSnapshotRepoSettingsObject (gSnapshotRepoSettings r1))
1407 let noCompression = FsSnapshotRepo r1n (T.unpack dir) False Nothing Nothing Nothing
1408 resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings noCompression
1409 liftIO (validateStatus resp 200)
1410 Right [roundtrippedNoCompression] <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| []))
1411 liftIO (roundtrippedNoCompression `shouldBe` toGSnapshotRepo noCompression)
1413 -- verify came around in 1.4 it seems
1414 it "can verify existing repos" $ when' canSnapshot $ when' (atleast es14) $ withTestEnv $ do
1415 let r1n = SnapshotRepoName "bloodhound-repo1"
1416 withSnapshotRepo r1n $ \_ -> do
1417 res <- verifySnapshotRepo r1n
1418 liftIO $ case res of
1419 Right (SnapshotVerification vs)
1420 | null vs -> expectationFailure "Expected nonempty set of verifying nodes"
1421 | otherwise -> return ()
1422 Left e -> expectationFailure (show e)
1424 describe "snapshots" $ do
1425 it "always parses all snapshots API" $ when' canSnapshot $ withTestEnv $ do
1426 let r1n = SnapshotRepoName "bloodhound-repo1"
1427 withSnapshotRepo r1n $ \_ -> do
1428 res <- getSnapshots r1n AllSnapshots
1429 liftIO $ case res of
1430 Left e -> expectationFailure ("Expected a right but got Left " <> show e)
1431 Right _ -> return ()
1433 it "can parse a snapshot that it created" $ when' canSnapshot $ withTestEnv $ do
1434 let r1n = SnapshotRepoName "bloodhound-repo1"
1435 withSnapshotRepo r1n $ \_ -> do
1436 let s1n = SnapshotName "example-snapshot"
1437 withSnapshot r1n s1n $ do
1438 res <- getSnapshots r1n (SnapshotList (ExactSnap s1n :| []))
1439 liftIO $ case res of
1440 Right [snap]
1441 | snapInfoState snap == SnapshotSuccess &&
1442 snapInfoName snap == s1n -> return ()
1443 | otherwise -> expectationFailure (show snap)
1444 Right [] -> expectationFailure "There were no snapshots"
1445 Right snaps -> expectationFailure ("Expected 1 snapshot but got" <> show (length snaps))
1446 Left e -> expectationFailure (show e)
1448 describe "snapshot restore" $ do
1449 it "can restore a snapshot that we create" $ when' canSnapshot $ withTestEnv $ do
1450 let r1n = SnapshotRepoName "bloodhound-repo1"
1451 withSnapshotRepo r1n $ \_ -> do
1452 let s1n = SnapshotName "example-snapshot"
1453 withSnapshot r1n s1n $ do
1454 let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True }
1455 -- have to close an index to restore it
1456 resp1 <- closeIndex testIndex
1457 liftIO (validateStatus resp1 200)
1458 resp2 <- restoreSnapshot r1n s1n settings
1459 liftIO (validateStatus resp2 200)
1461 it "can restore and rename" $ when' canSnapshot $ withTestEnv $ do
1462 let r1n = SnapshotRepoName "bloodhound-repo1"
1463 withSnapshotRepo r1n $ \_ -> do
1464 let s1n = SnapshotName "example-snapshot"
1465 withSnapshot r1n s1n $ do
1466 let pat = RestoreRenamePattern "bloodhound-tests-twitter-(\\d+)"
1467 let replace = RRTLit "restored-" :| [RRSubWholeMatch]
1468 let expectedIndex = IndexName "restored-bloodhound-tests-twitter-1"
1469 oldEnoughForOverrides <- liftIO (atleast es15)
1470 let overrides = RestoreIndexSettings { restoreOverrideReplicas = Just (ReplicaCount 0) }
1471 let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True
1472 , snapRestoreRenamePattern = Just pat
1473 , snapRestoreRenameReplacement = Just replace
1474 , snapRestoreIndexSettingsOverrides = if oldEnoughForOverrides
1475 then Just overrides
1476 else Nothing
1478 -- have to close an index to restore it
1479 let go = do
1480 resp <- restoreSnapshot r1n s1n settings
1481 liftIO (validateStatus resp 200)
1482 exists <- indexExists expectedIndex
1483 liftIO (exists `shouldBe` True)
1484 go `finally` deleteIndex expectedIndex
1486 describe "getNodesInfo" $ do
1487 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
1488 res <- getNodesInfo LocalNode
1489 liftIO $ case res of
1490 -- This is really just a smoke test for response
1491 -- parsing. Node info is so variable, there's not much I can
1492 -- assert here.
1493 Right NodesInfo {..} -> length nodesInfo `shouldBe` 1
1494 Left e -> expectationFailure ("Expected NodesInfo but got " <> show e)
1496 describe "getNodesStats" $ do
1497 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
1498 res <- getNodesStats LocalNode
1499 liftIO $ case res of
1500 -- This is really just a smoke test for response
1501 -- parsing. Node stats is so variable, there's not much I can
1502 -- assert here.
1503 Right NodesStats {..} -> length nodesStats `shouldBe` 1
1504 Left e -> expectationFailure ("Expected NodesStats but got " <> show e)
1506 describe "Enum DocVersion" $ do
1507 it "follows the laws of Enum, Bounded" $ do
1508 evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall
1509 evaluate (pred minBound :: DocVersion) `shouldThrow` anyErrorCall
1510 evaluate (toEnum 0 :: DocVersion) `shouldThrow` anyErrorCall
1511 evaluate (toEnum 9200000000000000001 :: DocVersion) `shouldThrow` anyErrorCall
1512 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1513 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1514 enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]
1516 describe "scan&scroll API" $ do
1517 it "returns documents using the scan&scroll API" $ withTestEnv $ do
1518 _ <- insertData
1519 _ <- insertOther
1520 let search = (mkSearch (Just $ MatchAllQuery Nothing) Nothing) { size = (Size 1) }
1521 regular_search <- searchTweet search
1522 scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet]
1523 let scan_search = map hitSource scan_search'
1524 liftIO $
1525 regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored
1526 liftIO $
1527 scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]
1529 describe "index aliases" $ do
1530 it "handles the simple case of aliasing an existing index" $ do
1531 let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1532 let create = IndexAliasCreate Nothing Nothing
1533 let action = AddAlias alias create
1535 withTestEnv $ do
1536 resetIndex
1537 resp <- updateIndexAliases (action :| [])
1538 liftIO $ validateStatus resp 200
1539 let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1540 (do aliases <- withTestEnv getIndexAliases
1541 let expected = IndexAliasSummary alias create
1542 case aliases of
1543 Right (IndexAliasesSummary summs) ->
1544 L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1545 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1547 describe "Index Listing" $ do
1548 it "returns a list of index names" $ withTestEnv $ do
1549 _ <- createExampleIndex
1550 ixns <- listIndices
1551 liftIO (ixns `shouldContain` [testIndex])
1553 describe "Index Settings" $ do
1554 it "persists settings" $ withTestEnv $ do
1555 _ <- deleteExampleIndex
1556 _ <- createExampleIndex
1557 let updates = BlocksWrite False :| []
1558 updateResp <- updateIndexSettings updates testIndex
1559 liftIO $ validateStatus updateResp 200
1560 getResp <- getIndexSettings testIndex
1561 liftIO $
1562 getResp `shouldBe` Right (IndexSettingsSummary
1563 testIndex
1564 (IndexSettings (ShardCount 1) (ReplicaCount 0))
1565 (NE.toList updates))
1567 describe "Index Optimization" $ do
1568 it "returns a successful response upon completion" $ withTestEnv $ do
1569 _ <- createExampleIndex
1570 resp <- forceMergeIndex (IndexList (testIndex :| [])) defaultForceMergeIndexSettings
1571 liftIO $ validateStatus resp 200
1573 describe "JSON instances" $ do
1574 propJSON (Proxy :: Proxy Version)
1575 propJSON (Proxy :: Proxy IndexName)
1576 propJSON (Proxy :: Proxy MappingName)
1577 propJSON (Proxy :: Proxy DocId)
1578 propJSON (Proxy :: Proxy IndexAliasRouting)
1579 propJSON (Proxy :: Proxy RoutingValue)
1580 propJSON (Proxy :: Proxy ShardCount)
1581 propJSON (Proxy :: Proxy ReplicaCount)
1582 propJSON (Proxy :: Proxy TemplateName)
1583 propJSON (Proxy :: Proxy TemplatePattern)
1584 propJSON (Proxy :: Proxy QueryString)
1585 propJSON (Proxy :: Proxy FieldName)
1586 propJSON (Proxy :: Proxy CacheName)
1587 propJSON (Proxy :: Proxy CacheKey)
1588 propJSON (Proxy :: Proxy Existence)
1589 propJSON (Proxy :: Proxy CutoffFrequency)
1590 propJSON (Proxy :: Proxy Analyzer)
1591 propJSON (Proxy :: Proxy MaxExpansions)
1592 propJSON (Proxy :: Proxy Lenient)
1593 propJSON (Proxy :: Proxy Tiebreaker)
1594 propJSON (Proxy :: Proxy Boost)
1595 propJSON (Proxy :: Proxy BoostTerms)
1596 propJSON (Proxy :: Proxy MinimumMatch)
1597 propJSON (Proxy :: Proxy DisableCoord)
1598 propJSON (Proxy :: Proxy IgnoreTermFrequency)
1599 propJSON (Proxy :: Proxy MinimumTermFrequency)
1600 propJSON (Proxy :: Proxy MaxQueryTerms)
1601 propJSON (Proxy :: Proxy Fuzziness)
1602 propJSON (Proxy :: Proxy PrefixLength)
1603 propJSON (Proxy :: Proxy TypeName)
1604 propJSON (Proxy :: Proxy PercentMatch)
1605 propJSON (Proxy :: Proxy StopWord)
1606 propJSON (Proxy :: Proxy QueryPath)
1607 propJSON (Proxy :: Proxy AllowLeadingWildcard)
1608 propJSON (Proxy :: Proxy LowercaseExpanded)
1609 propJSON (Proxy :: Proxy EnablePositionIncrements)
1610 propJSON (Proxy :: Proxy AnalyzeWildcard)
1611 propJSON (Proxy :: Proxy GeneratePhraseQueries)
1612 propJSON (Proxy :: Proxy Locale)
1613 propJSON (Proxy :: Proxy MaxWordLength)
1614 propJSON (Proxy :: Proxy MinWordLength)
1615 propJSON (Proxy :: Proxy PhraseSlop)
1616 propJSON (Proxy :: Proxy MinDocFrequency)
1617 propJSON (Proxy :: Proxy MaxDocFrequency)
1618 propJSON (Proxy :: Proxy Filter)
1619 propJSON (Proxy :: Proxy Query)
1620 propJSON (Proxy :: Proxy SimpleQueryStringQuery)
1621 propJSON (Proxy :: Proxy FieldOrFields)
1622 propJSON (Proxy :: Proxy SimpleQueryFlag)
1623 propJSON (Proxy :: Proxy RegexpQuery)
1624 propJSON (Proxy :: Proxy QueryStringQuery)
1625 propJSON (Proxy :: Proxy RangeQuery)
1626 propJSON (Proxy :: Proxy PrefixQuery)
1627 propJSON (Proxy :: Proxy NestedQuery)
1628 propJSON (Proxy :: Proxy MoreLikeThisFieldQuery)
1629 propJSON (Proxy :: Proxy MoreLikeThisQuery)
1630 propJSON (Proxy :: Proxy IndicesQuery)
1631 propJSON (Proxy :: Proxy HasParentQuery)
1632 propJSON (Proxy :: Proxy HasChildQuery)
1633 propJSON (Proxy :: Proxy FuzzyQuery)
1634 propJSON (Proxy :: Proxy FuzzyLikeFieldQuery)
1635 propJSON (Proxy :: Proxy FuzzyLikeThisQuery)
1636 propJSON (Proxy :: Proxy DisMaxQuery)
1637 propJSON (Proxy :: Proxy CommonTermsQuery)
1638 propJSON (Proxy :: Proxy CommonMinimumMatch)
1639 propJSON (Proxy :: Proxy BoostingQuery)
1640 propJSON (Proxy :: Proxy BoolQuery)
1641 propJSON (Proxy :: Proxy MatchQuery)
1642 propJSON (Proxy :: Proxy MultiMatchQueryType)
1643 propJSON (Proxy :: Proxy BooleanOperator)
1644 propJSON (Proxy :: Proxy ZeroTermsQuery)
1645 propJSON (Proxy :: Proxy MatchQueryType)
1646 propJSON (Proxy :: Proxy AliasRouting)
1647 propJSON (Proxy :: Proxy IndexAliasCreate)
1648 propJSON (Proxy :: Proxy SearchAliasRouting)
1649 propJSON (Proxy :: Proxy ScoreType)
1650 propJSON (Proxy :: Proxy Distance)
1651 propJSON (Proxy :: Proxy DistanceUnit)
1652 propJSON (Proxy :: Proxy DistanceType)
1653 propJSON (Proxy :: Proxy OptimizeBbox)
1654 propJSON (Proxy :: Proxy GeoBoundingBoxConstraint)
1655 propJSON (Proxy :: Proxy GeoFilterType)
1656 propJSON (Proxy :: Proxy GeoBoundingBox)
1657 propJSON (Proxy :: Proxy LatLon)
1658 propJSON (Proxy :: Proxy RangeExecution)
1659 prop "RegexpFlags FromJSON/ToJSON roundtrips, removing dups " $ \rfs ->
1660 let expected = case rfs of
1661 SomeRegexpFlags fs -> SomeRegexpFlags (NE.fromList (nub (NE.toList fs)))
1662 x -> x
1663 in parseEither parseJSON (toJSON rfs) === Right expected
1664 propJSON (Proxy :: Proxy BoolMatch)
1665 propJSON (Proxy :: Proxy Term)
1666 propJSON (Proxy :: Proxy MultiMatchQuery)
1667 propJSON (Proxy :: Proxy IndexSettings)
1668 propJSON (Proxy :: Proxy UpdatableIndexSetting')
1669 propJSON (Proxy :: Proxy ReplicaBounds)
1670 propJSON (Proxy :: Proxy Bytes)
1671 propJSON (Proxy :: Proxy AllocationPolicy)
1672 propJSON (Proxy :: Proxy InitialShardCount)
1673 propJSON (Proxy :: Proxy FSType)
1674 propJSON (Proxy :: Proxy CompoundFormat)
1675 propJSON (Proxy :: Proxy TemplateQueryInline)
1677-- Temporary solution for lacking of generic derivation of Arbitrary
1678-- We use generics-sop, as it's much more concise than directly using GHC.Generics
1680-- This will be unneeded after https://github.com/nick8325/quickcheck/pull/112
1681-- is merged and released
1682sopArbitrary :: forall a. (Generic a, SOP.GTo a, SOP.All SOP.SListI (SOP.GCode a), SOP.All2 Arbitrary (SOP.GCode a)) => Gen a
1683sopArbitrary = fmap SOP.gto sopArbitrary'
1685sopArbitrary' :: forall xss. (SOP.All SOP.SListI xss, SOP.All2 Arbitrary xss) => Gen (SOP.SOP SOP.I xss)
1686sopArbitrary' = SOP.hsequence =<< elements (SOP.apInjs_POP $ SOP.hcpure p arbitrary)
1687 where
1688 p :: Proxy Arbitrary
1689 p = Proxy