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