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