git.iko.soy/typeable/bloodhound
on 1454d69 help sign in
typeable/bloodhound/tests/V5/tests.hs
1815 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
622instance ApproxEq DirectGenerators
623instance ApproxEq DirectGeneratorSuggestModeTypes
625-- | Due to the way nodeattrfilters get serialized here, they may come
626-- out in a different order, but they are morally equivalent
627instance ApproxEq UpdatableIndexSetting where
628 RoutingAllocationInclude a =~ RoutingAllocationInclude b =
629 NE.sort a =~ NE.sort b
630 RoutingAllocationExclude a =~ RoutingAllocationExclude b =
631 NE.sort a =~ NE.sort b
632 RoutingAllocationRequire a =~ RoutingAllocationRequire b =
633 NE.sort a =~ NE.sort b
634 a =~ b = a == b
635 showApproxEq (RoutingAllocationInclude xs) = show (RoutingAllocationInclude (NE.sort xs))
636 showApproxEq (RoutingAllocationExclude xs) = show (RoutingAllocationExclude (NE.sort xs))
637 showApproxEq (RoutingAllocationRequire xs) = show (RoutingAllocationRequire (NE.sort xs))
638 showApproxEq x = show x
641noDuplicates :: Eq a => [a] -> Bool
642noDuplicates xs = nub xs == xs
644instance Arbitrary NominalDiffTime where
645 arbitrary = fromInteger <$> arbitrary
647#if !MIN_VERSION_QuickCheck(2,8,0)
648instance (Arbitrary k, Ord k, Arbitrary v) => Arbitrary (M.Map k v) where
649 arbitrary = M.fromList <$> arbitrary
650#endif
652instance Arbitrary Text where
653 arbitrary = T.pack <$> arbitrary
655instance Arbitrary UTCTime where
656 arbitrary = UTCTime
657 <$> arbitrary
658 <*> (fromRational . toRational <$> choose (0::Double, 86400))
660instance Arbitrary Day where
661 arbitrary = ModifiedJulianDay <$> (2000 +) <$> arbitrary
662 shrink = (ModifiedJulianDay <$>) . shrink . toModifiedJulianDay
664#if !MIN_VERSION_QuickCheck(2,9,0)
665instance Arbitrary a => Arbitrary (NonEmpty a) where
666 arbitrary = liftA2 (:|) arbitrary arbitrary
667#endif
669arbitraryScore :: Gen Score
670arbitraryScore = fmap getPositive <$> arbitrary
672instance (Arbitrary a, Typeable a) => Arbitrary (Hit a) where
673 arbitrary = Hit <$> arbitrary
674 <*> arbitrary
675 <*> arbitrary
676 <*> arbitraryScore
677 <*> arbitrary
678 <*> arbitrary
679 shrink = genericShrink
682instance (Arbitrary a, Typeable a) => Arbitrary (SearchHits a) where
683 arbitrary = reduceSize $ do
684 tot <- getPositive <$> arbitrary
685 score <- arbitraryScore
686 hs <- arbitrary
687 return $ SearchHits tot score hs
688 shrink = genericShrink
690reduceSize :: Gen a -> Gen a
691reduceSize f = sized $ \n -> resize (n `div` 2) f
693getSource :: EsResult a -> Maybe a
694getSource = fmap _source . foundResult
696grabFirst :: Either EsError (SearchResult a) -> Either EsError a
697grabFirst r =
698 case fmap (hitSource . head . hits . searchHits) r of
699 (Left e) -> Left e
700 (Right Nothing) -> Left (EsError 500 "Source was missing")
701 (Right (Just x)) -> Right x
703-------------------------------------------------------------------------------
704arbitraryAlphaNum :: Gen Char
705arbitraryAlphaNum = oneof [choose ('a', 'z')
706 ,choose ('A','Z')
707 , choose ('0', '9')]
709instance Arbitrary RoutingValue where
710 arbitrary = RoutingValue . T.pack <$> listOf1 arbitraryAlphaNum
712instance Arbitrary AliasRouting where
713 arbitrary = oneof [allAlias
714 ,one
715 ,theOther
716 ,both]
717 where one = GranularAliasRouting
718 <$> (Just <$> arbitrary)
719 <*> pure Nothing
720 theOther = GranularAliasRouting Nothing
721 <$> (Just <$> arbitrary)
722 both = GranularAliasRouting
723 <$> (Just <$> arbitrary)
724 <*> (Just <$> arbitrary)
725 allAlias = AllAliasRouting <$> arbitrary
726 shrink = genericShrink
729instance Arbitrary FieldName where
730 arbitrary = FieldName . T.pack <$> listOf1 arbitraryAlphaNum
731 shrink = genericShrink
734instance Arbitrary RegexpFlags where
735 arbitrary = oneof [ pure AllRegexpFlags
736 , pure NoRegexpFlags
737 , SomeRegexpFlags <$> genUniqueFlags
738 ]
739 where genUniqueFlags = NE.fromList . nub <$> listOf1 arbitrary
740 shrink = genericShrink
743instance Arbitrary IndexAliasCreate where
744 arbitrary = IndexAliasCreate <$> arbitrary <*> reduceSize arbitrary
745 shrink = genericShrink
747instance Arbitrary Query where
748 arbitrary = reduceSize $ oneof [ TermQuery <$> arbitrary <*> arbitrary
749 , TermsQuery <$> arbitrary <*> arbitrary
750 , QueryMatchQuery <$> arbitrary
751 , QueryMultiMatchQuery <$> arbitrary
752 , QueryBoolQuery <$> arbitrary
753 , QueryBoostingQuery <$> arbitrary
754 , QueryCommonTermsQuery <$> arbitrary
755 , ConstantScoreQuery <$> arbitrary <*> arbitrary
756 , QueryDisMaxQuery <$> arbitrary
757 , QueryFuzzyLikeThisQuery <$> arbitrary
758 , QueryFuzzyLikeFieldQuery <$> arbitrary
759 , QueryFuzzyQuery <$> arbitrary
760 , QueryHasChildQuery <$> arbitrary
761 , QueryHasParentQuery <$> arbitrary
762 , IdsQuery <$> arbitrary <*> arbitrary
763 , QueryIndicesQuery <$> arbitrary
764 , MatchAllQuery <$> arbitrary
765 , QueryMoreLikeThisQuery <$> arbitrary
766 , QueryMoreLikeThisFieldQuery <$> arbitrary
767 , QueryNestedQuery <$> arbitrary
768 , QueryPrefixQuery <$> arbitrary
769 , QueryQueryStringQuery <$> arbitrary
770 , QuerySimpleQueryStringQuery <$> arbitrary
771 , QueryRangeQuery <$> arbitrary
772 , QueryRegexpQuery <$> arbitrary
773 , QueryTemplateQueryInline <$> arbitrary
774 ]
775 shrink = genericShrink
777instance Arbitrary Filter where
778 arbitrary = Filter <$> arbitrary
779 shrink = genericShrink
781instance Arbitrary ReplicaBounds where
782 arbitrary = oneof [ replicasBounded
783 , replicasLowerBounded
784 , pure ReplicasUnbounded
785 ]
786 where replicasBounded = do Positive a <- arbitrary
787 Positive b <- arbitrary
788 return (ReplicasBounded a b)
789 replicasLowerBounded = do Positive a <- arbitrary
790 return (ReplicasLowerBounded a)
792instance Arbitrary NodeAttrName where
793 arbitrary = NodeAttrName . T.pack <$> listOf1 arbitraryAlphaNum
796instance Arbitrary NodeAttrFilter where
797 arbitrary = do
798 n <- arbitrary
799 s:ss <- listOf1 (listOf1 arbitraryAlphaNum)
800 let ts = T.pack <$> s :| ss
801 return (NodeAttrFilter n ts)
802 shrink = genericShrink
804instance Arbitrary VersionNumber where
805 arbitrary = mk . fmap getPositive . getNonEmpty <$> arbitrary
806 where
807 mk versions = VersionNumber (Vers.Version versions [])
809instance Arbitrary TemplateQueryKeyValuePairs where
810 arbitrary = TemplateQueryKeyValuePairs . HM.fromList <$> arbitrary
811 shrink (TemplateQueryKeyValuePairs x) = map (TemplateQueryKeyValuePairs . HM.fromList) . shrink $ HM.toList x
813instance Arbitrary IndexName where arbitrary = sopArbitrary; shrink = genericShrink
814instance Arbitrary MappingName where arbitrary = sopArbitrary; shrink = genericShrink
815instance Arbitrary DocId where arbitrary = sopArbitrary; shrink = genericShrink
816instance Arbitrary Version where arbitrary = sopArbitrary; shrink = genericShrink
817instance Arbitrary BuildHash where arbitrary = sopArbitrary; shrink = genericShrink
818instance Arbitrary IndexAliasRouting where arbitrary = sopArbitrary; shrink = genericShrink
819instance Arbitrary ShardCount where arbitrary = sopArbitrary; shrink = genericShrink
820instance Arbitrary ReplicaCount where arbitrary = sopArbitrary; shrink = genericShrink
821instance Arbitrary TemplateName where arbitrary = sopArbitrary; shrink = genericShrink
822instance Arbitrary TemplatePattern where arbitrary = sopArbitrary; shrink = genericShrink
823instance Arbitrary QueryString where arbitrary = sopArbitrary; shrink = genericShrink
824instance Arbitrary CacheName where arbitrary = sopArbitrary; shrink = genericShrink
825instance Arbitrary CacheKey where arbitrary = sopArbitrary; shrink = genericShrink
826instance Arbitrary Existence where arbitrary = sopArbitrary; shrink = genericShrink
827instance Arbitrary CutoffFrequency where arbitrary = sopArbitrary; shrink = genericShrink
828instance Arbitrary Analyzer where arbitrary = sopArbitrary; shrink = genericShrink
829instance Arbitrary MaxExpansions where arbitrary = sopArbitrary; shrink = genericShrink
830instance Arbitrary Lenient where arbitrary = sopArbitrary; shrink = genericShrink
831instance Arbitrary Tiebreaker where arbitrary = sopArbitrary; shrink = genericShrink
832instance Arbitrary Boost where arbitrary = sopArbitrary; shrink = genericShrink
833instance Arbitrary BoostTerms where arbitrary = sopArbitrary; shrink = genericShrink
834instance Arbitrary MinimumMatch where arbitrary = sopArbitrary; shrink = genericShrink
835instance Arbitrary DisableCoord where arbitrary = sopArbitrary; shrink = genericShrink
836instance Arbitrary IgnoreTermFrequency where arbitrary = sopArbitrary; shrink = genericShrink
837instance Arbitrary MinimumTermFrequency where arbitrary = sopArbitrary; shrink = genericShrink
838instance Arbitrary MaxQueryTerms where arbitrary = sopArbitrary; shrink = genericShrink
839instance Arbitrary Fuzziness where arbitrary = sopArbitrary; shrink = genericShrink
840instance Arbitrary PrefixLength where arbitrary = sopArbitrary; shrink = genericShrink
841instance Arbitrary TypeName where arbitrary = sopArbitrary; shrink = genericShrink
842instance Arbitrary PercentMatch where arbitrary = sopArbitrary; shrink = genericShrink
843instance Arbitrary StopWord where arbitrary = sopArbitrary; shrink = genericShrink
844instance Arbitrary QueryPath where arbitrary = sopArbitrary; shrink = genericShrink
845instance Arbitrary AllowLeadingWildcard where arbitrary = sopArbitrary; shrink = genericShrink
846instance Arbitrary LowercaseExpanded where arbitrary = sopArbitrary; shrink = genericShrink
847instance Arbitrary EnablePositionIncrements where arbitrary = sopArbitrary; shrink = genericShrink
848instance Arbitrary AnalyzeWildcard where arbitrary = sopArbitrary; shrink = genericShrink
849instance Arbitrary GeneratePhraseQueries where arbitrary = sopArbitrary; shrink = genericShrink
850instance Arbitrary Locale where arbitrary = sopArbitrary; shrink = genericShrink
851instance Arbitrary MaxWordLength where arbitrary = sopArbitrary; shrink = genericShrink
852instance Arbitrary MinWordLength where arbitrary = sopArbitrary; shrink = genericShrink
853instance Arbitrary PhraseSlop where arbitrary = sopArbitrary; shrink = genericShrink
854instance Arbitrary MinDocFrequency where arbitrary = sopArbitrary; shrink = genericShrink
855instance Arbitrary MaxDocFrequency where arbitrary = sopArbitrary; shrink = genericShrink
856instance Arbitrary Regexp where arbitrary = sopArbitrary; shrink = genericShrink
857instance Arbitrary SimpleQueryStringQuery where arbitrary = sopArbitrary; shrink = genericShrink
858instance Arbitrary FieldOrFields where arbitrary = sopArbitrary; shrink = genericShrink
859instance Arbitrary SimpleQueryFlag where arbitrary = sopArbitrary; shrink = genericShrink
860instance Arbitrary RegexpQuery where arbitrary = sopArbitrary; shrink = genericShrink
861instance Arbitrary QueryStringQuery where arbitrary = sopArbitrary; shrink = genericShrink
862instance Arbitrary RangeQuery where arbitrary = sopArbitrary; shrink = genericShrink
863instance Arbitrary RangeValue where arbitrary = sopArbitrary; shrink = genericShrink
864instance Arbitrary PrefixQuery where arbitrary = sopArbitrary; shrink = genericShrink
865instance Arbitrary NestedQuery where arbitrary = sopArbitrary; shrink = genericShrink
866instance Arbitrary MoreLikeThisFieldQuery where arbitrary = sopArbitrary; shrink = genericShrink
867instance Arbitrary MoreLikeThisQuery where arbitrary = sopArbitrary; shrink = genericShrink
868instance Arbitrary IndicesQuery where arbitrary = sopArbitrary; shrink = genericShrink
869instance Arbitrary HasParentQuery where arbitrary = sopArbitrary; shrink = genericShrink
870instance Arbitrary HasChildQuery where arbitrary = sopArbitrary; shrink = genericShrink
871instance Arbitrary FuzzyQuery where arbitrary = sopArbitrary; shrink = genericShrink
872instance Arbitrary FuzzyLikeFieldQuery where arbitrary = sopArbitrary; shrink = genericShrink
873instance Arbitrary FuzzyLikeThisQuery where arbitrary = sopArbitrary; shrink = genericShrink
874instance Arbitrary DisMaxQuery where arbitrary = sopArbitrary; shrink = genericShrink
875instance Arbitrary CommonTermsQuery where arbitrary = sopArbitrary; shrink = genericShrink
876instance Arbitrary DistanceRange where arbitrary = sopArbitrary; shrink = genericShrink
877instance Arbitrary MultiMatchQuery where arbitrary = sopArbitrary; shrink = genericShrink
878instance Arbitrary LessThanD where arbitrary = sopArbitrary; shrink = genericShrink
879instance Arbitrary LessThanEqD where arbitrary = sopArbitrary; shrink = genericShrink
880instance Arbitrary GreaterThanD where arbitrary = sopArbitrary; shrink = genericShrink
881instance Arbitrary GreaterThanEqD where arbitrary = sopArbitrary; shrink = genericShrink
882instance Arbitrary LessThan where arbitrary = sopArbitrary; shrink = genericShrink
883instance Arbitrary LessThanEq where arbitrary = sopArbitrary; shrink = genericShrink
884instance Arbitrary GreaterThan where arbitrary = sopArbitrary; shrink = genericShrink
885instance Arbitrary GreaterThanEq where arbitrary = sopArbitrary; shrink = genericShrink
886instance Arbitrary GeoPoint where arbitrary = sopArbitrary; shrink = genericShrink
887instance Arbitrary NullValue where arbitrary = sopArbitrary; shrink = genericShrink
888instance Arbitrary MinimumMatchHighLow where arbitrary = sopArbitrary; shrink = genericShrink
889instance Arbitrary CommonMinimumMatch where arbitrary = sopArbitrary; shrink = genericShrink
890instance Arbitrary BoostingQuery where arbitrary = sopArbitrary; shrink = genericShrink
891instance Arbitrary BoolQuery where arbitrary = sopArbitrary; shrink = genericShrink
892instance Arbitrary MatchQuery where arbitrary = sopArbitrary; shrink = genericShrink
893instance Arbitrary MultiMatchQueryType where arbitrary = sopArbitrary; shrink = genericShrink
894instance Arbitrary BooleanOperator where arbitrary = sopArbitrary; shrink = genericShrink
895instance Arbitrary ZeroTermsQuery where arbitrary = sopArbitrary; shrink = genericShrink
896instance Arbitrary MatchQueryType where arbitrary = sopArbitrary; shrink = genericShrink
897instance Arbitrary SearchAliasRouting where arbitrary = sopArbitrary; shrink = genericShrink
898instance Arbitrary ScoreType where arbitrary = sopArbitrary; shrink = genericShrink
899instance Arbitrary Distance where arbitrary = sopArbitrary; shrink = genericShrink
900instance Arbitrary DistanceUnit where arbitrary = sopArbitrary; shrink = genericShrink
901instance Arbitrary DistanceType where arbitrary = sopArbitrary; shrink = genericShrink
902instance Arbitrary OptimizeBbox where arbitrary = sopArbitrary; shrink = genericShrink
903instance Arbitrary GeoBoundingBoxConstraint where arbitrary = sopArbitrary; shrink = genericShrink
904instance Arbitrary GeoFilterType where arbitrary = sopArbitrary; shrink = genericShrink
905instance Arbitrary GeoBoundingBox where arbitrary = sopArbitrary; shrink = genericShrink
906instance Arbitrary LatLon where arbitrary = sopArbitrary; shrink = genericShrink
907instance Arbitrary RangeExecution where arbitrary = sopArbitrary; shrink = genericShrink
908instance Arbitrary RegexpFlag where arbitrary = sopArbitrary; shrink = genericShrink
909instance Arbitrary BoolMatch where arbitrary = sopArbitrary; shrink = genericShrink
910instance Arbitrary Term where arbitrary = sopArbitrary; shrink = genericShrink
911instance Arbitrary IndexSettings where arbitrary = sopArbitrary; shrink = genericShrink
912instance Arbitrary TokenChar where arbitrary = sopArbitrary; shrink = genericShrink
913instance Arbitrary Ngram where arbitrary = sopArbitrary; shrink = genericShrink
914instance Arbitrary TokenizerDefinition where arbitrary = sopArbitrary; shrink = genericShrink
915instance Arbitrary AnalyzerDefinition where arbitrary = sopArbitrary; shrink = genericShrink
916instance Arbitrary Analysis where arbitrary = sopArbitrary; shrink = genericShrink
917instance Arbitrary Tokenizer where arbitrary = sopArbitrary; shrink = genericShrink
918instance Arbitrary UpdatableIndexSetting where arbitrary = sopArbitrary; shrink = genericShrink
919instance Arbitrary Compression where arbitrary = sopArbitrary; shrink = genericShrink
920instance Arbitrary Bytes where arbitrary = sopArbitrary; shrink = genericShrink
921instance Arbitrary AllocationPolicy where arbitrary = sopArbitrary; shrink = genericShrink
922instance Arbitrary InitialShardCount where arbitrary = sopArbitrary; shrink = genericShrink
923instance Arbitrary FSType where arbitrary = sopArbitrary; shrink = genericShrink
924instance Arbitrary CompoundFormat where arbitrary = sopArbitrary; shrink = genericShrink
925instance Arbitrary FsSnapshotRepo where arbitrary = sopArbitrary; shrink = genericShrink
926instance Arbitrary SnapshotRepoName where arbitrary = sopArbitrary; shrink = genericShrink
927instance Arbitrary TemplateQueryInline where arbitrary = sopArbitrary; shrink = genericShrink
928instance Arbitrary PhraseSuggesterCollate where arbitrary = sopArbitrary; shrink = genericShrink
929instance Arbitrary PhraseSuggesterHighlighter where arbitrary = sopArbitrary; shrink = genericShrink
930instance Arbitrary Size where arbitrary = sopArbitrary; shrink = genericShrink
931instance Arbitrary PhraseSuggester where arbitrary = sopArbitrary; shrink = genericShrink
932instance Arbitrary SuggestType where arbitrary = sopArbitrary; shrink = genericShrink
933instance Arbitrary Suggest where arbitrary = sopArbitrary; shrink = genericShrink
934instance Arbitrary DirectGenerators where arbitrary = sopArbitrary; shrink = genericShrink
935instance Arbitrary DirectGeneratorSuggestModeTypes where arbitrary = sopArbitrary; shrink = genericShrink
937newtype UpdatableIndexSetting' = UpdatableIndexSetting' UpdatableIndexSetting
938 deriving (Show, Eq, ToJSON, FromJSON, ApproxEq, Typeable)
940instance Arbitrary UpdatableIndexSetting' where
941 arbitrary = do
942 settings <- arbitrary
943 return $ UpdatableIndexSetting' $ case settings of
944 RoutingAllocationInclude xs -> RoutingAllocationInclude (dropDuplicateAttrNames xs)
945 RoutingAllocationExclude xs -> RoutingAllocationExclude (dropDuplicateAttrNames xs)
946 RoutingAllocationRequire xs -> RoutingAllocationRequire (dropDuplicateAttrNames xs)
947 x -> x
948 where
949 dropDuplicateAttrNames = NE.fromList . L.nubBy sameAttrName . NE.toList
950 sameAttrName a b = nodeAttrFilterName a == nodeAttrFilterName b
952main :: IO ()
953main = hspec $ do
955 describe "index create/delete API" $ do
956 it "creates and then deletes the requested index" $ withTestEnv $ do
957 -- priming state.
958 _ <- deleteExampleIndex
959 resp <- createExampleIndex
960 deleteResp <- deleteExampleIndex
961 liftIO $ do
962 validateStatus resp 200
963 validateStatus deleteResp 200
965 describe "error parsing" $ do
966 it "can parse EsErrors for < 2.0" $ when' (atmost es16) $ withTestEnv $ do
967 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
968 let errorResp = eitherDecode (responseBody res)
969 liftIO (errorResp `shouldBe` Right (EsError 404 "IndexMissingException[[bogus] missing]"))
971 it "can parse EsErrors for >= 2.0" $ when' (atleast es20) $ withTestEnv $ do
972 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
973 let errorResp = eitherDecode (responseBody res)
974 liftIO (errorResp `shouldBe` Right (EsError 404 "no such index"))
976 describe "document API" $ do
977 it "indexes, updates, gets, and then deletes the generated document" $ withTestEnv $ do
978 _ <- insertData
979 _ <- updateData
980 docInserted <- getDocument testIndex testMapping (DocId "1")
981 let newTweet = eitherDecode
982 (responseBody docInserted) :: Either String (EsResult Tweet)
983 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just patchedTweet))
985 it "indexes, gets, and then deletes the generated document with a DocId containing a space" $ withTestEnv $ do
986 _ <- insertWithSpaceInId
987 docInserted <- getDocument testIndex testMapping (DocId "Hello World")
988 let newTweet = eitherDecode
989 (responseBody docInserted) :: Either String (EsResult Tweet)
990 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))
992 it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do
993 doc <- getDocument testIndex testMapping (DocId "bogus")
994 let noTweet = eitherDecode
995 (responseBody doc) :: Either String (EsResult Tweet)
996 liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing
998 it "can use optimistic concurrency control" $ withTestEnv $ do
999 let ev = ExternalDocVersion minBound
1000 let cfg = defaultIndexDocumentSettings { idsVersionControl = ExternalGT ev }
1001 resetIndex
1002 res <- insertData' cfg
1003 liftIO $ isCreated res `shouldBe` True
1004 res' <- insertData' cfg
1005 liftIO $ isVersionConflict res' `shouldBe` True
1007 it "indexes two documents in a parent/child relationship and checks that the child exists" $ withTestEnv $ do
1008 resetIndex
1009 _ <- putMapping testIndex (MappingName "child") ChildMapping
1010 _ <- putMapping testIndex (MappingName "parent") ParentMapping
1011 _ <- indexDocument testIndex (MappingName "parent") defaultIndexDocumentSettings exampleTweet (DocId "1")
1012 let parent = (Just . DocumentParent . DocId) "1"
1013 ids = IndexDocumentSettings NoVersionControl parent
1014 _ <- indexDocument testIndex (MappingName "child") ids otherTweet (DocId "2")
1015 _ <- refreshIndex testIndex
1016 exists <- documentExists testIndex (MappingName "child") parent (DocId "2")
1017 liftIO $ exists `shouldBe` True
1019 describe "template API" $ do
1020 it "can create a template" $ withTestEnv $ do
1021 let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
1022 resp <- putTemplate idxTpl (TemplateName "tweet-tpl")
1023 liftIO $ validateStatus resp 200
1025 it "can detect if a template exists" $ withTestEnv $ do
1026 exists <- templateExists (TemplateName "tweet-tpl")
1027 liftIO $ exists `shouldBe` True
1029 it "can delete a template" $ withTestEnv $ do
1030 resp <- deleteTemplate (TemplateName "tweet-tpl")
1031 liftIO $ validateStatus resp 200
1033 it "can detect if a template doesn't exist" $ withTestEnv $ do
1034 exists <- templateExists (TemplateName "tweet-tpl")
1035 liftIO $ exists `shouldBe` False
1037 describe "bulk API" $ do
1038 it "inserts all documents we request" $ withTestEnv $ do
1039 _ <- insertData
1040 let firstTest = BulkTest "blah"
1041 let secondTest = BulkTest "bloo"
1042 let thirdTest = BulkTest "graffle"
1043 let firstDoc = BulkIndex testIndex
1044 testMapping (DocId "2") (toJSON firstTest)
1045 let secondDoc = BulkCreate testIndex
1046 testMapping (DocId "3") (toJSON secondTest)
1047 let thirdDoc = BulkCreateEncoding testIndex
1048 testMapping (DocId "4") (toEncoding thirdTest)
1049 let stream = V.fromList [firstDoc, secondDoc, thirdDoc]
1050 _ <- bulk stream
1051 _ <- refreshIndex testIndex
1052 fDoc <- getDocument testIndex testMapping (DocId "2")
1053 sDoc <- getDocument testIndex testMapping (DocId "3")
1054 tDoc <- getDocument testIndex testMapping (DocId "4")
1055 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
1056 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
1057 let maybeThird = eitherDecode $ responseBody tDoc :: Either String (EsResult BulkTest)
1058 liftIO $ do
1059 fmap getSource maybeFirst `shouldBe` Right (Just firstTest)
1060 fmap getSource maybeSecond `shouldBe` Right (Just secondTest)
1061 fmap getSource maybeThird `shouldBe` Right (Just thirdTest)
1064 describe "query API" $ do
1065 it "returns document for term query and identity filter" $ withTestEnv $ do
1066 _ <- insertData
1067 let query = TermQuery (Term "user" "bitemyapp") Nothing
1068 let filter = Filter $ MatchAllQuery Nothing
1069 let search = mkSearch (Just query) (Just filter)
1070 myTweet <- searchTweet search
1071 liftIO $
1072 myTweet `shouldBe` Right exampleTweet
1074 it "handles constant score queries" $ withTestEnv $ do
1075 _ <- insertData
1076 let query = TermsQuery "user" ("bitemyapp" :| [])
1077 let cfQuery = ConstantScoreQuery query (Boost 1.0)
1078 let filter = Filter $ MatchAllQuery Nothing
1079 let search = mkSearch (Just cfQuery) (Just filter)
1080 myTweet <- searchTweet search
1081 liftIO $
1082 myTweet `shouldBe` Right exampleTweet
1084 it "returns document for terms query and identity filter" $ withTestEnv $ do
1085 _ <- insertData
1086 let query = TermsQuery "user" ("bitemyapp" :| [])
1087 let filter = Filter $ MatchAllQuery Nothing
1088 let search = mkSearch (Just query) (Just filter)
1089 myTweet <- searchTweet search
1090 liftIO $
1091 myTweet `shouldBe` Right exampleTweet
1093 it "returns document for match query" $ withTestEnv $ do
1094 _ <- insertData
1095 let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1096 let search = mkSearch (Just query) Nothing
1097 myTweet <- searchTweet search
1098 liftIO $
1099 myTweet `shouldBe` Right exampleTweet
1101 it "returns document for multi-match query" $ withTestEnv $ do
1102 _ <- insertData
1103 let flds = [FieldName "user", FieldName "message"]
1104 let query = QueryMultiMatchQuery $ mkMultiMatchQuery flds (QueryString "bitemyapp")
1105 let search = mkSearch (Just query) Nothing
1106 myTweet <- searchTweet search
1107 liftIO $
1108 myTweet `shouldBe` Right exampleTweet
1110 it "returns document for multi-match query with a custom tiebreaker" $ withTestEnv $ do
1111 _ <- insertData
1112 let tiebreaker = Just $ Tiebreaker 0.3
1113 flds = [FieldName "user", FieldName "message"]
1114 multiQuery' = mkMultiMatchQuery flds (QueryString "bitemyapp")
1115 query = QueryMultiMatchQuery $ multiQuery' { multiMatchQueryTiebreaker = tiebreaker }
1116 search = mkSearch (Just query) Nothing
1117 myTweet <- searchTweet search
1118 liftIO $
1119 myTweet `shouldBe` Right exampleTweet
1121 it "returns document for bool query" $ withTestEnv $ do
1122 _ <- insertData
1123 let innerQuery = QueryMatchQuery $
1124 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1125 let query = QueryBoolQuery $
1126 mkBoolQuery [innerQuery] [] [] []
1127 let search = mkSearch (Just query) Nothing
1128 myTweet <- searchTweet search
1129 liftIO $
1130 myTweet `shouldBe` Right exampleTweet
1132 it "returns document for boosting query" $ withTestEnv $ do
1133 _ <- insertData
1134 let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1135 let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
1136 let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
1137 let search = mkSearch (Just query) Nothing
1138 myTweet <- searchTweet search
1139 liftIO $
1140 myTweet `shouldBe` Right exampleTweet
1142 it "returns document for common terms query" $ withTestEnv $ do
1143 _ <- insertData
1144 let query = QueryCommonTermsQuery $
1145 CommonTermsQuery (FieldName "user")
1146 (QueryString "bitemyapp")
1147 (CutoffFrequency 0.0001)
1148 Or Or Nothing Nothing Nothing Nothing
1149 let search = mkSearch (Just query) Nothing
1150 myTweet <- searchTweet search
1151 liftIO $
1152 myTweet `shouldBe` Right exampleTweet
1154 it "returns document for for inline template query" $ withTestEnv $ do
1155 _ <- insertData
1156 let innerQuery = QueryMatchQuery $
1157 mkMatchQuery (FieldName "{{userKey}}")
1158 (QueryString "{{bitemyappKey}}")
1159 templateParams = TemplateQueryKeyValuePairs $ HM.fromList
1160 [ ("userKey", "user")
1161 , ("bitemyappKey", "bitemyapp")
1163 templateQuery = QueryTemplateQueryInline $
1164 TemplateQueryInline innerQuery templateParams
1165 search = mkSearch (Just templateQuery) Nothing
1166 myTweet <- searchTweet search
1167 liftIO $ myTweet `shouldBe` Right exampleTweet
1170 describe "sorting" $ do
1171 it "returns documents in the right order" $ withTestEnv $ do
1172 _ <- insertData
1173 _ <- insertOther
1174 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
1175 let search = Search Nothing
1176 Nothing (Just [sortSpec]) Nothing Nothing
1177 False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
1178 Nothing
1179 result <- searchTweets search
1180 let myTweet = grabFirst result
1181 liftIO $
1182 myTweet `shouldBe` Right otherTweet
1184 describe "Aggregation API" $ do
1185 it "returns term aggregation results" $ withTestEnv $ do
1186 _ <- insertData
1187 let terms = TermsAgg $ mkTermsAggregation "user"
1188 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1189 searchExpectAggs search
1190 searchValidBucketAgg search "users" toTerms
1192 it "return sub-aggregation results" $ withTestEnv $ do
1193 _ <- insertData
1194 let subaggs = mkAggregations "age_agg" . TermsAgg $ mkTermsAggregation "age"
1195 agg = TermsAgg $ (mkTermsAggregation "user") { termAggs = Just subaggs}
1196 search = mkAggregateSearch Nothing $ mkAggregations "users" agg
1197 reply <- searchByIndex testIndex search
1198 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
1199 usersAggResults = result >>= aggregations >>= toTerms "users"
1200 subAggResults = usersAggResults >>= (listToMaybe . buckets) >>= termsAggs >>= toTerms "age_agg"
1201 subAddResultsExists = isJust subAggResults
1202 liftIO $ (subAddResultsExists) `shouldBe` True
1204 it "returns cardinality aggregation results" $ withTestEnv $ do
1205 _ <- insertData
1206 let cardinality = CardinalityAgg $ mkCardinalityAggregation $ FieldName "user"
1207 let search = mkAggregateSearch Nothing $ mkAggregations "users" cardinality
1208 let search' = search { Database.V5.Bloodhound.from = From 0, size = Size 0 }
1209 searchExpectAggs search'
1210 let docCountPair k n = (k, object ["value" .= Number n])
1211 res <- searchTweets search'
1212 liftIO $
1213 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "users" 1]))
1215 it "returns stats aggregation results" $ withTestEnv $ do
1216 _ <- insertData
1217 let stats = StatsAgg $ mkStatsAggregation $ FieldName "age"
1218 let search = mkAggregateSearch Nothing $ mkAggregations "users" stats
1219 let search' = search { Database.V5.Bloodhound.from = From 0, size = Size 0 }
1220 searchExpectAggs search'
1221 let statsAggRes k n = (k, object [ "max" .= Number n
1222 , "avg" .= Number n
1223 , "count" .= Number 1
1224 , "min" .= Number n
1225 , "sum" .= Number n])
1226 res <- searchTweets search'
1227 liftIO $
1228 fmap aggregations res `shouldBe` Right (Just (M.fromList [ statsAggRes "users" 10000]))
1230 it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
1231 _ <- insertData
1232 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
1233 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1234 searchExpectAggs search
1235 searchValidBucketAgg search "users" toTerms
1237 -- One of these fails with 1.7.3
1238 it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
1239 _ <- insertData
1240 searchTermsAggHint [Map, Ordinals]
1242 it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do
1243 _ <- insertData
1244 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
1246 it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
1247 _ <- insertData
1248 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
1249 -- One of the above.
1251 it "can execute value_count aggregations" $ withTestEnv $ do
1252 _ <- insertData
1253 _ <- insertOther
1254 let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>
1255 mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))
1256 let search = mkAggregateSearch Nothing ags
1257 let docCountPair k n = (k, object ["value" .= Number n])
1258 res <- searchTweets search
1259 liftIO $
1260 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2
1261 , docCountPair "bogus_count" 0
1262 ]))
1264 it "can execute date_range aggregations" $ withTestEnv $ do
1265 let now = fromGregorian 2015 3 14
1266 let ltAMonthAgo = UTCTime (fromGregorian 2015 3 1) 0
1267 let ltAWeekAgo = UTCTime (fromGregorian 2015 3 10) 0
1268 let oldDoc = exampleTweet { postDate = ltAMonthAgo }
1269 let newDoc = exampleTweet { postDate = ltAWeekAgo }
1270 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings oldDoc (DocId "1")
1271 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings newDoc (DocId "2")
1272 _ <- refreshIndex testIndex
1273 let thisMonth = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMMonth])
1274 let thisWeek = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMWeek])
1275 let agg = DateRangeAggregation (FieldName "postDate") Nothing (thisMonth :| [thisWeek])
1276 let ags = mkAggregations "date_ranges" (DateRangeAgg agg)
1277 let search = mkAggregateSearch Nothing ags
1278 res <- searchTweets search
1279 liftIO $ hitsTotal . searchHits <$> res `shouldBe` Right 2
1280 let bucks = do magrs <- fmapL show (aggregations <$> res)
1281 agrs <- note "no aggregations returned" magrs
1282 rawBucks <- note "no date_ranges aggregation" $ M.lookup "date_ranges" agrs
1283 parseEither parseJSON rawBucks
1284 let fromMonthT = UTCTime (fromGregorian 2015 2 14) 0
1285 let fromWeekT = UTCTime (fromGregorian 2015 3 7) 0
1286 liftIO $ buckets <$> bucks `shouldBe` Right [ DateRangeResult "2015-02-14T00:00:00.000Z-*"
1287 (Just fromMonthT)
1288 (Just "2015-02-14T00:00:00.000Z")
1289 Nothing
1290 Nothing
1292 Nothing
1293 , DateRangeResult "2015-03-07T00:00:00.000Z-*"
1294 (Just fromWeekT)
1295 (Just "2015-03-07T00:00:00.000Z")
1296 Nothing
1297 Nothing
1299 Nothing
1302 it "returns date histogram aggregation results" $ withTestEnv $ do
1303 _ <- insertData
1304 let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
1305 let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
1306 searchExpectAggs search
1307 searchValidBucketAgg search "byDate" toDateHistogram
1309 it "can execute missing aggregations" $ withTestEnv $ do
1310 _ <- insertData
1311 _ <- insertExtra
1312 let ags = mkAggregations "missing_agg" (MissingAgg (MissingAggregation "extra"))
1313 let search = mkAggregateSearch Nothing ags
1314 let docCountPair k n = (k, object ["doc_count" .= Number n])
1315 res <- searchTweets search
1316 liftIO $
1317 fmap aggregations res `shouldBe` Right (Just (M.fromList [docCountPair "missing_agg" 1]))
1319 describe "Highlights API" $ do
1321 it "returns highlight from query when there should be one" $ withTestEnv $ do
1322 _ <- insertData
1323 _ <- insertOther
1324 let query = QueryMatchQuery $ mkMatchQuery (FieldName "message") (QueryString "haskell")
1325 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
1327 let search = mkHighlightSearch (Just query) testHighlight
1328 myHighlight <- searchTweetHighlight search
1329 liftIO $
1330 myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
1332 it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
1333 _ <- insertData
1334 _ <- insertOther
1335 let query = QueryMatchQuery $ mkMatchQuery (FieldName "message") (QueryString "haskell")
1336 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "user") Nothing]
1338 let search = mkHighlightSearch (Just query) testHighlight
1339 myHighlight <- searchTweetHighlight search
1340 liftIO $
1341 myHighlight `shouldBe` Right Nothing
1343 describe "Source filtering" $ do
1345 it "doesn't include source when sources are disabled" $ withTestEnv $ do
1346 searchExpectSource
1347 NoSource
1348 (Left (EsError 500 "Source was missing"))
1350 it "includes a source" $ withTestEnv $ do
1351 searchExpectSource
1352 (SourcePatterns (PopPattern (Pattern "message")))
1353 (Right (Object (HM.fromList [("message", String "Use haskell!")])))
1355 it "includes sources" $ withTestEnv $ do
1356 searchExpectSource
1357 (SourcePatterns (PopPatterns [Pattern "user", Pattern "message"]))
1358 (Right (Object (HM.fromList [("user",String "bitemyapp"),("message", String "Use haskell!")])))
1360 it "includes source patterns" $ withTestEnv $ do
1361 searchExpectSource
1362 (SourcePatterns (PopPattern (Pattern "*ge")))
1363 (Right (Object (HM.fromList [("age", Number 10000),("message", String "Use haskell!")])))
1365 it "excludes source patterns" $ withTestEnv $ do
1366 searchExpectSource
1367 (SourceIncludeExclude (Include [])
1368 (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate", Pattern "extra"]))
1369 (Right (Object (HM.fromList [("user",String "bitemyapp")])))
1371 describe "ToJSON RegexpFlags" $ do
1372 it "generates the correct JSON for AllRegexpFlags" $
1373 toJSON AllRegexpFlags `shouldBe` String "ALL"
1375 it "generates the correct JSON for NoRegexpFlags" $
1376 toJSON NoRegexpFlags `shouldBe` String "NONE"
1378 it "generates the correct JSON for SomeRegexpFlags" $
1379 let flags = AnyString :| [ Automaton
1380 , Complement
1381 , Empty
1382 , Intersection
1383 , Interval ]
1384 in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
1386 prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
1387 let String str = toJSON flags
1388 flagStrs = T.splitOn "|" str
1389 in noDuplicates flagStrs
1391 describe "omitNulls" $ do
1392 it "checks that omitNulls drops list elements when it should" $
1393 let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))
1394 , "test2" .= (toJSON ("some value" :: Text))]
1395 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1397 it "checks that omitNulls doesn't drop list elements when it shouldn't" $
1398 let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))
1399 , "test2" .= (toJSON ("some value" :: Text))]
1400 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))
1401 , ("test2", String "some value")])
1402 it "checks that omitNulls drops non list elements when it should" $
1403 let dropped = omitNulls $ [ "test1" .= (toJSON Null)
1404 , "test2" .= (toJSON ("some value" :: Text))]
1405 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1406 it "checks that omitNulls doesn't drop non list elements when it shouldn't" $
1407 let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
1408 , "test2" .= (toJSON ("some value" :: Text))]
1409 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
1410 , ("test2", String "some value")])
1411 describe "Monoid (SearchHits a)" $ do
1412 prop "abides the monoid laws" $ eq $
1413 prop_Monoid (T :: T (SearchHits ()))
1415 describe "mkDocVersion" $ do
1416 prop "can never construct an out of range docVersion" $ \i ->
1417 let res = mkDocVersion i
1418 in case res of
1419 Nothing -> property True
1420 Just dv -> (dv >= minBound) .&&.
1421 (dv <= maxBound) .&&.
1422 docVersionNumber dv === i
1424 describe "FsSnapshotRepo" $ do
1425 prop "SnapshotRepo laws" $ \fsr ->
1426 fromGSnapshotRepo (toGSnapshotRepo fsr) === Right (fsr :: FsSnapshotRepo)
1428 describe "snapshot repos" $ do
1429 it "always parses all snapshot repos API" $ when' canSnapshot $ withTestEnv $ do
1430 res <- getSnapshotRepos AllSnapshotRepos
1431 liftIO $ case res of
1432 Left e -> expectationFailure ("Expected a right but got Left " <> show e)
1433 Right _ -> return ()
1435 it "finds an existing list of repos" $ when' canSnapshot $ withTestEnv $ do
1436 let r1n = SnapshotRepoName "bloodhound-repo1"
1437 let r2n = SnapshotRepoName "bloodhound-repo2"
1438 withSnapshotRepo r1n $ \r1 ->
1439 withSnapshotRepo r2n $ \r2 -> do
1440 repos <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| [ExactRepo r2n]))
1441 liftIO $ case repos of
1442 Right xs -> do
1443 let srt = L.sortBy (comparing gSnapshotRepoName)
1444 srt xs `shouldBe` srt [r1, r2]
1445 Left e -> expectationFailure (show e)
1447 it "creates and updates with updateSnapshotRepo" $ when' canSnapshot $ withTestEnv $ do
1448 let r1n = SnapshotRepoName "bloodhound-repo1"
1449 withSnapshotRepo r1n $ \r1 -> do
1450 let Just (String dir) = HM.lookup "location" (gSnapshotRepoSettingsObject (gSnapshotRepoSettings r1))
1451 let noCompression = FsSnapshotRepo r1n (T.unpack dir) False Nothing Nothing Nothing
1452 resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings noCompression
1453 liftIO (validateStatus resp 200)
1454 Right [roundtrippedNoCompression] <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| []))
1455 liftIO (roundtrippedNoCompression `shouldBe` toGSnapshotRepo noCompression)
1457 -- verify came around in 1.4 it seems
1458 it "can verify existing repos" $ when' canSnapshot $ when' (atleast es14) $ withTestEnv $ do
1459 let r1n = SnapshotRepoName "bloodhound-repo1"
1460 withSnapshotRepo r1n $ \_ -> do
1461 res <- verifySnapshotRepo r1n
1462 liftIO $ case res of
1463 Right (SnapshotVerification vs)
1464 | null vs -> expectationFailure "Expected nonempty set of verifying nodes"
1465 | otherwise -> return ()
1466 Left e -> expectationFailure (show e)
1468 describe "snapshots" $ do
1469 it "always parses all snapshots API" $ when' canSnapshot $ withTestEnv $ do
1470 let r1n = SnapshotRepoName "bloodhound-repo1"
1471 withSnapshotRepo r1n $ \_ -> do
1472 res <- getSnapshots r1n AllSnapshots
1473 liftIO $ case res of
1474 Left e -> expectationFailure ("Expected a right but got Left " <> show e)
1475 Right _ -> return ()
1477 it "can parse a snapshot that it created" $ when' canSnapshot $ withTestEnv $ do
1478 let r1n = SnapshotRepoName "bloodhound-repo1"
1479 withSnapshotRepo r1n $ \_ -> do
1480 let s1n = SnapshotName "example-snapshot"
1481 withSnapshot r1n s1n $ do
1482 res <- getSnapshots r1n (SnapshotList (ExactSnap s1n :| []))
1483 liftIO $ case res of
1484 Right [snap]
1485 | snapInfoState snap == SnapshotSuccess &&
1486 snapInfoName snap == s1n -> return ()
1487 | otherwise -> expectationFailure (show snap)
1488 Right [] -> expectationFailure "There were no snapshots"
1489 Right snaps -> expectationFailure ("Expected 1 snapshot but got" <> show (length snaps))
1490 Left e -> expectationFailure (show e)
1492 describe "snapshot restore" $ do
1493 it "can restore a snapshot that we create" $ when' canSnapshot $ withTestEnv $ do
1494 let r1n = SnapshotRepoName "bloodhound-repo1"
1495 withSnapshotRepo r1n $ \_ -> do
1496 let s1n = SnapshotName "example-snapshot"
1497 withSnapshot r1n s1n $ do
1498 let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True }
1499 -- have to close an index to restore it
1500 resp1 <- closeIndex testIndex
1501 liftIO (validateStatus resp1 200)
1502 resp2 <- restoreSnapshot r1n s1n settings
1503 liftIO (validateStatus resp2 200)
1505 it "can restore and rename" $ when' canSnapshot $ withTestEnv $ do
1506 let r1n = SnapshotRepoName "bloodhound-repo1"
1507 withSnapshotRepo r1n $ \_ -> do
1508 let s1n = SnapshotName "example-snapshot"
1509 withSnapshot r1n s1n $ do
1510 let pat = RestoreRenamePattern "bloodhound-tests-twitter-(\\d+)"
1511 let replace = RRTLit "restored-" :| [RRSubWholeMatch]
1512 let expectedIndex = IndexName "restored-bloodhound-tests-twitter-1"
1513 oldEnoughForOverrides <- liftIO (atleast es15)
1514 let overrides = RestoreIndexSettings { restoreOverrideReplicas = Just (ReplicaCount 0) }
1515 let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True
1516 , snapRestoreRenamePattern = Just pat
1517 , snapRestoreRenameReplacement = Just replace
1518 , snapRestoreIndexSettingsOverrides = if oldEnoughForOverrides
1519 then Just overrides
1520 else Nothing
1522 -- have to close an index to restore it
1523 let go = do
1524 resp <- restoreSnapshot r1n s1n settings
1525 liftIO (validateStatus resp 200)
1526 exists <- indexExists expectedIndex
1527 liftIO (exists `shouldBe` True)
1528 go `finally` deleteIndex expectedIndex
1530 describe "getNodesInfo" $ do
1531 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
1532 res <- getNodesInfo LocalNode
1533 liftIO $ case res of
1534 -- This is really just a smoke test for response
1535 -- parsing. Node info is so variable, there's not much I can
1536 -- assert here.
1537 Right NodesInfo {..} -> length nodesInfo `shouldBe` 1
1538 Left e -> expectationFailure ("Expected NodesInfo but got " <> show e)
1540 describe "getNodesStats" $ do
1541 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
1542 res <- getNodesStats LocalNode
1543 liftIO $ case res of
1544 -- This is really just a smoke test for response
1545 -- parsing. Node stats is so variable, there's not much I can
1546 -- assert here.
1547 Right NodesStats {..} -> length nodesStats `shouldBe` 1
1548 Left e -> expectationFailure ("Expected NodesStats but got " <> show e)
1550 describe "Enum DocVersion" $ do
1551 it "follows the laws of Enum, Bounded" $ do
1552 evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall
1553 evaluate (pred minBound :: DocVersion) `shouldThrow` anyErrorCall
1554 evaluate (toEnum 0 :: DocVersion) `shouldThrow` anyErrorCall
1555 evaluate (toEnum 9200000000000000001 :: DocVersion) `shouldThrow` anyErrorCall
1556 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1557 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1558 enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]
1560 describe "scan&scroll API" $ do
1561 it "returns documents using the scan&scroll API" $ withTestEnv $ do
1562 _ <- insertData
1563 _ <- insertOther
1564 let search = (mkSearch (Just $ MatchAllQuery Nothing) Nothing) { size = (Size 1) }
1565 regular_search <- searchTweet search
1566 scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet]
1567 let scan_search = map hitSource scan_search'
1568 liftIO $
1569 regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored
1570 liftIO $
1571 scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]
1573 describe "index aliases" $ do
1574 let aname = IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias")
1575 let alias = IndexAlias (testIndex) aname
1576 let create = IndexAliasCreate Nothing Nothing
1577 let action = AddAlias alias create
1578 it "handles the simple case of aliasing an existing index" $ do
1579 withTestEnv $ do
1580 resetIndex
1581 resp <- updateIndexAliases (action :| [])
1582 liftIO $ validateStatus resp 200
1583 let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1584 (do aliases <- withTestEnv getIndexAliases
1585 let expected = IndexAliasSummary alias create
1586 case aliases of
1587 Right (IndexAliasesSummary summs) ->
1588 L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1589 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1590 it "allows alias deletion" $ do
1591 aliases <- withTestEnv $ do
1592 resetIndex
1593 resp <- updateIndexAliases (action :| [])
1594 liftIO $ validateStatus resp 200
1595 deleteIndexAlias aname
1596 getIndexAliases
1597 let expected = IndexAliasSummary alias create
1598 case aliases of
1599 Right (IndexAliasesSummary summs) ->
1600 L.find ((== aname) . indexAlias . indexAliasSummaryAlias) summs `shouldBe` Nothing
1601 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)
1603 describe "Index Listing" $ do
1604 it "returns a list of index names" $ withTestEnv $ do
1605 _ <- createExampleIndex
1606 ixns <- listIndices
1607 liftIO (ixns `shouldContain` [testIndex])
1609 describe "Index Settings" $ do
1610 it "persists settings" $ withTestEnv $ do
1611 _ <- deleteExampleIndex
1612 _ <- createExampleIndex
1613 let updates = BlocksWrite False :| []
1614 updateResp <- updateIndexSettings updates testIndex
1615 liftIO $ validateStatus updateResp 200
1616 getResp <- getIndexSettings testIndex
1617 liftIO $
1618 getResp `shouldBe` Right (IndexSettingsSummary
1619 testIndex
1620 (IndexSettings (ShardCount 1) (ReplicaCount 0))
1621 (NE.toList updates))
1623 it "allows total fields to be set" $ when' (atleast es50) $ withTestEnv $ do
1624 _ <- deleteExampleIndex
1625 _ <- createExampleIndex
1626 let updates = MappingTotalFieldsLimit 2500 :| []
1627 updateResp <- updateIndexSettings updates testIndex
1628 liftIO $ validateStatus updateResp 200
1629 getResp <- getIndexSettings testIndex
1630 liftIO $
1631 getResp `shouldBe` Right (IndexSettingsSummary
1632 testIndex
1633 (IndexSettings (ShardCount 1) (ReplicaCount 0))
1634 (NE.toList updates))
1636 it "accepts customer analyzers" $ when' (atleast es50) $ withTestEnv $ do
1637 _ <- deleteExampleIndex
1638 let analysis = Analysis
1639 (M.singleton "ex_analyzer" (AnalyzerDefinition (Just (Tokenizer "ex_tokenizer"))))
1640 (M.singleton "ex_tokenizer"
1641 ( TokenizerDefinitionNgram
1642 ( Ngram 3 4 [TokenLetter,TokenDigit])
1645 updates = [AnalysisSetting analysis]
1646 createResp <- createIndexWith (updates ++ [NumberOfReplicas (ReplicaCount 0)]) 1 testIndex
1647 liftIO $ validateStatus createResp 200
1648 getResp <- getIndexSettings testIndex
1649 liftIO $
1650 getResp `shouldBe` Right (IndexSettingsSummary
1651 testIndex
1652 (IndexSettings (ShardCount 1) (ReplicaCount 0))
1653 updates
1656 it "accepts default compression codec" $ when' (atleast es50) $ withTestEnv $ do
1657 _ <- deleteExampleIndex
1658 let updates = [CompressionSetting CompressionDefault]
1659 createResp <- createIndexWith (updates ++ [NumberOfReplicas (ReplicaCount 0)]) 1 testIndex
1660 liftIO $ validateStatus createResp 200
1661 getResp <- getIndexSettings testIndex
1662 liftIO $ getResp `shouldBe` Right
1663 (IndexSettingsSummary testIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) updates)
1665 it "accepts best compression codec" $ when' (atleast es50) $ withTestEnv $ do
1666 _ <- deleteExampleIndex
1667 let updates = [CompressionSetting CompressionBest]
1668 createResp <- createIndexWith (updates ++ [NumberOfReplicas (ReplicaCount 0)]) 1 testIndex
1669 liftIO $ validateStatus createResp 200
1670 getResp <- getIndexSettings testIndex
1671 liftIO $ getResp `shouldBe` Right
1672 (IndexSettingsSummary testIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) updates)
1675 describe "Index Optimization" $ do
1676 it "returns a successful response upon completion" $ withTestEnv $ do
1677 _ <- createExampleIndex
1678 resp <- forceMergeIndex (IndexList (testIndex :| [])) defaultForceMergeIndexSettings
1679 liftIO $ validateStatus resp 200
1681 describe "Suggest" $ do
1682 it "returns a search suggestion using the phrase suggester" $ withTestEnv $ do
1683 _ <- insertData
1684 let query = QueryMatchNoneQuery
1685 phraseSuggester = mkPhraseSuggester (FieldName "message")
1686 namedSuggester = Suggest "Use haskel" "suggest_name" (SuggestTypePhraseSuggester phraseSuggester)
1687 search' = mkSearch (Just query) Nothing
1688 search = search' { suggestBody = Just namedSuggester }
1689 expectedText = Just "use haskell"
1690 resp <- searchByIndex testIndex search
1691 parsed <- parseEsResponse resp :: BH IO (Either EsError (SearchResult Tweet))
1692 case parsed of
1693 Left e -> liftIO $ expectationFailure ("Expected an search suggestion but got " <> show e)
1694 Right sr -> liftIO $ (suggestOptionsText . head . suggestResponseOptions . head . nsrResponses <$> suggest sr) `shouldBe` expectedText
1696 describe "JSON instances" $ do
1697 propJSON (Proxy :: Proxy Version)
1698 propJSON (Proxy :: Proxy IndexName)
1699 propJSON (Proxy :: Proxy MappingName)
1700 propJSON (Proxy :: Proxy DocId)
1701 propJSON (Proxy :: Proxy IndexAliasRouting)
1702 propJSON (Proxy :: Proxy RoutingValue)
1703 propJSON (Proxy :: Proxy ShardCount)
1704 propJSON (Proxy :: Proxy ReplicaCount)
1705 propJSON (Proxy :: Proxy TemplateName)
1706 propJSON (Proxy :: Proxy TemplatePattern)
1707 propJSON (Proxy :: Proxy QueryString)
1708 propJSON (Proxy :: Proxy FieldName)
1709 propJSON (Proxy :: Proxy CacheName)
1710 propJSON (Proxy :: Proxy CacheKey)
1711 propJSON (Proxy :: Proxy Existence)
1712 propJSON (Proxy :: Proxy CutoffFrequency)
1713 propJSON (Proxy :: Proxy Analyzer)
1714 propJSON (Proxy :: Proxy MaxExpansions)
1715 propJSON (Proxy :: Proxy Lenient)
1716 propJSON (Proxy :: Proxy Tiebreaker)
1717 propJSON (Proxy :: Proxy Boost)
1718 propJSON (Proxy :: Proxy BoostTerms)
1719 propJSON (Proxy :: Proxy MinimumMatch)
1720 propJSON (Proxy :: Proxy DisableCoord)
1721 propJSON (Proxy :: Proxy IgnoreTermFrequency)
1722 propJSON (Proxy :: Proxy MinimumTermFrequency)
1723 propJSON (Proxy :: Proxy MaxQueryTerms)
1724 propJSON (Proxy :: Proxy Fuzziness)
1725 propJSON (Proxy :: Proxy PrefixLength)
1726 propJSON (Proxy :: Proxy TypeName)
1727 propJSON (Proxy :: Proxy PercentMatch)
1728 propJSON (Proxy :: Proxy StopWord)
1729 propJSON (Proxy :: Proxy QueryPath)
1730 propJSON (Proxy :: Proxy AllowLeadingWildcard)
1731 propJSON (Proxy :: Proxy LowercaseExpanded)
1732 propJSON (Proxy :: Proxy EnablePositionIncrements)
1733 propJSON (Proxy :: Proxy AnalyzeWildcard)
1734 propJSON (Proxy :: Proxy GeneratePhraseQueries)
1735 propJSON (Proxy :: Proxy Locale)
1736 propJSON (Proxy :: Proxy MaxWordLength)
1737 propJSON (Proxy :: Proxy MinWordLength)
1738 propJSON (Proxy :: Proxy PhraseSlop)
1739 propJSON (Proxy :: Proxy MinDocFrequency)
1740 propJSON (Proxy :: Proxy MaxDocFrequency)
1741 propJSON (Proxy :: Proxy Filter)
1742 propJSON (Proxy :: Proxy Query)
1743 propJSON (Proxy :: Proxy SimpleQueryStringQuery)
1744 propJSON (Proxy :: Proxy FieldOrFields)
1745 propJSON (Proxy :: Proxy SimpleQueryFlag)
1746 propJSON (Proxy :: Proxy RegexpQuery)
1747 propJSON (Proxy :: Proxy QueryStringQuery)
1748 propJSON (Proxy :: Proxy RangeQuery)
1749 propJSON (Proxy :: Proxy PrefixQuery)
1750 propJSON (Proxy :: Proxy NestedQuery)
1751 propJSON (Proxy :: Proxy MoreLikeThisFieldQuery)
1752 propJSON (Proxy :: Proxy MoreLikeThisQuery)
1753 propJSON (Proxy :: Proxy IndicesQuery)
1754 propJSON (Proxy :: Proxy HasParentQuery)
1755 propJSON (Proxy :: Proxy HasChildQuery)
1756 propJSON (Proxy :: Proxy FuzzyQuery)
1757 propJSON (Proxy :: Proxy FuzzyLikeFieldQuery)
1758 propJSON (Proxy :: Proxy FuzzyLikeThisQuery)
1759 propJSON (Proxy :: Proxy DisMaxQuery)
1760 propJSON (Proxy :: Proxy CommonTermsQuery)
1761 propJSON (Proxy :: Proxy CommonMinimumMatch)
1762 propJSON (Proxy :: Proxy BoostingQuery)
1763 propJSON (Proxy :: Proxy BoolQuery)
1764 propJSON (Proxy :: Proxy MatchQuery)
1765 propJSON (Proxy :: Proxy MultiMatchQueryType)
1766 propJSON (Proxy :: Proxy BooleanOperator)
1767 propJSON (Proxy :: Proxy ZeroTermsQuery)
1768 propJSON (Proxy :: Proxy MatchQueryType)
1769 propJSON (Proxy :: Proxy AliasRouting)
1770 propJSON (Proxy :: Proxy IndexAliasCreate)
1771 propJSON (Proxy :: Proxy SearchAliasRouting)
1772 propJSON (Proxy :: Proxy ScoreType)
1773 propJSON (Proxy :: Proxy Distance)
1774 propJSON (Proxy :: Proxy DistanceUnit)
1775 propJSON (Proxy :: Proxy DistanceType)
1776 propJSON (Proxy :: Proxy OptimizeBbox)
1777 propJSON (Proxy :: Proxy GeoBoundingBoxConstraint)
1778 propJSON (Proxy :: Proxy GeoFilterType)
1779 propJSON (Proxy :: Proxy GeoBoundingBox)
1780 propJSON (Proxy :: Proxy LatLon)
1781 propJSON (Proxy :: Proxy RangeExecution)
1782 prop "RegexpFlags FromJSON/ToJSON roundtrips, removing dups " $ \rfs ->
1783 let expected = case rfs of
1784 SomeRegexpFlags fs -> SomeRegexpFlags (NE.fromList (nub (NE.toList fs)))
1785 x -> x
1786 in parseEither parseJSON (toJSON rfs) === Right expected
1787 propJSON (Proxy :: Proxy BoolMatch)
1788 propJSON (Proxy :: Proxy Term)
1789 propJSON (Proxy :: Proxy MultiMatchQuery)
1790 propJSON (Proxy :: Proxy IndexSettings)
1791 propJSON (Proxy :: Proxy UpdatableIndexSetting')
1792 propJSON (Proxy :: Proxy ReplicaBounds)
1793 propJSON (Proxy :: Proxy Bytes)
1794 propJSON (Proxy :: Proxy AllocationPolicy)
1795 propJSON (Proxy :: Proxy InitialShardCount)
1796 propJSON (Proxy :: Proxy FSType)
1797 propJSON (Proxy :: Proxy CompoundFormat)
1798 propJSON (Proxy :: Proxy TemplateQueryInline)
1799 propJSON (Proxy :: Proxy Suggest)
1800 propJSON (Proxy :: Proxy DirectGenerators)
1801 propJSON (Proxy :: Proxy DirectGeneratorSuggestModeTypes)
1803-- Temporary solution for lacking of generic derivation of Arbitrary
1804-- We use generics-sop, as it's much more concise than directly using GHC.Generics
1806-- This will be unneeded after https://github.com/nick8325/quickcheck/pull/112
1807-- is merged and released
1808sopArbitrary :: forall a. (Generic a, SOP.GTo a, SOP.All SOP.SListI (SOP.GCode a), SOP.All2 Arbitrary (SOP.GCode a)) => Gen a
1809sopArbitrary = fmap SOP.gto sopArbitrary'
1811sopArbitrary' :: forall xss. (SOP.All SOP.SListI xss, SOP.All2 Arbitrary xss) => Gen (SOP.SOP SOP.I xss)
1812sopArbitrary' = SOP.hsequence =<< elements (SOP.apInjs_POP $ SOP.hcpure p arbitrary)
1813 where
1814 p :: Proxy Arbitrary
1815 p = Proxy