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