git.iko.soy/typeable/bloodhound
on 9092939 help sign in
1949 lines 90 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.V1.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] []
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 -- Serializing the date as a date is breaking other tests, mysteriously.
190 -- , "postDate" .= object [ "type" .= ("date" :: Text)
191 -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
192 , "message" .= object ["type" .= ("string" :: Text)]
193 , "age" .= object ["type" .= ("integer" :: Text)]
194 , "location" .= object ["type" .= ("geo_point" :: Text)]
195 ]]
197data ChildMapping = ChildMapping deriving (Eq, Show)
199instance ToJSON ChildMapping where
200 toJSON ChildMapping =
201 object ["_parent" .= object ["type" .= ("parent" :: Text)]
202 , "properties" .=
203 object [ "user" .= object ["type" .= ("string" :: Text)]
204 -- Serializing the date as a date is breaking other tests, mysteriously.
205 -- , "postDate" .= object [ "type" .= ("date" :: Text)
206 -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
207 , "message" .= object ["type" .= ("string" :: Text)]
208 , "age" .= object ["type" .= ("integer" :: Text)]
209 , "location" .= object ["type" .= ("geo_point" :: Text)]
210 ]]
212data TweetMapping = TweetMapping deriving (Eq, Show)
214instance ToJSON TweetMapping where
215 toJSON TweetMapping =
216 object ["properties" .=
217 object [ "user" .= object ["type" .= ("string" :: Text)]
218 -- Serializing the date as a date is breaking other tests, mysteriously.
219 -- , "postDate" .= object [ "type" .= ("date" :: Text)
220 -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
221 , "message" .= object ["type" .= ("string" :: Text)]
222 , "age" .= object ["type" .= ("integer" :: Text)]
223 , "location" .= object ["type" .= ("geo_point" :: Text)]
224 ]]
226exampleTweet :: Tweet
227exampleTweet = Tweet { user = "bitemyapp"
228 , postDate = UTCTime
229 (ModifiedJulianDay 55000)
230 (secondsToDiffTime 10)
231 , message = "Use haskell!"
232 , age = 10000
233 , location = Location 40.12 (-71.34)
234 , extra = Nothing }
236tweetWithExtra :: Tweet
237tweetWithExtra = 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 = Just "blah blah" }
246newAge :: Int
247newAge = 31337
249newUser :: Text
250newUser = "someotherapp"
252tweetPatch :: Value
253tweetPatch =
254 object [ "age" .= newAge
255 , "user" .= newUser
256 ]
258patchedTweet :: Tweet
259patchedTweet = exampleTweet{age = newAge, user = newUser}
261otherTweet :: Tweet
262otherTweet = Tweet { user = "notmyapp"
263 , postDate = UTCTime
264 (ModifiedJulianDay 55000)
265 (secondsToDiffTime 11)
266 , message = "Use haskell!"
267 , age = 1000
268 , location = Location 40.12 (-71.34)
269 , extra = Nothing }
271resetIndex :: BH IO ()
272resetIndex = do
273 _ <- deleteExampleIndex
274 _ <- createExampleIndex
275 _ <- putMapping testIndex testMapping TweetMapping
276 return ()
278insertData :: BH IO Reply
279insertData = do
280 resetIndex
281 insertData' defaultIndexDocumentSettings
283insertData' :: IndexDocumentSettings -> BH IO Reply
284insertData' ids = do
285 r <- indexDocument testIndex testMapping ids exampleTweet (DocId "1")
286 _ <- refreshIndex testIndex
287 return r
289updateData :: BH IO Reply
290updateData = do
291 r <- updateDocument testIndex testMapping defaultIndexDocumentSettings tweetPatch (DocId "1")
292 _ <- refreshIndex testIndex
293 return r
295insertOther :: BH IO ()
296insertOther = do
297 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings otherTweet (DocId "2")
298 _ <- refreshIndex testIndex
299 return ()
301insertExtra :: BH IO ()
302insertExtra = do
303 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings tweetWithExtra (DocId "4")
304 _ <- refreshIndex testIndex
305 return ()
307insertWithSpaceInId :: BH IO ()
308insertWithSpaceInId = do
309 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "Hello World")
310 _ <- refreshIndex testIndex
311 return ()
313searchTweet :: Search -> BH IO (Either EsError Tweet)
314searchTweet search = do
315 result <- searchTweets search
316 let myTweet :: Either EsError Tweet
317 myTweet = grabFirst result
318 return myTweet
320searchTweets :: Search -> BH IO (Either EsError (SearchResult Tweet))
321searchTweets search = parseEsResponse =<< searchByIndex testIndex search
323searchExpectNoResults :: Search -> BH IO ()
324searchExpectNoResults search = do
325 result <- searchTweets search
326 let emptyHits = fmap (hits . searchHits) result
327 liftIO $
328 emptyHits `shouldBe` Right []
330searchExpectAggs :: Search -> BH IO ()
331searchExpectAggs search = do
332 reply <- searchByIndex testIndex search
333 let isEmpty x = return (M.null x)
334 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
335 liftIO $
336 (result >>= aggregations >>= isEmpty) `shouldBe` Just False
338searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) =>
339 Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> BH IO ()
340searchValidBucketAgg search aggKey extractor = do
341 reply <- searchByIndex testIndex search
342 let bucketDocs = docCount . head . buckets
343 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
344 let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)
345 liftIO $
346 count `shouldBe` Just 1
348searchTermsAggHint :: [ExecutionHint] -> BH IO ()
349searchTermsAggHint hints = do
350 let terms hint = TermsAgg $ (mkTermsAggregation "user") { termExecutionHint = Just hint }
351 let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint
352 forM_ hints $ searchExpectAggs . search
353 forM_ hints (\x -> searchValidBucketAgg (search x) "users" toTerms)
355searchTweetHighlight :: Search -> BH IO (Either EsError (Maybe HitHighlight))
356searchTweetHighlight search = do
357 result <- searchTweets search
358 let myHighlight = fmap (hitHighlight . head . hits . searchHits) result
359 return myHighlight
361searchExpectSource :: Source -> Either EsError Value -> BH IO ()
362searchExpectSource src expected = do
363 _ <- insertData
364 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
365 let search = (mkSearch (Just query) Nothing) { source = Just src }
366 reply <- searchByIndex testIndex search
367 result <- parseEsResponse reply
368 let value = grabFirst result
369 liftIO $
370 value `shouldBe` expected
372withSnapshotRepo
373 :: ( MonadMask m
374 , MonadBH m
375 )
376 => SnapshotRepoName
377 -> (GenericSnapshotRepo -> m a)
378 -> m a
379withSnapshotRepo srn@(SnapshotRepoName n) f = do
380 repoPaths <- liftIO getRepoPaths
381 -- we'll use the first repo path if available, otherwise system temp
382 -- dir. Note that this will fail on ES > 1.6, so be sure you use
383 -- @when' canSnapshot@.
384 case repoPaths of
385 (firstRepoPath:_) -> withTempDirectory firstRepoPath (T.unpack n) $ \dir -> bracket (alloc dir) free f
386 [] -> withSystemTempDirectory (T.unpack n) $ \dir -> bracket (alloc dir) free f
387 where
388 alloc dir = do
389 liftIO (setFileMode dir mode)
390 let repo = FsSnapshotRepo srn "bloodhound-tests-backups" True Nothing Nothing Nothing
391 resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings repo
392 liftIO (validateStatus resp 200)
393 return (toGSnapshotRepo repo)
394 mode = ownerModes `unionFileModes` groupModes `unionFileModes` otherModes
395 free GenericSnapshotRepo {..} = do
396 resp <- deleteSnapshotRepo gSnapshotRepoName
397 liftIO (validateStatus resp 200)
400withSnapshot
401 :: ( MonadMask m
402 , MonadBH m
403 )
404 => SnapshotRepoName
405 -> SnapshotName
406 -> m a
407 -> m a
408withSnapshot srn sn = bracket_ alloc free
409 where
410 alloc = do
411 resp <- createSnapshot srn sn createSettings
412 liftIO (validateStatus resp 200)
413 -- We'll make this synchronous for testing purposes
414 createSettings = defaultSnapshotCreateSettings { snapWaitForCompletion = True
415 , snapIndices = Just (IndexList (testIndex :| []))
416 -- We don't actually need to back up any data
417 }
418 free = do
419 deleteSnapshot srn sn
423data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
424instance FromJSON BulkTest where
425 parseJSON = genericParseJSON defaultOptions
426instance ToJSON BulkTest where
427 toJSON = genericToJSON defaultOptions
429class GApproxEq f where
430 gApproxEq :: f a -> f a -> Bool
432-- | Unit type
433instance GApproxEq U1 where
434 gApproxEq U1 U1 = True
436-- | Sum type, ensure same constructors, recurse
437instance (GApproxEq a, GApproxEq b) => GApproxEq (a :+: b) where
438 gApproxEq (L1 a) (L1 b) = gApproxEq a b
439 gApproxEq (R1 a) (R1 b) = gApproxEq a b
440 gApproxEq _ _ = False
442-- | Product type, ensure each field is approx eq
443instance (GApproxEq a, GApproxEq b) => GApproxEq (a :*: b) where
444 gApproxEq (a1 :*: b1) (a2 :*: b2) = gApproxEq a1 a2 && gApproxEq b1 b2
446-- | Value type, actually check the values for approx equality
447instance (ApproxEq a) => GApproxEq (K1 i a) where
448 gApproxEq (K1 a) (K1 b) = a =~ b
450instance (GApproxEq f) => GApproxEq (M1 i t f) where
451 gApproxEq (M1 a) (M1 b) = gApproxEq a b
453-- | Typeclass for "equal where it matters". Use this to specify
454-- less-strict equivalence for things such as lists that can wind up
455-- in an unpredictable order
456class ApproxEq a where
457 (=~) :: a -> a -> Bool
458 default (=~) :: (Generic a, GApproxEq (Rep a)) => a -> a -> Bool
459 a =~ b = gApproxEq (G.from a) (G.from b)
461 showApproxEq :: a -> String
462 default showApproxEq :: (Show a) => a -> String
463 showApproxEq = show
465instance ApproxEq NominalDiffTime where (=~) = (==)
466instance ApproxEq UTCTime where (=~) = (==)
467instance ApproxEq Text where (=~) = (==)
468instance ApproxEq Bool where (=~) = (==)
469instance ApproxEq Int where (=~) = (==)
470instance ApproxEq Double where (=~) = (==)
471instance (ApproxEq a, Show a) => ApproxEq (NonEmpty a)
472instance (ApproxEq a, Show a) => ApproxEq (Maybe a)
473instance ApproxEq GeoPoint
474instance ApproxEq Regexp
475instance ApproxEq RangeValue
476instance ApproxEq LessThan
477instance ApproxEq LessThanEq
478instance ApproxEq LessThanD
479instance ApproxEq LessThanEqD
480instance ApproxEq GreaterThan
481instance ApproxEq GreaterThanEq
482instance ApproxEq GreaterThanD
483instance ApproxEq GreaterThanEqD
484instance ApproxEq MinimumMatchHighLow
485instance ApproxEq RegexpFlag
486instance ApproxEq RegexpFlags
487instance ApproxEq NullValue
488instance ApproxEq Version
489instance ApproxEq VersionNumber
490instance ApproxEq DistanceRange
491instance ApproxEq IndexName
492instance ApproxEq MappingName
493instance ApproxEq DocId
494instance ApproxEq IndexAliasRouting
495instance ApproxEq RoutingValue
496instance ApproxEq ShardCount
497instance ApproxEq ReplicaCount
498instance ApproxEq TemplateName
499instance ApproxEq TemplatePattern
500instance ApproxEq QueryString
501instance ApproxEq FieldName
502instance ApproxEq CacheName
503instance ApproxEq CacheKey
504instance ApproxEq Existence
505instance ApproxEq CutoffFrequency
506instance ApproxEq Analyzer
507instance ApproxEq Lenient
508instance ApproxEq Tiebreaker
509instance ApproxEq Boost
510instance ApproxEq BoostTerms
511instance ApproxEq MaxExpansions
512instance ApproxEq MinimumMatch
513instance ApproxEq DisableCoord
514instance ApproxEq IgnoreTermFrequency
515instance ApproxEq MinimumTermFrequency
516instance ApproxEq MaxQueryTerms
517instance ApproxEq Fuzziness
518instance ApproxEq PrefixLength
519instance ApproxEq TypeName
520instance ApproxEq PercentMatch
521instance ApproxEq StopWord
522instance ApproxEq QueryPath
523instance ApproxEq AllowLeadingWildcard
524instance ApproxEq LowercaseExpanded
525instance ApproxEq EnablePositionIncrements
526instance ApproxEq AnalyzeWildcard
527instance ApproxEq GeneratePhraseQueries
528instance ApproxEq Locale
529instance ApproxEq MaxWordLength
530instance ApproxEq MinWordLength
531instance ApproxEq PhraseSlop
532instance ApproxEq MinDocFrequency
533instance ApproxEq MaxDocFrequency
534instance ApproxEq Filter
535instance ApproxEq Query
536instance ApproxEq SimpleQueryStringQuery
537instance ApproxEq FieldOrFields
538instance ApproxEq SimpleQueryFlag
539instance ApproxEq RegexpQuery
540instance ApproxEq QueryStringQuery
541instance ApproxEq RangeQuery
542instance ApproxEq PrefixQuery
543instance ApproxEq NestedQuery
544instance ApproxEq MoreLikeThisFieldQuery
545instance ApproxEq MoreLikeThisQuery
546instance ApproxEq IndicesQuery
547instance ApproxEq HasParentQuery
548instance ApproxEq HasChildQuery
549instance ApproxEq FuzzyQuery
550instance ApproxEq FuzzyLikeFieldQuery
551instance ApproxEq FuzzyLikeThisQuery
552instance ApproxEq FilteredQuery
553instance ApproxEq DisMaxQuery
554instance ApproxEq CommonTermsQuery
555instance ApproxEq CommonMinimumMatch
556instance ApproxEq BoostingQuery
557instance ApproxEq BoolQuery
558instance ApproxEq MatchQuery
559instance ApproxEq MultiMatchQueryType
560instance ApproxEq BooleanOperator
561instance ApproxEq ZeroTermsQuery
562instance ApproxEq MatchQueryType
563instance ApproxEq AliasRouting
564instance ApproxEq IndexAliasCreate
565instance ApproxEq SearchAliasRouting
566instance ApproxEq ScoreType
567instance ApproxEq Distance
568instance ApproxEq DistanceUnit
569instance ApproxEq DistanceType
570instance ApproxEq OptimizeBbox
571instance ApproxEq GeoBoundingBoxConstraint
572instance ApproxEq GeoFilterType
573instance ApproxEq GeoBoundingBox
574instance ApproxEq LatLon
575instance ApproxEq RangeExecution
576instance ApproxEq FSType
577instance ApproxEq CompoundFormat
578instance ApproxEq InitialShardCount
579instance ApproxEq Bytes
580instance ApproxEq ReplicaBounds
581instance ApproxEq Term
582instance ApproxEq BoolMatch
583instance ApproxEq MultiMatchQuery
584instance ApproxEq IndexSettings
585instance ApproxEq AllocationPolicy
586instance ApproxEq Char where
587 (=~) = (==)
588instance ApproxEq Vers.Version where
589 (=~) = (==)
590instance (ApproxEq a, Show a) => ApproxEq [a] where
591 as =~ bs = and (zipWith (=~) as bs)
592instance (ApproxEq l, ApproxEq r) => ApproxEq (Either l r) where
593 Left a =~ Left b = a =~ b
594 Right a =~ Right b = a =~ b
595 _ =~ _ = False
596 showApproxEq (Left x) = "Left " <> showApproxEq x
597 showApproxEq (Right x) = "Right " <> showApproxEq x
598instance ApproxEq NodeAttrFilter
599instance ApproxEq NodeAttrName
600instance ApproxEq BuildHash
601instance ApproxEq TemplateQueryKeyValuePairs where
602 (=~) = (==)
603instance ApproxEq TemplateQueryInline
604instance ApproxEq Size
605instance ApproxEq PhraseSuggesterHighlighter
606instance ApproxEq PhraseSuggesterCollate
607instance ApproxEq PhraseSuggester
608instance ApproxEq SuggestType
609instance ApproxEq Suggest
611-- | Due to the way nodeattrfilters get serialized here, they may come
612-- out in a different order, but they are morally equivalent
613instance ApproxEq UpdatableIndexSetting where
614 RoutingAllocationInclude a =~ RoutingAllocationInclude b =
615 NE.sort a =~ NE.sort b
616 RoutingAllocationExclude a =~ RoutingAllocationExclude b =
617 NE.sort a =~ NE.sort b
618 RoutingAllocationRequire a =~ RoutingAllocationRequire b =
619 NE.sort a =~ NE.sort b
620 a =~ b = a == b
621 showApproxEq (RoutingAllocationInclude xs) = show (RoutingAllocationInclude (NE.sort xs))
622 showApproxEq (RoutingAllocationExclude xs) = show (RoutingAllocationExclude (NE.sort xs))
623 showApproxEq (RoutingAllocationRequire xs) = show (RoutingAllocationRequire (NE.sort xs))
624 showApproxEq x = show x
627noDuplicates :: Eq a => [a] -> Bool
628noDuplicates xs = nub xs == xs
630instance Arbitrary NominalDiffTime where
631 arbitrary = fromInteger <$> arbitrary
633#if !MIN_VERSION_QuickCheck(2,8,0)
634instance (Arbitrary k, Ord k, Arbitrary v) => Arbitrary (M.Map k v) where
635 arbitrary = M.fromList <$> arbitrary
636#endif
638instance Arbitrary Text where
639 arbitrary = T.pack <$> arbitrary
641instance Arbitrary UTCTime where
642 arbitrary = UTCTime
643 <$> arbitrary
644 <*> (fromRational . toRational <$> choose (0::Double, 86400))
646instance Arbitrary Day where
647 arbitrary = ModifiedJulianDay <$> (2000 +) <$> arbitrary
648 shrink = (ModifiedJulianDay <$>) . shrink . toModifiedJulianDay
650#if !MIN_VERSION_QuickCheck(2,9,0)
651instance Arbitrary a => Arbitrary (NonEmpty a) where
652 arbitrary = liftA2 (:|) arbitrary arbitrary
653#endif
655arbitraryScore :: Gen Score
656arbitraryScore = fmap getPositive <$> arbitrary
658instance (Arbitrary a, Typeable a) => Arbitrary (Hit a) where
659 arbitrary = Hit <$> arbitrary
660 <*> arbitrary
661 <*> arbitrary
662 <*> arbitraryScore
663 <*> arbitrary
664 <*> arbitrary
665 shrink = genericShrink
668instance (Arbitrary a, Typeable a) => Arbitrary (SearchHits a) where
669 arbitrary = reduceSize $ do
670 tot <- getPositive <$> arbitrary
671 score <- arbitraryScore
672 hs <- arbitrary
673 return $ SearchHits tot score hs
674 shrink = genericShrink
676reduceSize :: Gen a -> Gen a
677reduceSize f = sized $ \n -> resize (n `div` 2) f
679getSource :: EsResult a -> Maybe a
680getSource = fmap _source . foundResult
682grabFirst :: Either EsError (SearchResult a) -> Either EsError a
683grabFirst r =
684 case fmap (hitSource . head . hits . searchHits) r of
685 (Left e) -> Left e
686 (Right Nothing) -> Left (EsError 500 "Source was missing")
687 (Right (Just x)) -> Right x
689-------------------------------------------------------------------------------
690arbitraryAlphaNum :: Gen Char
691arbitraryAlphaNum = oneof [choose ('a', 'z')
692 ,choose ('A','Z')
693 , choose ('0', '9')]
695instance Arbitrary RoutingValue where
696 arbitrary = RoutingValue . T.pack <$> listOf1 arbitraryAlphaNum
698instance Arbitrary AliasRouting where
699 arbitrary = oneof [allAlias
700 ,one
701 ,theOther
702 ,both]
703 where one = GranularAliasRouting
704 <$> (Just <$> arbitrary)
705 <*> pure Nothing
706 theOther = GranularAliasRouting Nothing
707 <$> (Just <$> arbitrary)
708 both = GranularAliasRouting
709 <$> (Just <$> arbitrary)
710 <*> (Just <$> arbitrary)
711 allAlias = AllAliasRouting <$> arbitrary
712 shrink = genericShrink
715instance Arbitrary FieldName where
716 arbitrary = FieldName . T.pack <$> listOf1 arbitraryAlphaNum
717 shrink = genericShrink
720instance Arbitrary RegexpFlags where
721 arbitrary = oneof [ pure AllRegexpFlags
722 , pure NoRegexpFlags
723 , SomeRegexpFlags <$> genUniqueFlags
724 ]
725 where genUniqueFlags = NE.fromList . nub <$> listOf1 arbitrary
726 shrink = genericShrink
729instance Arbitrary IndexAliasCreate where
730 arbitrary = IndexAliasCreate <$> arbitrary <*> reduceSize arbitrary
731 shrink = genericShrink
733instance Arbitrary Query where
734 arbitrary = reduceSize $ oneof [ TermQuery <$> arbitrary <*> arbitrary
735 , TermsQuery <$> arbitrary <*> arbitrary
736 , QueryMatchQuery <$> arbitrary
737 , QueryMultiMatchQuery <$> arbitrary
738 , QueryBoolQuery <$> arbitrary
739 , QueryBoostingQuery <$> arbitrary
740 , QueryCommonTermsQuery <$> arbitrary
741 , ConstantScoreFilter <$> arbitrary <*> arbitrary
742 , ConstantScoreQuery <$> arbitrary <*> arbitrary
743 , QueryDisMaxQuery <$> arbitrary
744 , QueryFilteredQuery <$> arbitrary
745 , QueryFuzzyLikeThisQuery <$> arbitrary
746 , QueryFuzzyLikeFieldQuery <$> arbitrary
747 , QueryFuzzyQuery <$> arbitrary
748 , QueryHasChildQuery <$> arbitrary
749 , QueryHasParentQuery <$> arbitrary
750 , IdsQuery <$> arbitrary <*> arbitrary
751 , QueryIndicesQuery <$> arbitrary
752 , MatchAllQuery <$> arbitrary
753 , QueryMoreLikeThisQuery <$> arbitrary
754 , QueryMoreLikeThisFieldQuery <$> arbitrary
755 , QueryNestedQuery <$> arbitrary
756 , QueryPrefixQuery <$> arbitrary
757 , QueryQueryStringQuery <$> arbitrary
758 , QuerySimpleQueryStringQuery <$> arbitrary
759 , QueryRangeQuery <$> arbitrary
760 , QueryRegexpQuery <$> arbitrary
761 , QueryTemplateQueryInline <$> arbitrary
762 ]
763 shrink = genericShrink
765instance Arbitrary Filter where
766 arbitrary = reduceSize $ oneof [ AndFilter <$> arbitrary <*> arbitrary
767 , OrFilter <$> arbitrary <*> arbitrary
768 , NotFilter <$> arbitrary <*> arbitrary
769 , pure IdentityFilter
770 , BoolFilter <$> arbitrary
771 , ExistsFilter <$> arbitrary
772 , GeoBoundingBoxFilter <$> arbitrary
773 , GeoDistanceFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
774 , GeoDistanceRangeFilter <$> arbitrary <*> arbitrary
775 , GeoPolygonFilter <$> arbitrary <*> arbitrary
776 , IdsFilter <$> arbitrary <*> arbitrary
777 , LimitFilter <$> arbitrary
778 , MissingFilter <$> arbitrary <*> arbitrary <*> arbitrary
779 , PrefixFilter <$> arbitrary <*> arbitrary <*> arbitrary
780 , QueryFilter <$> arbitrary <*> arbitrary
781 , RangeFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
782 , RegexpFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
783 , TermFilter <$> arbitrary <*> arbitrary]
784 shrink = genericShrink
786instance Arbitrary ReplicaBounds where
787 arbitrary = oneof [ replicasBounded
788 , replicasLowerBounded
789 , pure ReplicasUnbounded
790 ]
791 where replicasBounded = do Positive a <- arbitrary
792 Positive b <- arbitrary
793 return (ReplicasBounded a b)
794 replicasLowerBounded = do Positive a <- arbitrary
795 return (ReplicasLowerBounded a)
797instance Arbitrary NodeAttrName where
798 arbitrary = NodeAttrName . T.pack <$> listOf1 arbitraryAlphaNum
801instance Arbitrary NodeAttrFilter where
802 arbitrary = do
803 n <- arbitrary
804 s:ss <- listOf1 (listOf1 arbitraryAlphaNum)
805 let ts = T.pack <$> s :| ss
806 return (NodeAttrFilter n ts)
807 shrink = genericShrink
809instance Arbitrary VersionNumber where
810 arbitrary = mk . fmap getPositive . getNonEmpty <$> arbitrary
811 where
812 mk versions = VersionNumber (Vers.Version versions [])
814instance Arbitrary TemplateQueryKeyValuePairs where
815 arbitrary = TemplateQueryKeyValuePairs . HM.fromList <$> arbitrary
816 shrink (TemplateQueryKeyValuePairs x) = map (TemplateQueryKeyValuePairs . HM.fromList) . shrink $ HM.toList x
818instance Arbitrary IndexName where arbitrary = sopArbitrary; shrink = genericShrink
819instance Arbitrary MappingName where arbitrary = sopArbitrary; shrink = genericShrink
820instance Arbitrary DocId where arbitrary = sopArbitrary; shrink = genericShrink
821instance Arbitrary Version where arbitrary = sopArbitrary; shrink = genericShrink
822instance Arbitrary BuildHash where arbitrary = sopArbitrary; shrink = genericShrink
823instance Arbitrary IndexAliasRouting where arbitrary = sopArbitrary; shrink = genericShrink
824instance Arbitrary ShardCount where arbitrary = sopArbitrary; shrink = genericShrink
825instance Arbitrary ReplicaCount where arbitrary = sopArbitrary; shrink = genericShrink
826instance Arbitrary TemplateName where arbitrary = sopArbitrary; shrink = genericShrink
827instance Arbitrary TemplatePattern where arbitrary = sopArbitrary; shrink = genericShrink
828instance Arbitrary QueryString where arbitrary = sopArbitrary; shrink = genericShrink
829instance Arbitrary CacheName where arbitrary = sopArbitrary; shrink = genericShrink
830instance Arbitrary CacheKey where arbitrary = sopArbitrary; shrink = genericShrink
831instance Arbitrary Existence where arbitrary = sopArbitrary; shrink = genericShrink
832instance Arbitrary CutoffFrequency where arbitrary = sopArbitrary; shrink = genericShrink
833instance Arbitrary Analyzer where arbitrary = sopArbitrary; shrink = genericShrink
834instance Arbitrary MaxExpansions where arbitrary = sopArbitrary; shrink = genericShrink
835instance Arbitrary Lenient where arbitrary = sopArbitrary; shrink = genericShrink
836instance Arbitrary Tiebreaker where arbitrary = sopArbitrary; shrink = genericShrink
837instance Arbitrary Boost where arbitrary = sopArbitrary; shrink = genericShrink
838instance Arbitrary BoostTerms where arbitrary = sopArbitrary; shrink = genericShrink
839instance Arbitrary MinimumMatch where arbitrary = sopArbitrary; shrink = genericShrink
840instance Arbitrary DisableCoord where arbitrary = sopArbitrary; shrink = genericShrink
841instance Arbitrary IgnoreTermFrequency where arbitrary = sopArbitrary; shrink = genericShrink
842instance Arbitrary MinimumTermFrequency where arbitrary = sopArbitrary; shrink = genericShrink
843instance Arbitrary MaxQueryTerms where arbitrary = sopArbitrary; shrink = genericShrink
844instance Arbitrary Fuzziness where arbitrary = sopArbitrary; shrink = genericShrink
845instance Arbitrary PrefixLength where arbitrary = sopArbitrary; shrink = genericShrink
846instance Arbitrary TypeName where arbitrary = sopArbitrary; shrink = genericShrink
847instance Arbitrary PercentMatch where arbitrary = sopArbitrary; shrink = genericShrink
848instance Arbitrary StopWord where arbitrary = sopArbitrary; shrink = genericShrink
849instance Arbitrary QueryPath where arbitrary = sopArbitrary; shrink = genericShrink
850instance Arbitrary AllowLeadingWildcard where arbitrary = sopArbitrary; shrink = genericShrink
851instance Arbitrary LowercaseExpanded where arbitrary = sopArbitrary; shrink = genericShrink
852instance Arbitrary EnablePositionIncrements where arbitrary = sopArbitrary; shrink = genericShrink
853instance Arbitrary AnalyzeWildcard where arbitrary = sopArbitrary; shrink = genericShrink
854instance Arbitrary GeneratePhraseQueries where arbitrary = sopArbitrary; shrink = genericShrink
855instance Arbitrary Locale where arbitrary = sopArbitrary; shrink = genericShrink
856instance Arbitrary MaxWordLength where arbitrary = sopArbitrary; shrink = genericShrink
857instance Arbitrary MinWordLength where arbitrary = sopArbitrary; shrink = genericShrink
858instance Arbitrary PhraseSlop where arbitrary = sopArbitrary; shrink = genericShrink
859instance Arbitrary MinDocFrequency where arbitrary = sopArbitrary; shrink = genericShrink
860instance Arbitrary MaxDocFrequency where arbitrary = sopArbitrary; shrink = genericShrink
861instance Arbitrary Regexp where arbitrary = sopArbitrary; shrink = genericShrink
862instance Arbitrary SimpleQueryStringQuery where arbitrary = sopArbitrary; shrink = genericShrink
863instance Arbitrary FieldOrFields where arbitrary = sopArbitrary; shrink = genericShrink
864instance Arbitrary SimpleQueryFlag where arbitrary = sopArbitrary; shrink = genericShrink
865instance Arbitrary RegexpQuery where arbitrary = sopArbitrary; shrink = genericShrink
866instance Arbitrary QueryStringQuery where arbitrary = sopArbitrary; shrink = genericShrink
867instance Arbitrary RangeQuery where arbitrary = sopArbitrary; shrink = genericShrink
868instance Arbitrary RangeValue where arbitrary = sopArbitrary; shrink = genericShrink
869instance Arbitrary PrefixQuery where arbitrary = sopArbitrary; shrink = genericShrink
870instance Arbitrary NestedQuery where arbitrary = sopArbitrary; shrink = genericShrink
871instance Arbitrary MoreLikeThisFieldQuery where arbitrary = sopArbitrary; shrink = genericShrink
872instance Arbitrary MoreLikeThisQuery where arbitrary = sopArbitrary; shrink = genericShrink
873instance Arbitrary IndicesQuery where arbitrary = sopArbitrary; shrink = genericShrink
874instance Arbitrary HasParentQuery where arbitrary = sopArbitrary; shrink = genericShrink
875instance Arbitrary HasChildQuery where arbitrary = sopArbitrary; shrink = genericShrink
876instance Arbitrary FuzzyQuery where arbitrary = sopArbitrary; shrink = genericShrink
877instance Arbitrary FuzzyLikeFieldQuery where arbitrary = sopArbitrary; shrink = genericShrink
878instance Arbitrary FuzzyLikeThisQuery where arbitrary = sopArbitrary; shrink = genericShrink
879instance Arbitrary FilteredQuery where arbitrary = sopArbitrary; shrink = genericShrink
880instance Arbitrary DisMaxQuery where arbitrary = sopArbitrary; shrink = genericShrink
881instance Arbitrary CommonTermsQuery where arbitrary = sopArbitrary; shrink = genericShrink
882instance Arbitrary DistanceRange where arbitrary = sopArbitrary; shrink = genericShrink
883instance Arbitrary MultiMatchQuery where arbitrary = sopArbitrary; shrink = genericShrink
884instance Arbitrary LessThanD where arbitrary = sopArbitrary; shrink = genericShrink
885instance Arbitrary LessThanEqD where arbitrary = sopArbitrary; shrink = genericShrink
886instance Arbitrary GreaterThanD where arbitrary = sopArbitrary; shrink = genericShrink
887instance Arbitrary GreaterThanEqD where arbitrary = sopArbitrary; shrink = genericShrink
888instance Arbitrary LessThan where arbitrary = sopArbitrary; shrink = genericShrink
889instance Arbitrary LessThanEq where arbitrary = sopArbitrary; shrink = genericShrink
890instance Arbitrary GreaterThan where arbitrary = sopArbitrary; shrink = genericShrink
891instance Arbitrary GreaterThanEq where arbitrary = sopArbitrary; shrink = genericShrink
892instance Arbitrary GeoPoint where
893 arbitrary = GeoPoint <$> (arbitrary `suchThat` reasonableFieldName) <*> arbitrary
894 where
895 -- These are problematic for geopoint for obvious reasons
896 reasonableFieldName (FieldName "from") = False
897 reasonableFieldName (FieldName "to") = False
898 reasonableFieldName _ = True
899 shrink = genericShrink
900instance Arbitrary NullValue where arbitrary = sopArbitrary; shrink = genericShrink
901instance Arbitrary MinimumMatchHighLow where arbitrary = sopArbitrary; shrink = genericShrink
902instance Arbitrary CommonMinimumMatch where arbitrary = sopArbitrary; shrink = genericShrink
903instance Arbitrary BoostingQuery where arbitrary = sopArbitrary; shrink = genericShrink
904instance Arbitrary BoolQuery where arbitrary = sopArbitrary; shrink = genericShrink
905instance Arbitrary MatchQuery where arbitrary = sopArbitrary; shrink = genericShrink
906instance Arbitrary MultiMatchQueryType where arbitrary = sopArbitrary; shrink = genericShrink
907instance Arbitrary BooleanOperator where arbitrary = sopArbitrary; shrink = genericShrink
908instance Arbitrary ZeroTermsQuery where arbitrary = sopArbitrary; shrink = genericShrink
909instance Arbitrary MatchQueryType where arbitrary = sopArbitrary; shrink = genericShrink
910instance Arbitrary SearchAliasRouting where arbitrary = sopArbitrary; shrink = genericShrink
911instance Arbitrary ScoreType where arbitrary = sopArbitrary; shrink = genericShrink
912instance Arbitrary Distance where arbitrary = sopArbitrary; shrink = genericShrink
913instance Arbitrary DistanceUnit where arbitrary = sopArbitrary; shrink = genericShrink
914instance Arbitrary DistanceType where arbitrary = sopArbitrary; shrink = genericShrink
915instance Arbitrary OptimizeBbox where arbitrary = sopArbitrary; shrink = genericShrink
916instance Arbitrary GeoBoundingBoxConstraint where arbitrary = sopArbitrary; shrink = genericShrink
917instance Arbitrary GeoFilterType where arbitrary = sopArbitrary; shrink = genericShrink
918instance Arbitrary GeoBoundingBox where arbitrary = sopArbitrary; shrink = genericShrink
919instance Arbitrary LatLon where arbitrary = sopArbitrary; shrink = genericShrink
920instance Arbitrary RangeExecution where arbitrary = sopArbitrary; shrink = genericShrink
921instance Arbitrary RegexpFlag where arbitrary = sopArbitrary; shrink = genericShrink
922instance Arbitrary BoolMatch where arbitrary = sopArbitrary; shrink = genericShrink
923instance Arbitrary Term where arbitrary = sopArbitrary; shrink = genericShrink
924instance Arbitrary IndexSettings where arbitrary = sopArbitrary; shrink = genericShrink
925instance Arbitrary UpdatableIndexSetting where arbitrary = sopArbitrary; shrink = genericShrink
926instance Arbitrary Bytes where arbitrary = sopArbitrary; shrink = genericShrink
927instance Arbitrary AllocationPolicy where arbitrary = sopArbitrary; shrink = genericShrink
928instance Arbitrary InitialShardCount where arbitrary = sopArbitrary; shrink = genericShrink
929instance Arbitrary FSType where arbitrary = sopArbitrary; shrink = genericShrink
930instance Arbitrary CompoundFormat where arbitrary = sopArbitrary; shrink = genericShrink
931instance Arbitrary FsSnapshotRepo where arbitrary = sopArbitrary; shrink = genericShrink
932instance Arbitrary SnapshotRepoName where arbitrary = sopArbitrary; shrink = genericShrink
933instance Arbitrary TemplateQueryInline where arbitrary = sopArbitrary; shrink = genericShrink
934instance Arbitrary PhraseSuggesterCollate where arbitrary = sopArbitrary; shrink = genericShrink
935instance Arbitrary PhraseSuggesterHighlighter where arbitrary = sopArbitrary; shrink = genericShrink
936instance Arbitrary Size where arbitrary = sopArbitrary; shrink = genericShrink
937instance Arbitrary PhraseSuggester where arbitrary = sopArbitrary; shrink = genericShrink
938instance Arbitrary SuggestType where arbitrary = sopArbitrary; shrink = genericShrink
939instance Arbitrary Suggest where arbitrary = sopArbitrary; shrink = genericShrink
941newtype UpdatableIndexSetting' = UpdatableIndexSetting' UpdatableIndexSetting
942 deriving (Show, Eq, ToJSON, FromJSON, ApproxEq, Typeable)
944instance Arbitrary UpdatableIndexSetting' where
945 arbitrary = do
946 settings <- arbitrary
947 return $ UpdatableIndexSetting' $ case settings of
948 RoutingAllocationInclude xs -> RoutingAllocationInclude (dropDuplicateAttrNames xs)
949 RoutingAllocationExclude xs -> RoutingAllocationExclude (dropDuplicateAttrNames xs)
950 RoutingAllocationRequire xs -> RoutingAllocationRequire (dropDuplicateAttrNames xs)
951 x -> x
952 where
953 dropDuplicateAttrNames = NE.fromList . L.nubBy sameAttrName . NE.toList
954 sameAttrName a b = nodeAttrFilterName a == nodeAttrFilterName b
956main :: IO ()
957main = hspec $ do
959 describe "index create/delete API" $ do
960 it "creates and then deletes the requested index" $ withTestEnv $ do
961 -- priming state.
962 _ <- deleteExampleIndex
963 resp <- createExampleIndex
964 deleteResp <- deleteExampleIndex
965 liftIO $ do
966 validateStatus resp 200
967 validateStatus deleteResp 200
969 describe "error parsing" $ do
970 it "can parse EsErrors for < 2.0" $ when' (atmost es16) $ withTestEnv $ do
971 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
972 let errorResp = eitherDecode (responseBody res)
973 liftIO (errorResp `shouldBe` Right (EsError 404 "IndexMissingException[[bogus] missing]"))
975 it "can parse EsErrors for >= 2.0" $ when' (atleast es20) $ withTestEnv $ do
976 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
977 let errorResp = eitherDecode (responseBody res)
978 liftIO (errorResp `shouldBe` Right (EsError 404 "no such index"))
980 describe "document API" $ do
981 it "indexes, updates, gets, and then deletes the generated document" $ withTestEnv $ do
982 _ <- insertData
983 _ <- updateData
984 docInserted <- getDocument testIndex testMapping (DocId "1")
985 let newTweet = eitherDecode
986 (responseBody docInserted) :: Either String (EsResult Tweet)
987 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just patchedTweet))
989 it "indexes, gets, and then deletes the generated document with a DocId containing a space" $ withTestEnv $ do
990 _ <- insertWithSpaceInId
991 docInserted <- getDocument testIndex testMapping (DocId "Hello World")
992 let newTweet = eitherDecode
993 (responseBody docInserted) :: Either String (EsResult Tweet)
994 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))
996 it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do
997 doc <- getDocument testIndex testMapping (DocId "bogus")
998 let noTweet = eitherDecode
999 (responseBody doc) :: Either String (EsResult Tweet)
1000 liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing
1002 it "can use optimistic concurrency control" $ withTestEnv $ do
1003 let ev = ExternalDocVersion minBound
1004 let cfg = defaultIndexDocumentSettings { idsVersionControl = ExternalGT ev }
1005 resetIndex
1006 res <- insertData' cfg
1007 liftIO $ isCreated res `shouldBe` True
1008 res' <- insertData' cfg
1009 liftIO $ isVersionConflict res' `shouldBe` True
1011 it "indexes two documents in a parent/child relationship and checks that the child exists" $ withTestEnv $ do
1012 resetIndex
1013 _ <- putMapping testIndex (MappingName "child") ChildMapping
1014 _ <- putMapping testIndex (MappingName "parent") ParentMapping
1015 _ <- indexDocument testIndex (MappingName "parent") defaultIndexDocumentSettings exampleTweet (DocId "1")
1016 let parent = (Just . DocumentParent . DocId) "1"
1017 ids = IndexDocumentSettings NoVersionControl parent
1018 _ <- indexDocument testIndex (MappingName "child") ids otherTweet (DocId "2")
1019 _ <- refreshIndex testIndex
1020 exists <- documentExists testIndex (MappingName "child") parent (DocId "2")
1021 liftIO $ exists `shouldBe` True
1023 describe "template API" $ do
1024 it "can create a template" $ withTestEnv $ do
1025 let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
1026 resp <- putTemplate idxTpl (TemplateName "tweet-tpl")
1027 liftIO $ validateStatus resp 200
1029 it "can detect if a template exists" $ withTestEnv $ do
1030 exists <- templateExists (TemplateName "tweet-tpl")
1031 liftIO $ exists `shouldBe` True
1033 it "can delete a template" $ withTestEnv $ do
1034 resp <- deleteTemplate (TemplateName "tweet-tpl")
1035 liftIO $ validateStatus resp 200
1037 it "can detect if a template doesn't exist" $ withTestEnv $ do
1038 exists <- templateExists (TemplateName "tweet-tpl")
1039 liftIO $ exists `shouldBe` False
1041 describe "bulk API" $ do
1042 it "inserts all documents we request" $ withTestEnv $ do
1043 _ <- insertData
1044 let firstTest = BulkTest "blah"
1045 let secondTest = BulkTest "bloo"
1046 let firstDoc = BulkIndex testIndex
1047 testMapping (DocId "2") (toJSON firstTest)
1048 let secondDoc = BulkCreate testIndex
1049 testMapping (DocId "3") (toJSON secondTest)
1050 let stream = V.fromList [firstDoc, secondDoc]
1051 _ <- bulk stream
1052 _ <- refreshIndex testIndex
1053 fDoc <- getDocument testIndex testMapping (DocId "2")
1054 sDoc <- getDocument testIndex testMapping (DocId "3")
1055 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
1056 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
1057 liftIO $ do
1058 fmap getSource maybeFirst `shouldBe` Right (Just firstTest)
1059 fmap getSource maybeSecond `shouldBe` Right (Just secondTest)
1062 describe "query API" $ do
1063 it "returns document for term query and identity filter" $ withTestEnv $ do
1064 _ <- insertData
1065 let query = TermQuery (Term "user" "bitemyapp") Nothing
1066 let filter = IdentityFilter <&&> IdentityFilter
1067 let search = mkSearch (Just query) (Just filter)
1068 myTweet <- searchTweet search
1069 liftIO $
1070 myTweet `shouldBe` Right exampleTweet
1072 it "handles constant score queries" $ withTestEnv $ do
1073 _ <- insertData
1074 let query = TermsQuery "user" ("bitemyapp" :| [])
1075 let cfQuery = ConstantScoreQuery query (Boost 1.0)
1076 let filter = IdentityFilter
1077 let search = mkSearch (Just cfQuery) (Just filter)
1078 myTweet <- searchTweet search
1079 liftIO $
1080 myTweet `shouldBe` Right exampleTweet
1081 it "handles constant score filters" $ withTestEnv $ do
1082 _ <- insertData
1083 let query = TermsQuery "user" ("bitemyapp" :| [])
1084 let cfFilter = ConstantScoreFilter IdentityFilter (Boost 1.0)
1085 let boolQuery = mkBoolQuery [query, cfFilter] [] []
1086 let search = mkSearch (Just (QueryBoolQuery boolQuery)) Nothing
1087 myTweet <- searchTweet search
1088 liftIO $
1089 myTweet `shouldBe` Right exampleTweet
1092 it "returns document for terms query and identity filter" $ withTestEnv $ do
1093 _ <- insertData
1094 let query = TermsQuery "user" ("bitemyapp" :| [])
1095 let filter = IdentityFilter <&&> IdentityFilter
1096 let search = mkSearch (Just query) (Just filter)
1097 myTweet <- searchTweet search
1098 liftIO $
1099 myTweet `shouldBe` Right exampleTweet
1101 it "returns document for match query" $ withTestEnv $ do
1102 _ <- insertData
1103 let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1104 let search = mkSearch (Just query) Nothing
1105 myTweet <- searchTweet search
1106 liftIO $
1107 myTweet `shouldBe` Right exampleTweet
1109 it "returns document for multi-match query" $ withTestEnv $ do
1110 _ <- insertData
1111 let flds = [FieldName "user", FieldName "message"]
1112 let query = QueryMultiMatchQuery $ mkMultiMatchQuery flds (QueryString "bitemyapp")
1113 let search = mkSearch (Just query) Nothing
1114 myTweet <- searchTweet search
1115 liftIO $
1116 myTweet `shouldBe` Right exampleTweet
1118 it "returns document for multi-match query with a custom tiebreaker" $ withTestEnv $ do
1119 _ <- insertData
1120 let tiebreaker = Just $ Tiebreaker 0.3
1121 flds = [FieldName "user", FieldName "message"]
1122 multiQuery' = mkMultiMatchQuery flds (QueryString "bitemyapp")
1123 query = QueryMultiMatchQuery $ multiQuery' { multiMatchQueryTiebreaker = tiebreaker }
1124 search = mkSearch (Just query) Nothing
1125 myTweet <- searchTweet search
1126 liftIO $
1127 myTweet `shouldBe` Right exampleTweet
1129 it "returns document for bool query" $ withTestEnv $ do
1130 _ <- insertData
1131 let innerQuery = QueryMatchQuery $
1132 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1133 let query = QueryBoolQuery $
1134 mkBoolQuery [innerQuery] [] []
1135 let search = mkSearch (Just query) Nothing
1136 myTweet <- searchTweet search
1137 liftIO $
1138 myTweet `shouldBe` Right exampleTweet
1140 it "returns document for boosting query" $ withTestEnv $ do
1141 _ <- insertData
1142 let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1143 let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
1144 let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
1145 let search = mkSearch (Just query) Nothing
1146 myTweet <- searchTweet search
1147 liftIO $
1148 myTweet `shouldBe` Right exampleTweet
1150 it "returns document for common terms query" $ withTestEnv $ do
1151 _ <- insertData
1152 let query = QueryCommonTermsQuery $
1153 CommonTermsQuery (FieldName "user")
1154 (QueryString "bitemyapp")
1155 (CutoffFrequency 0.0001)
1156 Or Or Nothing Nothing Nothing Nothing
1157 let search = mkSearch (Just query) Nothing
1158 myTweet <- searchTweet search
1159 liftIO $
1160 myTweet `shouldBe` Right exampleTweet
1162 it "returns document for for inline template query" $ withTestEnv $ do
1163 _ <- insertData
1164 let innerQuery = QueryMatchQuery $
1165 mkMatchQuery (FieldName "{{userKey}}")
1166 (QueryString "{{bitemyappKey}}")
1167 templateParams = TemplateQueryKeyValuePairs $ HM.fromList
1168 [ ("userKey", "user")
1169 , ("bitemyappKey", "bitemyapp")
1171 templateQuery = QueryTemplateQueryInline $
1172 TemplateQueryInline innerQuery templateParams
1173 search = mkSearch (Just templateQuery) Nothing
1174 myTweet <- searchTweet search
1175 liftIO $ myTweet `shouldBe` Right exampleTweet
1178 describe "sorting" $ do
1179 it "returns documents in the right order" $ withTestEnv $ do
1180 _ <- insertData
1181 _ <- insertOther
1182 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
1183 let search = Search Nothing
1184 (Just IdentityFilter) (Just [sortSpec]) Nothing Nothing
1185 False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
1186 Nothing
1187 result <- searchTweets search
1188 let myTweet = grabFirst result
1189 liftIO $
1190 myTweet `shouldBe` Right otherTweet
1193 describe "filtering API" $ do
1194 it "returns document for composed boolmatch and identity" $ withTestEnv $ do
1195 _ <- insertData
1196 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
1197 <&&> IdentityFilter
1198 let search = mkSearch Nothing (Just queryFilter)
1199 myTweet <- searchTweet search
1200 liftIO $
1201 myTweet `shouldBe` Right exampleTweet
1203 it "returns document for term filter" $ withTestEnv $ do
1204 _ <- insertData
1205 let termFilter = TermFilter (Term "user" "bitemyapp") False
1206 let search = mkSearch Nothing (Just termFilter)
1207 myTweet <- searchTweet search
1208 liftIO $
1209 myTweet `shouldBe` Right exampleTweet
1211 it "returns document for existential filter" $ withTestEnv $ do
1212 _ <- insertData
1213 let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
1214 myTweet <- searchTweet search
1215 liftIO $
1216 myTweet `shouldBe` Right exampleTweet
1218 it "returns document for geo boundingbox filter" $ withTestEnv $ do
1219 _ <- insertData
1220 let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
1221 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
1222 let geoFilter = GeoBoundingBoxFilter bbConstraint
1223 let search = mkSearch Nothing (Just geoFilter)
1224 myTweet <- searchTweet search
1225 liftIO $
1226 myTweet `shouldBe` Right exampleTweet
1228 it "doesn't return document for nonsensical boundingbox filter" $ withTestEnv $ do
1229 _ <- insertData
1230 let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
1231 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
1232 let geoFilter = GeoBoundingBoxFilter bbConstraint
1233 let search = mkSearch Nothing (Just geoFilter)
1234 searchExpectNoResults search
1236 it "returns document for geo distance filter" $ withTestEnv $ do
1237 _ <- insertData
1238 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1239 let distance = Distance 10.0 Miles
1240 let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
1241 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
1242 let search = mkSearch Nothing (Just geoFilter)
1243 myTweet <- searchTweet search
1244 liftIO $
1245 myTweet `shouldBe` Right exampleTweet
1247 it "returns document for geo distance range filter" $ withTestEnv $ do
1248 _ <- insertData
1249 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1250 let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
1251 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
1252 let search = mkSearch Nothing (Just geoFilter)
1253 myTweet <- searchTweet search
1254 liftIO $
1255 myTweet `shouldBe` Right exampleTweet
1257 it "doesn't return document for wild geo distance range filter" $ withTestEnv $ do
1258 _ <- insertData
1259 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1260 let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
1261 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
1262 let search = mkSearch Nothing (Just geoFilter)
1263 searchExpectNoResults search
1265 it "returns document for geo polygon filter" $ withTestEnv $ do
1266 _ <- insertData
1267 let points = [LatLon 40.0 (-70.00),
1268 LatLon 40.0 (-72.00),
1269 LatLon 41.0 (-70.00),
1270 LatLon 41.0 (-72.00)]
1271 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
1272 let search = mkSearch Nothing (Just geoFilter)
1273 myTweet <- searchTweet search
1274 liftIO $
1275 myTweet `shouldBe` Right exampleTweet
1277 it "doesn't return document for bad geo polygon filter" $ withTestEnv $ do
1278 _ <- insertData
1279 let points = [LatLon 40.0 (-70.00),
1280 LatLon 40.0 (-71.00),
1281 LatLon 41.0 (-70.00),
1282 LatLon 41.0 (-71.00)]
1283 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
1284 let search = mkSearch Nothing (Just geoFilter)
1285 searchExpectNoResults search
1287 it "returns document for ids filter" $ withTestEnv $ do
1288 _ <- insertData
1289 let filter = IdsFilter (MappingName "tweet") [DocId "1"]
1290 let search = mkSearch Nothing (Just filter)
1291 myTweet <- searchTweet search
1292 liftIO $
1293 myTweet `shouldBe` Right exampleTweet
1295 it "returns document for Double range filter" $ withTestEnv $ do
1296 _ <- insertData
1297 let filter = RangeFilter (FieldName "age")
1298 (RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))
1299 RangeExecutionIndex False
1300 let search = mkSearch Nothing (Just filter)
1301 myTweet <- searchTweet search
1302 liftIO $
1303 myTweet `shouldBe` Right exampleTweet
1305 it "returns document for UTCTime date filter" $ withTestEnv $ do
1306 _ <- insertData
1307 let filter = RangeFilter (FieldName "postDate")
1308 (RangeDateGtLt
1309 (GreaterThanD (UTCTime
1310 (ModifiedJulianDay 54000)
1311 (secondsToDiffTime 0)))
1312 (LessThanD (UTCTime
1313 (ModifiedJulianDay 55000)
1314 (secondsToDiffTime 11))))
1315 RangeExecutionIndex False
1316 let search = mkSearch Nothing (Just filter)
1317 myTweet <- searchTweet search
1318 liftIO $
1319 myTweet `shouldBe` Right exampleTweet
1321 it "returns document for regexp filter" $ withTestEnv $ do
1322 _ <- insertData
1323 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
1324 AllRegexpFlags (CacheName "test") False (CacheKey "key")
1325 let search = mkSearch Nothing (Just filter)
1326 myTweet <- searchTweet search
1327 liftIO $
1328 myTweet `shouldBe` Right exampleTweet
1330 it "doesn't return document for non-matching regexp filter" $ withTestEnv $ do
1331 _ <- insertData
1332 let filter = RegexpFilter (FieldName "user")
1333 (Regexp "boy") AllRegexpFlags
1334 (CacheName "test") False (CacheKey "key")
1335 let search = mkSearch Nothing (Just filter)
1336 searchExpectNoResults search
1338 it "returns document for query filter, uncached" $ withTestEnv $ do
1339 _ <- insertData
1340 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) True
1341 search = mkSearch Nothing (Just filter)
1342 myTweet <- searchTweet search
1343 liftIO $ myTweet `shouldBe` Right exampleTweet
1345 it "returns document for query filter, cached" $ withTestEnv $ do
1346 _ <- insertData
1347 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) False
1348 search = mkSearch Nothing (Just filter)
1349 myTweet <- searchTweet search
1350 liftIO $ myTweet `shouldBe` Right exampleTweet
1352 describe "Aggregation API" $ do
1353 it "returns term aggregation results" $ withTestEnv $ do
1354 _ <- insertData
1355 let terms = TermsAgg $ mkTermsAggregation "user"
1356 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1357 searchExpectAggs search
1358 searchValidBucketAgg search "users" toTerms
1360 it "return sub-aggregation results" $ withTestEnv $ do
1361 _ <- insertData
1362 let subaggs = mkAggregations "age_agg" . TermsAgg $ mkTermsAggregation "age"
1363 agg = TermsAgg $ (mkTermsAggregation "user") { termAggs = Just subaggs}
1364 search = mkAggregateSearch Nothing $ mkAggregations "users" agg
1365 reply <- searchByIndex testIndex search
1366 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
1367 usersAggResults = result >>= aggregations >>= toTerms "users"
1368 subAggResults = usersAggResults >>= (listToMaybe . buckets) >>= termsAggs >>= toTerms "age_agg"
1369 subAddResultsExists = isJust subAggResults
1370 liftIO $ (subAddResultsExists) `shouldBe` True
1372 it "returns cardinality aggregation results" $ withTestEnv $ do
1373 _ <- insertData
1374 let cardinality = CardinalityAgg $ mkCardinalityAggregation $ FieldName "user"
1375 let search = mkAggregateSearch Nothing $ mkAggregations "users" cardinality
1376 let search' = search { Database.V1.Bloodhound.from = From 0, size = Size 0 }
1377 searchExpectAggs search'
1378 let docCountPair k n = (k, object ["value" .= Number n])
1379 res <- searchTweets search'
1380 liftIO $
1381 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "users" 1]))
1383 it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
1384 _ <- insertData
1385 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
1386 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1387 searchExpectAggs search
1388 searchValidBucketAgg search "users" toTerms
1390 -- One of these fails with 1.7.3
1391 it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
1392 _ <- insertData
1393 searchTermsAggHint [Map, Ordinals]
1395 it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do
1396 _ <- insertData
1397 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
1399 it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
1400 _ <- insertData
1401 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
1402 -- One of the above.
1404 it "can execute value_count aggregations" $ withTestEnv $ do
1405 _ <- insertData
1406 _ <- insertOther
1407 let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>
1408 mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))
1409 let search = mkAggregateSearch Nothing ags
1410 let docCountPair k n = (k, object ["value" .= Number n])
1411 res <- searchTweets search
1412 liftIO $
1413 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2
1414 , docCountPair "bogus_count" 0
1415 ]))
1417 it "can execute filter aggregations" $ withTestEnv $ do
1418 _ <- insertData
1419 _ <- insertOther
1420 let ags = mkAggregations "bitemyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "bitemyapp") defaultCache) Nothing)) <>
1421 mkAggregations "notmyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "notmyapp") defaultCache) Nothing))
1422 let search = mkAggregateSearch Nothing ags
1423 let docCountPair k n = (k, object ["doc_count" .= Number n])
1424 res <- searchTweets search
1425 liftIO $
1426 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "bitemyapps" 1
1427 , docCountPair "notmyapps" 1
1428 ]))
1429 it "can execute date_range aggregations" $ withTestEnv $ do
1430 let now = fromGregorian 2015 3 14
1431 let ltAMonthAgo = UTCTime (fromGregorian 2015 3 1) 0
1432 let ltAWeekAgo = UTCTime (fromGregorian 2015 3 10) 0
1433 let oldDoc = exampleTweet { postDate = ltAMonthAgo }
1434 let newDoc = exampleTweet { postDate = ltAWeekAgo }
1435 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings oldDoc (DocId "1")
1436 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings newDoc (DocId "2")
1437 _ <- refreshIndex testIndex
1438 let thisMonth = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMMonth])
1439 let thisWeek = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMWeek])
1440 let agg = DateRangeAggregation (FieldName "postDate") Nothing (thisMonth :| [thisWeek])
1441 let ags = mkAggregations "date_ranges" (DateRangeAgg agg)
1442 let search = mkAggregateSearch Nothing ags
1443 res <- searchTweets search
1444 liftIO $ hitsTotal . searchHits <$> res `shouldBe` Right 2
1445 let bucks = do magrs <- fmapL show (aggregations <$> res)
1446 agrs <- note "no aggregations returned" magrs
1447 rawBucks <- note "no date_ranges aggregation" $ M.lookup "date_ranges" agrs
1448 parseEither parseJSON rawBucks
1449 let fromMonthT = UTCTime (fromGregorian 2015 2 14) 0
1450 let fromWeekT = UTCTime (fromGregorian 2015 3 7) 0
1451 liftIO $ buckets <$> bucks `shouldBe` Right [ DateRangeResult "2015-02-14T00:00:00.000Z-*"
1452 (Just fromMonthT)
1453 (Just "2015-02-14T00:00:00.000Z")
1454 Nothing
1455 Nothing
1457 Nothing
1458 , DateRangeResult "2015-03-07T00:00:00.000Z-*"
1459 (Just fromWeekT)
1460 (Just "2015-03-07T00:00:00.000Z")
1461 Nothing
1462 Nothing
1464 Nothing
1467 it "returns date histogram aggregation results" $ withTestEnv $ do
1468 _ <- insertData
1469 let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
1470 let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
1471 searchExpectAggs search
1472 searchValidBucketAgg search "byDate" toDateHistogram
1474 it "returns date histogram using fractional date" $ withTestEnv $ do
1475 _ <- insertData
1476 let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]
1477 let fractionals = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]
1478 let intervals = periods ++ fractionals
1479 let histogram = mkDateHistogram (FieldName "postDate")
1480 let search interval = mkAggregateSearch Nothing $ mkAggregations "byDate" $ DateHistogramAgg (histogram interval)
1481 let expect interval = searchExpectAggs (search interval)
1482 let valid interval = searchValidBucketAgg (search interval) "byDate" toDateHistogram
1483 forM_ intervals expect
1484 forM_ intervals valid
1486 it "can execute missing aggregations" $ withTestEnv $ do
1487 _ <- insertData
1488 _ <- insertExtra
1489 let ags = mkAggregations "missing_agg" (MissingAgg (MissingAggregation "extra"))
1490 let search = mkAggregateSearch Nothing ags
1491 let docCountPair k n = (k, object ["doc_count" .= Number n])
1492 res <- searchTweets search
1493 liftIO $
1494 fmap aggregations res `shouldBe` Right (Just (M.fromList [docCountPair "missing_agg" 1]))
1496 describe "Highlights API" $ do
1498 it "returns highlight from query when there should be one" $ withTestEnv $ do
1499 _ <- insertData
1500 _ <- insertOther
1501 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1502 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
1504 let search = mkHighlightSearch (Just query) testHighlight
1505 myHighlight <- searchTweetHighlight search
1506 liftIO $
1507 myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
1509 it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
1510 _ <- insertData
1511 _ <- insertOther
1512 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1513 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "user") Nothing]
1515 let search = mkHighlightSearch (Just query) testHighlight
1516 myHighlight <- searchTweetHighlight search
1517 liftIO $
1518 myHighlight `shouldBe` Right Nothing
1520 describe "Source filtering" $ do
1522 it "doesn't include source when sources are disabled" $ withTestEnv $ do
1523 searchExpectSource
1524 NoSource
1525 (Left (EsError 500 "Source was missing"))
1527 it "includes a source" $ withTestEnv $ do
1528 searchExpectSource
1529 (SourcePatterns (PopPattern (Pattern "message")))
1530 (Right (Object (HM.fromList [("message", String "Use haskell!")])))
1532 it "includes sources" $ withTestEnv $ do
1533 searchExpectSource
1534 (SourcePatterns (PopPatterns [Pattern "user", Pattern "message"]))
1535 (Right (Object (HM.fromList [("user",String "bitemyapp"),("message", String "Use haskell!")])))
1537 it "includes source patterns" $ withTestEnv $ do
1538 searchExpectSource
1539 (SourcePatterns (PopPattern (Pattern "*ge")))
1540 (Right (Object (HM.fromList [("age", Number 10000),("message", String "Use haskell!")])))
1542 it "excludes source patterns" $ withTestEnv $ do
1543 searchExpectSource
1544 (SourceIncludeExclude (Include [])
1545 (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate", Pattern "extra"]))
1546 (Right (Object (HM.fromList [("user",String "bitemyapp")])))
1548 describe "ToJSON RegexpFlags" $ do
1549 it "generates the correct JSON for AllRegexpFlags" $
1550 toJSON AllRegexpFlags `shouldBe` String "ALL"
1552 it "generates the correct JSON for NoRegexpFlags" $
1553 toJSON NoRegexpFlags `shouldBe` String "NONE"
1555 it "generates the correct JSON for SomeRegexpFlags" $
1556 let flags = AnyString :| [ Automaton
1557 , Complement
1558 , Empty
1559 , Intersection
1560 , Interval ]
1561 in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
1563 prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
1564 let String str = toJSON flags
1565 flagStrs = T.splitOn "|" str
1566 in noDuplicates flagStrs
1568 describe "omitNulls" $ do
1569 it "checks that omitNulls drops list elements when it should" $
1570 let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))
1571 , "test2" .= (toJSON ("some value" :: Text))]
1572 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1574 it "checks that omitNulls doesn't drop list elements when it shouldn't" $
1575 let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))
1576 , "test2" .= (toJSON ("some value" :: Text))]
1577 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))
1578 , ("test2", String "some value")])
1579 it "checks that omitNulls drops non list elements when it should" $
1580 let dropped = omitNulls $ [ "test1" .= (toJSON Null)
1581 , "test2" .= (toJSON ("some value" :: Text))]
1582 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1583 it "checks that omitNulls doesn't drop non list elements when it shouldn't" $
1584 let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
1585 , "test2" .= (toJSON ("some value" :: Text))]
1586 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
1587 , ("test2", String "some value")])
1588 describe "Monoid (SearchHits a)" $ do
1589 prop "abides the monoid laws" $ eq $
1590 prop_Monoid (T :: T (SearchHits ()))
1592 describe "mkDocVersion" $ do
1593 prop "can never construct an out of range docVersion" $ \i ->
1594 let res = mkDocVersion i
1595 in case res of
1596 Nothing -> property True
1597 Just dv -> (dv >= minBound) .&&.
1598 (dv <= maxBound) .&&.
1599 docVersionNumber dv === i
1601 describe "FsSnapshotRepo" $ do
1602 prop "SnapshotRepo laws" $ \fsr ->
1603 fromGSnapshotRepo (toGSnapshotRepo fsr) === Right (fsr :: FsSnapshotRepo)
1605 describe "snapshot repos" $ do
1606 it "always parses all snapshot repos API" $ when' canSnapshot $ withTestEnv $ do
1607 res <- getSnapshotRepos AllSnapshotRepos
1608 liftIO $ case res of
1609 Left e -> expectationFailure ("Expected a right but got Left " <> show e)
1610 Right _ -> return ()
1612 it "finds an existing list of repos" $ when' canSnapshot $ withTestEnv $ do
1613 let r1n = SnapshotRepoName "bloodhound-repo1"
1614 let r2n = SnapshotRepoName "bloodhound-repo2"
1615 withSnapshotRepo r1n $ \r1 ->
1616 withSnapshotRepo r2n $ \r2 -> do
1617 repos <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| [ExactRepo r2n]))
1618 liftIO $ case repos of
1619 Right xs -> do
1620 let srt = L.sortBy (comparing gSnapshotRepoName)
1621 srt xs `shouldBe` srt [r1, r2]
1622 Left e -> expectationFailure (show e)
1624 it "creates and updates with updateSnapshotRepo" $ when' canSnapshot $ withTestEnv $ do
1625 let r1n = SnapshotRepoName "bloodhound-repo1"
1626 withSnapshotRepo r1n $ \r1 -> do
1627 let Just (String dir) = HM.lookup "location" (gSnapshotRepoSettingsObject (gSnapshotRepoSettings r1))
1628 let noCompression = FsSnapshotRepo r1n (T.unpack dir) False Nothing Nothing Nothing
1629 resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings noCompression
1630 liftIO (validateStatus resp 200)
1631 Right [roundtrippedNoCompression] <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| []))
1632 liftIO (roundtrippedNoCompression `shouldBe` toGSnapshotRepo noCompression)
1634 -- verify came around in 1.4 it seems
1635 it "can verify existing repos" $ when' canSnapshot $ when' (atleast es14) $ withTestEnv $ do
1636 let r1n = SnapshotRepoName "bloodhound-repo1"
1637 withSnapshotRepo r1n $ \_ -> do
1638 res <- verifySnapshotRepo r1n
1639 liftIO $ case res of
1640 Right (SnapshotVerification vs)
1641 | null vs -> expectationFailure "Expected nonempty set of verifying nodes"
1642 | otherwise -> return ()
1643 Left e -> expectationFailure (show e)
1645 describe "snapshots" $ do
1646 it "always parses all snapshots API" $ when' canSnapshot $ withTestEnv $ do
1647 let r1n = SnapshotRepoName "bloodhound-repo1"
1648 withSnapshotRepo r1n $ \_ -> do
1649 res <- getSnapshots r1n AllSnapshots
1650 liftIO $ case res of
1651 Left e -> expectationFailure ("Expected a right but got Left " <> show e)
1652 Right _ -> return ()
1654 it "can parse a snapshot that it created" $ when' canSnapshot $ withTestEnv $ do
1655 let r1n = SnapshotRepoName "bloodhound-repo1"
1656 withSnapshotRepo r1n $ \_ -> do
1657 let s1n = SnapshotName "example-snapshot"
1658 withSnapshot r1n s1n $ do
1659 res <- getSnapshots r1n (SnapshotList (ExactSnap s1n :| []))
1660 liftIO $ case res of
1661 Right [snap]
1662 | snapInfoState snap == SnapshotSuccess &&
1663 snapInfoName snap == s1n -> return ()
1664 | otherwise -> expectationFailure (show snap)
1665 Right [] -> expectationFailure "There were no snapshots"
1666 Right snaps -> expectationFailure ("Expected 1 snapshot but got" <> show (length snaps))
1667 Left e -> expectationFailure (show e)
1669 describe "snapshot restore" $ do
1670 it "can restore a snapshot that we create" $ when' canSnapshot $ withTestEnv $ do
1671 let r1n = SnapshotRepoName "bloodhound-repo1"
1672 withSnapshotRepo r1n $ \_ -> do
1673 let s1n = SnapshotName "example-snapshot"
1674 withSnapshot r1n s1n $ do
1675 let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True }
1676 -- have to close an index to restore it
1677 resp1 <- closeIndex testIndex
1678 liftIO (validateStatus resp1 200)
1679 resp2 <- restoreSnapshot r1n s1n settings
1680 liftIO (validateStatus resp2 200)
1682 it "can restore and rename" $ when' canSnapshot $ withTestEnv $ do
1683 let r1n = SnapshotRepoName "bloodhound-repo1"
1684 withSnapshotRepo r1n $ \_ -> do
1685 let s1n = SnapshotName "example-snapshot"
1686 withSnapshot r1n s1n $ do
1687 let pat = RestoreRenamePattern "bloodhound-tests-twitter-(\\d+)"
1688 let replace = RRTLit "restored-" :| [RRSubWholeMatch]
1689 let expectedIndex = IndexName "restored-bloodhound-tests-twitter-1"
1690 oldEnoughForOverrides <- liftIO (atleast es15)
1691 let overrides = RestoreIndexSettings { restoreOverrideReplicas = Just (ReplicaCount 0) }
1692 let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True
1693 , snapRestoreRenamePattern = Just pat
1694 , snapRestoreRenameReplacement = Just replace
1695 , snapRestoreIndexSettingsOverrides = if oldEnoughForOverrides
1696 then Just overrides
1697 else Nothing
1699 -- have to close an index to restore it
1700 let go = do
1701 resp <- restoreSnapshot r1n s1n settings
1702 liftIO (validateStatus resp 200)
1703 exists <- indexExists expectedIndex
1704 liftIO (exists `shouldBe` True)
1705 go `finally` deleteIndex expectedIndex
1707 describe "getNodesInfo" $ do
1708 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
1709 res <- getNodesInfo LocalNode
1710 liftIO $ case res of
1711 -- This is really just a smoke test for response
1712 -- parsing. Node info is so variable, there's not much I can
1713 -- assert here.
1714 Right NodesInfo {..} -> length nodesInfo `shouldBe` 1
1715 Left e -> expectationFailure ("Expected NodesInfo but got " <> show e)
1717 describe "getNodesStats" $ do
1718 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
1719 res <- getNodesStats LocalNode
1720 liftIO $ case res of
1721 -- This is really just a smoke test for response
1722 -- parsing. Node stats is so variable, there's not much I can
1723 -- assert here.
1724 Right NodesStats {..} -> length nodesStats `shouldBe` 1
1725 Left e -> expectationFailure ("Expected NodesStats but got " <> show e)
1727 describe "Enum DocVersion" $ do
1728 it "follows the laws of Enum, Bounded" $ do
1729 evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall
1730 evaluate (pred minBound :: DocVersion) `shouldThrow` anyErrorCall
1731 evaluate (toEnum 0 :: DocVersion) `shouldThrow` anyErrorCall
1732 evaluate (toEnum 9200000000000000001 :: DocVersion) `shouldThrow` anyErrorCall
1733 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1734 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1735 enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]
1737 describe "scan&scroll API" $ do
1738 it "returns documents using the scan&scroll API" $ withTestEnv $ do
1739 _ <- insertData
1740 _ <- insertOther
1741 let search = (mkSearch (Just $ MatchAllQuery Nothing) Nothing) { size = (Size 1) }
1742 regular_search <- searchTweet search
1743 scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet]
1744 let scan_search = map hitSource scan_search'
1745 liftIO $
1746 regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored
1747 liftIO $
1748 scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]
1750 describe "index aliases" $ do
1751 it "handles the simple case of aliasing an existing index" $ do
1752 let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1753 let create = IndexAliasCreate Nothing Nothing
1754 let action = AddAlias alias create
1756 withTestEnv $ do
1757 resetIndex
1758 resp <- updateIndexAliases (action :| [])
1759 liftIO $ validateStatus resp 200
1760 let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1761 (do aliases <- withTestEnv getIndexAliases
1762 let expected = IndexAliasSummary alias create
1763 case aliases of
1764 Right (IndexAliasesSummary summs) ->
1765 L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1766 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1768 it "handles an alias with routing and a filter" $ do
1769 let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1770 let sar = SearchAliasRouting (RoutingValue "search val" :| [])
1771 let iar = IndexAliasRouting (RoutingValue "index val")
1772 let routing = GranularAliasRouting (Just sar) (Just iar)
1773 let filter = LimitFilter 42
1774 let create = IndexAliasCreate (Just routing) (Just filter)
1775 let action = AddAlias alias create
1777 withTestEnv $ do
1778 resetIndex
1779 resp <- updateIndexAliases (action :| [])
1780 liftIO $ validateStatus resp 200
1781 let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1782 (do aliases <- withTestEnv getIndexAliases
1783 let expected = IndexAliasSummary alias create
1784 case aliases of
1785 Right (IndexAliasesSummary summs) ->
1786 L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1787 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1789 describe "Index Listing" $ do
1790 it "returns a list of index names" $ withTestEnv $ do
1791 _ <- createExampleIndex
1792 ixns <- listIndices
1793 liftIO (ixns `shouldContain` [testIndex])
1795 describe "Index Settings" $ do
1796 it "persists settings" $ withTestEnv $ do
1797 _ <- deleteExampleIndex
1798 _ <- createExampleIndex
1799 let updates = BlocksWrite False :| []
1800 updateResp <- updateIndexSettings updates testIndex
1801 liftIO $ validateStatus updateResp 200
1802 getResp <- getIndexSettings testIndex
1803 liftIO $
1804 getResp `shouldBe` Right (IndexSettingsSummary
1805 testIndex
1806 (IndexSettings (ShardCount 1) (ReplicaCount 0))
1807 (NE.toList updates))
1809 describe "Index Optimization" $ do
1810 it "returns a successful response upon completion" $ withTestEnv $ do
1811 _ <- createExampleIndex
1812 resp <- optimizeIndex (IndexList (testIndex :| [])) defaultIndexOptimizationSettings
1813 liftIO $ validateStatus resp 200
1815 describe "Suggest" $ do
1816 it "returns a search suggestion using the phrase suggester" $ withTestEnv $ do
1817 _ <- insertData
1818 let {- query = QueryMatchNoneQuery
1819 query = TermQuery (Term "user" "bitemyapp") Nothing -}
1820 let phraseSuggester = mkPhraseSuggester (FieldName "message")
1821 namedSuggester = Suggest "Use haskel" "suggest_name" (SuggestTypePhraseSuggester phraseSuggester)
1822 search' = mkSearch Nothing Nothing
1823 search = search' { suggestBody = Just namedSuggester }
1824 expectedText = Just "use haskell"
1825 resp <- searchByIndex testIndex search
1826 parsed <- parseEsResponse resp :: BH IO (Either EsError (SearchResult Tweet))
1827 case parsed of
1828 Left e -> liftIO $ expectationFailure ("Expected an search suggestion but got " <> show e)
1829 Right sr -> liftIO $ (suggestOptionsText . head . suggestResponseOptions . head . nsrResponses <$> suggest sr) `shouldBe` expectedText
1831 describe "JSON instances" $ do
1832 propJSON (Proxy :: Proxy Version)
1833 propJSON (Proxy :: Proxy IndexName)
1834 propJSON (Proxy :: Proxy MappingName)
1835 propJSON (Proxy :: Proxy DocId)
1836 propJSON (Proxy :: Proxy IndexAliasRouting)
1837 propJSON (Proxy :: Proxy RoutingValue)
1838 propJSON (Proxy :: Proxy ShardCount)
1839 propJSON (Proxy :: Proxy ReplicaCount)
1840 propJSON (Proxy :: Proxy TemplateName)
1841 propJSON (Proxy :: Proxy TemplatePattern)
1842 propJSON (Proxy :: Proxy QueryString)
1843 propJSON (Proxy :: Proxy FieldName)
1844 propJSON (Proxy :: Proxy CacheName)
1845 propJSON (Proxy :: Proxy CacheKey)
1846 propJSON (Proxy :: Proxy Existence)
1847 propJSON (Proxy :: Proxy CutoffFrequency)
1848 propJSON (Proxy :: Proxy Analyzer)
1849 propJSON (Proxy :: Proxy MaxExpansions)
1850 propJSON (Proxy :: Proxy Lenient)
1851 propJSON (Proxy :: Proxy Tiebreaker)
1852 propJSON (Proxy :: Proxy Boost)
1853 propJSON (Proxy :: Proxy BoostTerms)
1854 propJSON (Proxy :: Proxy MinimumMatch)
1855 propJSON (Proxy :: Proxy DisableCoord)
1856 propJSON (Proxy :: Proxy IgnoreTermFrequency)
1857 propJSON (Proxy :: Proxy MinimumTermFrequency)
1858 propJSON (Proxy :: Proxy MaxQueryTerms)
1859 propJSON (Proxy :: Proxy Fuzziness)
1860 propJSON (Proxy :: Proxy PrefixLength)
1861 propJSON (Proxy :: Proxy TypeName)
1862 propJSON (Proxy :: Proxy PercentMatch)
1863 propJSON (Proxy :: Proxy StopWord)
1864 propJSON (Proxy :: Proxy QueryPath)
1865 propJSON (Proxy :: Proxy AllowLeadingWildcard)
1866 propJSON (Proxy :: Proxy LowercaseExpanded)
1867 propJSON (Proxy :: Proxy EnablePositionIncrements)
1868 propJSON (Proxy :: Proxy AnalyzeWildcard)
1869 propJSON (Proxy :: Proxy GeneratePhraseQueries)
1870 propJSON (Proxy :: Proxy Locale)
1871 propJSON (Proxy :: Proxy MaxWordLength)
1872 propJSON (Proxy :: Proxy MinWordLength)
1873 propJSON (Proxy :: Proxy PhraseSlop)
1874 propJSON (Proxy :: Proxy MinDocFrequency)
1875 propJSON (Proxy :: Proxy MaxDocFrequency)
1876 propJSON (Proxy :: Proxy Filter)
1877 propJSON (Proxy :: Proxy Query)
1878 propJSON (Proxy :: Proxy SimpleQueryStringQuery)
1879 propJSON (Proxy :: Proxy FieldOrFields)
1880 propJSON (Proxy :: Proxy SimpleQueryFlag)
1881 propJSON (Proxy :: Proxy RegexpQuery)
1882 propJSON (Proxy :: Proxy QueryStringQuery)
1883 propJSON (Proxy :: Proxy RangeQuery)
1884 propJSON (Proxy :: Proxy PrefixQuery)
1885 propJSON (Proxy :: Proxy NestedQuery)
1886 propJSON (Proxy :: Proxy MoreLikeThisFieldQuery)
1887 propJSON (Proxy :: Proxy MoreLikeThisQuery)
1888 propJSON (Proxy :: Proxy IndicesQuery)
1889 propJSON (Proxy :: Proxy HasParentQuery)
1890 propJSON (Proxy :: Proxy HasChildQuery)
1891 propJSON (Proxy :: Proxy FuzzyQuery)
1892 propJSON (Proxy :: Proxy FuzzyLikeFieldQuery)
1893 propJSON (Proxy :: Proxy FuzzyLikeThisQuery)
1894 propJSON (Proxy :: Proxy FilteredQuery)
1895 propJSON (Proxy :: Proxy DisMaxQuery)
1896 propJSON (Proxy :: Proxy CommonTermsQuery)
1897 propJSON (Proxy :: Proxy CommonMinimumMatch)
1898 propJSON (Proxy :: Proxy BoostingQuery)
1899 propJSON (Proxy :: Proxy BoolQuery)
1900 propJSON (Proxy :: Proxy MatchQuery)
1901 propJSON (Proxy :: Proxy MultiMatchQueryType)
1902 propJSON (Proxy :: Proxy BooleanOperator)
1903 propJSON (Proxy :: Proxy ZeroTermsQuery)
1904 propJSON (Proxy :: Proxy MatchQueryType)
1905 propJSON (Proxy :: Proxy AliasRouting)
1906 propJSON (Proxy :: Proxy IndexAliasCreate)
1907 propJSON (Proxy :: Proxy SearchAliasRouting)
1908 propJSON (Proxy :: Proxy ScoreType)
1909 propJSON (Proxy :: Proxy Distance)
1910 propJSON (Proxy :: Proxy DistanceUnit)
1911 propJSON (Proxy :: Proxy DistanceType)
1912 propJSON (Proxy :: Proxy OptimizeBbox)
1913 propJSON (Proxy :: Proxy GeoBoundingBoxConstraint)
1914 propJSON (Proxy :: Proxy GeoFilterType)
1915 propJSON (Proxy :: Proxy GeoBoundingBox)
1916 propJSON (Proxy :: Proxy LatLon)
1917 propJSON (Proxy :: Proxy RangeExecution)
1918 prop "RegexpFlags FromJSON/ToJSON roundtrips, removing dups " $ \rfs ->
1919 let expected = case rfs of
1920 SomeRegexpFlags fs -> SomeRegexpFlags (NE.fromList (nub (NE.toList fs)))
1921 x -> x
1922 in parseEither parseJSON (toJSON rfs) === Right expected
1923 propJSON (Proxy :: Proxy BoolMatch)
1924 propJSON (Proxy :: Proxy Term)
1925 propJSON (Proxy :: Proxy MultiMatchQuery)
1926 propJSON (Proxy :: Proxy IndexSettings)
1927 propJSON (Proxy :: Proxy UpdatableIndexSetting')
1928 propJSON (Proxy :: Proxy ReplicaBounds)
1929 propJSON (Proxy :: Proxy Bytes)
1930 propJSON (Proxy :: Proxy AllocationPolicy)
1931 propJSON (Proxy :: Proxy InitialShardCount)
1932 propJSON (Proxy :: Proxy FSType)
1933 propJSON (Proxy :: Proxy CompoundFormat)
1934 propJSON (Proxy :: Proxy TemplateQueryInline)
1935 propJSON (Proxy :: Proxy Suggest)
1937-- Temporary solution for lacking of generic derivation of Arbitrary
1938-- We use generics-sop, as it's much more concise than directly using GHC.Generics
1940-- This will be unneeded after https://github.com/nick8325/quickcheck/pull/112
1941-- is merged and released
1942sopArbitrary :: forall a. (Generic a, SOP.GTo a, SOP.All SOP.SListI (SOP.GCode a), SOP.All2 Arbitrary (SOP.GCode a)) => Gen a
1943sopArbitrary = fmap SOP.gto sopArbitrary'
1945sopArbitrary' :: forall xss. (SOP.All SOP.SListI xss, SOP.All2 Arbitrary xss) => Gen (SOP.SOP SOP.I xss)
1946sopArbitrary' = SOP.hsequence =<< elements (SOP.apInjs_POP $ SOP.hcpure p arbitrary)
1947 where
1948 p :: Proxy Arbitrary
1949 p = Proxy