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