git.iko.soy/typeable/bloodhound
on faster-compile-auto-id help sign in
typeable/bloodhound/tests/V1/tests.hs
1960 lines 91 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
720#if MIN_VERSION_base(4,10,0)
721-- Test.QuickCheck.Modifiers
723qcNonEmptyToNonEmpty :: NonEmptyList a -> NonEmpty a
724qcNonEmptyToNonEmpty (NonEmpty (a : xs)) = (a :| xs)
725qcNonEmptyToNonEmpty (NonEmpty []) = error "NonEmpty was empty!"
727instance Arbitrary a => Arbitrary (NonEmpty a) where
728 arbitrary = qcNonEmptyToNonEmpty <$> arbitrary
729#endif
731instance Arbitrary RegexpFlags where
732 arbitrary = oneof [ pure AllRegexpFlags
733 , pure NoRegexpFlags
734 , SomeRegexpFlags <$> genUniqueFlags
735 ]
736 where genUniqueFlags = NE.fromList . nub <$> listOf1 arbitrary
737 shrink = genericShrink
740instance Arbitrary IndexAliasCreate where
741 arbitrary = IndexAliasCreate <$> arbitrary <*> reduceSize arbitrary
742 shrink = genericShrink
744instance Arbitrary Query where
745 arbitrary = reduceSize $ oneof [ TermQuery <$> arbitrary <*> arbitrary
746 , TermsQuery <$> arbitrary <*> arbitrary
747 , QueryMatchQuery <$> arbitrary
748 , QueryMultiMatchQuery <$> arbitrary
749 , QueryBoolQuery <$> arbitrary
750 , QueryBoostingQuery <$> arbitrary
751 , QueryCommonTermsQuery <$> arbitrary
752 , ConstantScoreFilter <$> arbitrary <*> arbitrary
753 , ConstantScoreQuery <$> arbitrary <*> arbitrary
754 , QueryDisMaxQuery <$> arbitrary
755 , QueryFilteredQuery <$> arbitrary
756 , QueryFuzzyLikeThisQuery <$> arbitrary
757 , QueryFuzzyLikeFieldQuery <$> arbitrary
758 , QueryFuzzyQuery <$> arbitrary
759 , QueryHasChildQuery <$> arbitrary
760 , QueryHasParentQuery <$> arbitrary
761 , IdsQuery <$> arbitrary <*> arbitrary
762 , QueryIndicesQuery <$> arbitrary
763 , MatchAllQuery <$> arbitrary
764 , QueryMoreLikeThisQuery <$> arbitrary
765 , QueryMoreLikeThisFieldQuery <$> arbitrary
766 , QueryNestedQuery <$> arbitrary
767 , QueryPrefixQuery <$> arbitrary
768 , QueryQueryStringQuery <$> arbitrary
769 , QuerySimpleQueryStringQuery <$> arbitrary
770 , QueryRangeQuery <$> arbitrary
771 , QueryRegexpQuery <$> arbitrary
772 , QueryTemplateQueryInline <$> arbitrary
773 ]
774 shrink = genericShrink
776instance Arbitrary Filter where
777 arbitrary = reduceSize $ oneof [ AndFilter <$> arbitrary <*> arbitrary
778 , OrFilter <$> arbitrary <*> arbitrary
779 , NotFilter <$> arbitrary <*> arbitrary
780 , pure IdentityFilter
781 , BoolFilter <$> arbitrary
782 , ExistsFilter <$> arbitrary
783 , GeoBoundingBoxFilter <$> arbitrary
784 , GeoDistanceFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
785 , GeoDistanceRangeFilter <$> arbitrary <*> arbitrary
786 , GeoPolygonFilter <$> arbitrary <*> arbitrary
787 , IdsFilter <$> arbitrary <*> arbitrary
788 , LimitFilter <$> arbitrary
789 , MissingFilter <$> arbitrary <*> arbitrary <*> arbitrary
790 , PrefixFilter <$> arbitrary <*> arbitrary <*> arbitrary
791 , QueryFilter <$> arbitrary <*> arbitrary
792 , RangeFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
793 , RegexpFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
794 , TermFilter <$> arbitrary <*> arbitrary]
795 shrink = genericShrink
797instance Arbitrary ReplicaBounds where
798 arbitrary = oneof [ replicasBounded
799 , replicasLowerBounded
800 , pure ReplicasUnbounded
801 ]
802 where replicasBounded = do Positive a <- arbitrary
803 Positive b <- arbitrary
804 return (ReplicasBounded a b)
805 replicasLowerBounded = do Positive a <- arbitrary
806 return (ReplicasLowerBounded a)
808instance Arbitrary NodeAttrName where
809 arbitrary = NodeAttrName . T.pack <$> listOf1 arbitraryAlphaNum
812instance Arbitrary NodeAttrFilter where
813 arbitrary = do
814 n <- arbitrary
815 s:ss <- listOf1 (listOf1 arbitraryAlphaNum)
816 let ts = T.pack <$> s :| ss
817 return (NodeAttrFilter n ts)
818 shrink = genericShrink
820instance Arbitrary VersionNumber where
821 arbitrary = mk . fmap getPositive . getNonEmpty <$> arbitrary
822 where
823 mk versions = VersionNumber (Vers.Version versions [])
825instance Arbitrary TemplateQueryKeyValuePairs where
826 arbitrary = TemplateQueryKeyValuePairs . HM.fromList <$> arbitrary
827 shrink (TemplateQueryKeyValuePairs x) = map (TemplateQueryKeyValuePairs . HM.fromList) . shrink $ HM.toList x
829instance Arbitrary IndexName where arbitrary = sopArbitrary; shrink = genericShrink
830instance Arbitrary MappingName where arbitrary = sopArbitrary; shrink = genericShrink
831instance Arbitrary DocId where arbitrary = sopArbitrary; shrink = genericShrink
832instance Arbitrary Version where arbitrary = sopArbitrary; shrink = genericShrink
833instance Arbitrary BuildHash where arbitrary = sopArbitrary; shrink = genericShrink
834instance Arbitrary IndexAliasRouting where arbitrary = sopArbitrary; shrink = genericShrink
835instance Arbitrary ShardCount where arbitrary = sopArbitrary; shrink = genericShrink
836instance Arbitrary ReplicaCount where arbitrary = sopArbitrary; shrink = genericShrink
837instance Arbitrary TemplateName where arbitrary = sopArbitrary; shrink = genericShrink
838instance Arbitrary TemplatePattern where arbitrary = sopArbitrary; shrink = genericShrink
839instance Arbitrary QueryString where arbitrary = sopArbitrary; shrink = genericShrink
840instance Arbitrary CacheName where arbitrary = sopArbitrary; shrink = genericShrink
841instance Arbitrary CacheKey where arbitrary = sopArbitrary; shrink = genericShrink
842instance Arbitrary Existence where arbitrary = sopArbitrary; shrink = genericShrink
843instance Arbitrary CutoffFrequency where arbitrary = sopArbitrary; shrink = genericShrink
844instance Arbitrary Analyzer where arbitrary = sopArbitrary; shrink = genericShrink
845instance Arbitrary MaxExpansions where arbitrary = sopArbitrary; shrink = genericShrink
846instance Arbitrary Lenient where arbitrary = sopArbitrary; shrink = genericShrink
847instance Arbitrary Tiebreaker where arbitrary = sopArbitrary; shrink = genericShrink
848instance Arbitrary Boost where arbitrary = sopArbitrary; shrink = genericShrink
849instance Arbitrary BoostTerms where arbitrary = sopArbitrary; shrink = genericShrink
850instance Arbitrary MinimumMatch where arbitrary = sopArbitrary; shrink = genericShrink
851instance Arbitrary DisableCoord where arbitrary = sopArbitrary; shrink = genericShrink
852instance Arbitrary IgnoreTermFrequency where arbitrary = sopArbitrary; shrink = genericShrink
853instance Arbitrary MinimumTermFrequency where arbitrary = sopArbitrary; shrink = genericShrink
854instance Arbitrary MaxQueryTerms where arbitrary = sopArbitrary; shrink = genericShrink
855instance Arbitrary Fuzziness where arbitrary = sopArbitrary; shrink = genericShrink
856instance Arbitrary PrefixLength where arbitrary = sopArbitrary; shrink = genericShrink
857instance Arbitrary TypeName where arbitrary = sopArbitrary; shrink = genericShrink
858instance Arbitrary PercentMatch where arbitrary = sopArbitrary; shrink = genericShrink
859instance Arbitrary StopWord where arbitrary = sopArbitrary; shrink = genericShrink
860instance Arbitrary QueryPath where arbitrary = sopArbitrary; shrink = genericShrink
861instance Arbitrary AllowLeadingWildcard where arbitrary = sopArbitrary; shrink = genericShrink
862instance Arbitrary LowercaseExpanded where arbitrary = sopArbitrary; shrink = genericShrink
863instance Arbitrary EnablePositionIncrements where arbitrary = sopArbitrary; shrink = genericShrink
864instance Arbitrary AnalyzeWildcard where arbitrary = sopArbitrary; shrink = genericShrink
865instance Arbitrary GeneratePhraseQueries where arbitrary = sopArbitrary; shrink = genericShrink
866instance Arbitrary Locale where arbitrary = sopArbitrary; shrink = genericShrink
867instance Arbitrary MaxWordLength where arbitrary = sopArbitrary; shrink = genericShrink
868instance Arbitrary MinWordLength where arbitrary = sopArbitrary; shrink = genericShrink
869instance Arbitrary PhraseSlop where arbitrary = sopArbitrary; shrink = genericShrink
870instance Arbitrary MinDocFrequency where arbitrary = sopArbitrary; shrink = genericShrink
871instance Arbitrary MaxDocFrequency where arbitrary = sopArbitrary; shrink = genericShrink
872instance Arbitrary Regexp where arbitrary = sopArbitrary; shrink = genericShrink
873instance Arbitrary SimpleQueryStringQuery where arbitrary = sopArbitrary; shrink = genericShrink
874instance Arbitrary FieldOrFields where arbitrary = sopArbitrary; shrink = genericShrink
875instance Arbitrary SimpleQueryFlag where arbitrary = sopArbitrary; shrink = genericShrink
876instance Arbitrary RegexpQuery where arbitrary = sopArbitrary; shrink = genericShrink
877instance Arbitrary QueryStringQuery where arbitrary = sopArbitrary; shrink = genericShrink
878instance Arbitrary RangeQuery where arbitrary = sopArbitrary; shrink = genericShrink
879instance Arbitrary RangeValue where arbitrary = sopArbitrary; shrink = genericShrink
880instance Arbitrary PrefixQuery where arbitrary = sopArbitrary; shrink = genericShrink
881instance Arbitrary NestedQuery where arbitrary = sopArbitrary; shrink = genericShrink
882instance Arbitrary MoreLikeThisFieldQuery where arbitrary = sopArbitrary; shrink = genericShrink
883instance Arbitrary MoreLikeThisQuery where arbitrary = sopArbitrary; shrink = genericShrink
884instance Arbitrary IndicesQuery where arbitrary = sopArbitrary; shrink = genericShrink
885instance Arbitrary HasParentQuery where arbitrary = sopArbitrary; shrink = genericShrink
886instance Arbitrary HasChildQuery where arbitrary = sopArbitrary; shrink = genericShrink
887instance Arbitrary FuzzyQuery where arbitrary = sopArbitrary; shrink = genericShrink
888instance Arbitrary FuzzyLikeFieldQuery where arbitrary = sopArbitrary; shrink = genericShrink
889instance Arbitrary FuzzyLikeThisQuery where arbitrary = sopArbitrary; shrink = genericShrink
890instance Arbitrary FilteredQuery where arbitrary = sopArbitrary; shrink = genericShrink
891instance Arbitrary DisMaxQuery where arbitrary = sopArbitrary; shrink = genericShrink
892instance Arbitrary CommonTermsQuery where arbitrary = sopArbitrary; shrink = genericShrink
893instance Arbitrary DistanceRange where arbitrary = sopArbitrary; shrink = genericShrink
894instance Arbitrary MultiMatchQuery where arbitrary = sopArbitrary; shrink = genericShrink
895instance Arbitrary LessThanD where arbitrary = sopArbitrary; shrink = genericShrink
896instance Arbitrary LessThanEqD where arbitrary = sopArbitrary; shrink = genericShrink
897instance Arbitrary GreaterThanD where arbitrary = sopArbitrary; shrink = genericShrink
898instance Arbitrary GreaterThanEqD where arbitrary = sopArbitrary; shrink = genericShrink
899instance Arbitrary LessThan where arbitrary = sopArbitrary; shrink = genericShrink
900instance Arbitrary LessThanEq where arbitrary = sopArbitrary; shrink = genericShrink
901instance Arbitrary GreaterThan where arbitrary = sopArbitrary; shrink = genericShrink
902instance Arbitrary GreaterThanEq where arbitrary = sopArbitrary; shrink = genericShrink
903instance Arbitrary GeoPoint where
904 arbitrary = GeoPoint <$> (arbitrary `suchThat` reasonableFieldName) <*> arbitrary
905 where
906 -- These are problematic for geopoint for obvious reasons
907 reasonableFieldName (FieldName "from") = False
908 reasonableFieldName (FieldName "to") = False
909 reasonableFieldName _ = True
910 shrink = genericShrink
911instance Arbitrary NullValue where arbitrary = sopArbitrary; shrink = genericShrink
912instance Arbitrary MinimumMatchHighLow where arbitrary = sopArbitrary; shrink = genericShrink
913instance Arbitrary CommonMinimumMatch where arbitrary = sopArbitrary; shrink = genericShrink
914instance Arbitrary BoostingQuery where arbitrary = sopArbitrary; shrink = genericShrink
915instance Arbitrary BoolQuery where arbitrary = sopArbitrary; shrink = genericShrink
916instance Arbitrary MatchQuery where arbitrary = sopArbitrary; shrink = genericShrink
917instance Arbitrary MultiMatchQueryType where arbitrary = sopArbitrary; shrink = genericShrink
918instance Arbitrary BooleanOperator where arbitrary = sopArbitrary; shrink = genericShrink
919instance Arbitrary ZeroTermsQuery where arbitrary = sopArbitrary; shrink = genericShrink
920instance Arbitrary MatchQueryType where arbitrary = sopArbitrary; shrink = genericShrink
921instance Arbitrary SearchAliasRouting where arbitrary = sopArbitrary; shrink = genericShrink
922instance Arbitrary ScoreType where arbitrary = sopArbitrary; shrink = genericShrink
923instance Arbitrary Distance where arbitrary = sopArbitrary; shrink = genericShrink
924instance Arbitrary DistanceUnit where arbitrary = sopArbitrary; shrink = genericShrink
925instance Arbitrary DistanceType where arbitrary = sopArbitrary; shrink = genericShrink
926instance Arbitrary OptimizeBbox where arbitrary = sopArbitrary; shrink = genericShrink
927instance Arbitrary GeoBoundingBoxConstraint where arbitrary = sopArbitrary; shrink = genericShrink
928instance Arbitrary GeoFilterType where arbitrary = sopArbitrary; shrink = genericShrink
929instance Arbitrary GeoBoundingBox where arbitrary = sopArbitrary; shrink = genericShrink
930instance Arbitrary LatLon where arbitrary = sopArbitrary; shrink = genericShrink
931instance Arbitrary RangeExecution where arbitrary = sopArbitrary; shrink = genericShrink
932instance Arbitrary RegexpFlag where arbitrary = sopArbitrary; shrink = genericShrink
933instance Arbitrary BoolMatch where arbitrary = sopArbitrary; shrink = genericShrink
934instance Arbitrary Term where arbitrary = sopArbitrary; shrink = genericShrink
935instance Arbitrary IndexSettings where arbitrary = sopArbitrary; shrink = genericShrink
936instance Arbitrary UpdatableIndexSetting where arbitrary = sopArbitrary; shrink = genericShrink
937instance Arbitrary Bytes where arbitrary = sopArbitrary; shrink = genericShrink
938instance Arbitrary AllocationPolicy where arbitrary = sopArbitrary; shrink = genericShrink
939instance Arbitrary InitialShardCount where arbitrary = sopArbitrary; shrink = genericShrink
940instance Arbitrary FSType where arbitrary = sopArbitrary; shrink = genericShrink
941instance Arbitrary CompoundFormat where arbitrary = sopArbitrary; shrink = genericShrink
942instance Arbitrary FsSnapshotRepo where arbitrary = sopArbitrary; shrink = genericShrink
943instance Arbitrary SnapshotRepoName where arbitrary = sopArbitrary; shrink = genericShrink
944instance Arbitrary TemplateQueryInline where arbitrary = sopArbitrary; shrink = genericShrink
945instance Arbitrary PhraseSuggesterCollate where arbitrary = sopArbitrary; shrink = genericShrink
946instance Arbitrary PhraseSuggesterHighlighter where arbitrary = sopArbitrary; shrink = genericShrink
947instance Arbitrary Size where arbitrary = sopArbitrary; shrink = genericShrink
948instance Arbitrary PhraseSuggester where arbitrary = sopArbitrary; shrink = genericShrink
949instance Arbitrary SuggestType where arbitrary = sopArbitrary; shrink = genericShrink
950instance Arbitrary Suggest where arbitrary = sopArbitrary; shrink = genericShrink
952newtype UpdatableIndexSetting' = UpdatableIndexSetting' UpdatableIndexSetting
953 deriving (Show, Eq, ToJSON, FromJSON, ApproxEq, Typeable)
955instance Arbitrary UpdatableIndexSetting' where
956 arbitrary = do
957 settings <- arbitrary
958 return $ UpdatableIndexSetting' $ case settings of
959 RoutingAllocationInclude xs -> RoutingAllocationInclude (dropDuplicateAttrNames xs)
960 RoutingAllocationExclude xs -> RoutingAllocationExclude (dropDuplicateAttrNames xs)
961 RoutingAllocationRequire xs -> RoutingAllocationRequire (dropDuplicateAttrNames xs)
962 x -> x
963 where
964 dropDuplicateAttrNames = NE.fromList . L.nubBy sameAttrName . NE.toList
965 sameAttrName a b = nodeAttrFilterName a == nodeAttrFilterName b
967main :: IO ()
968main = hspec $ do
970 describe "index create/delete API" $ do
971 it "creates and then deletes the requested index" $ withTestEnv $ do
972 -- priming state.
973 _ <- deleteExampleIndex
974 resp <- createExampleIndex
975 deleteResp <- deleteExampleIndex
976 liftIO $ do
977 validateStatus resp 200
978 validateStatus deleteResp 200
980 describe "error parsing" $ do
981 it "can parse EsErrors for < 2.0" $ when' (atmost es16) $ withTestEnv $ do
982 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
983 let errorResp = eitherDecode (responseBody res)
984 liftIO (errorResp `shouldBe` Right (EsError 404 "IndexMissingException[[bogus] missing]"))
986 it "can parse EsErrors for >= 2.0" $ when' (atleast es20) $ withTestEnv $ do
987 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
988 let errorResp = eitherDecode (responseBody res)
989 liftIO (errorResp `shouldBe` Right (EsError 404 "no such index"))
991 describe "document API" $ do
992 it "indexes, updates, gets, and then deletes the generated document" $ withTestEnv $ do
993 _ <- insertData
994 _ <- updateData
995 docInserted <- getDocument testIndex testMapping (DocId "1")
996 let newTweet = eitherDecode
997 (responseBody docInserted) :: Either String (EsResult Tweet)
998 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just patchedTweet))
1000 it "indexes, gets, and then deletes the generated document with a DocId containing a space" $ withTestEnv $ do
1001 _ <- insertWithSpaceInId
1002 docInserted <- getDocument testIndex testMapping (DocId "Hello World")
1003 let newTweet = eitherDecode
1004 (responseBody docInserted) :: Either String (EsResult Tweet)
1005 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))
1007 it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do
1008 doc <- getDocument testIndex testMapping (DocId "bogus")
1009 let noTweet = eitherDecode
1010 (responseBody doc) :: Either String (EsResult Tweet)
1011 liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing
1013 it "can use optimistic concurrency control" $ withTestEnv $ do
1014 let ev = ExternalDocVersion minBound
1015 let cfg = defaultIndexDocumentSettings { idsVersionControl = ExternalGT ev }
1016 resetIndex
1017 res <- insertData' cfg
1018 liftIO $ isCreated res `shouldBe` True
1019 res' <- insertData' cfg
1020 liftIO $ isVersionConflict res' `shouldBe` True
1022 it "indexes two documents in a parent/child relationship and checks that the child exists" $ withTestEnv $ do
1023 resetIndex
1024 _ <- putMapping testIndex (MappingName "child") ChildMapping
1025 _ <- putMapping testIndex (MappingName "parent") ParentMapping
1026 _ <- indexDocument testIndex (MappingName "parent") defaultIndexDocumentSettings exampleTweet (DocId "1")
1027 let parent = (Just . DocumentParent . DocId) "1"
1028 ids = IndexDocumentSettings NoVersionControl parent
1029 _ <- indexDocument testIndex (MappingName "child") ids otherTweet (DocId "2")
1030 _ <- refreshIndex testIndex
1031 exists <- documentExists testIndex (MappingName "child") parent (DocId "2")
1032 liftIO $ exists `shouldBe` True
1034 describe "template API" $ do
1035 it "can create a template" $ withTestEnv $ do
1036 let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
1037 resp <- putTemplate idxTpl (TemplateName "tweet-tpl")
1038 liftIO $ validateStatus resp 200
1040 it "can detect if a template exists" $ withTestEnv $ do
1041 exists <- templateExists (TemplateName "tweet-tpl")
1042 liftIO $ exists `shouldBe` True
1044 it "can delete a template" $ withTestEnv $ do
1045 resp <- deleteTemplate (TemplateName "tweet-tpl")
1046 liftIO $ validateStatus resp 200
1048 it "can detect if a template doesn't exist" $ withTestEnv $ do
1049 exists <- templateExists (TemplateName "tweet-tpl")
1050 liftIO $ exists `shouldBe` False
1052 describe "bulk API" $ do
1053 it "inserts all documents we request" $ withTestEnv $ do
1054 _ <- insertData
1055 let firstTest = BulkTest "blah"
1056 let secondTest = BulkTest "bloo"
1057 let firstDoc = BulkIndex testIndex
1058 testMapping (DocId "2") (toJSON firstTest)
1059 let secondDoc = BulkCreate testIndex
1060 testMapping (DocId "3") (toJSON secondTest)
1061 let stream = V.fromList [firstDoc, secondDoc]
1062 _ <- bulk stream
1063 _ <- refreshIndex testIndex
1064 fDoc <- getDocument testIndex testMapping (DocId "2")
1065 sDoc <- getDocument testIndex testMapping (DocId "3")
1066 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
1067 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
1068 liftIO $ do
1069 fmap getSource maybeFirst `shouldBe` Right (Just firstTest)
1070 fmap getSource maybeSecond `shouldBe` Right (Just secondTest)
1073 describe "query API" $ do
1074 it "returns document for term query and identity filter" $ withTestEnv $ do
1075 _ <- insertData
1076 let query = TermQuery (Term "user" "bitemyapp") Nothing
1077 let filter = IdentityFilter <&&> IdentityFilter
1078 let search = mkSearch (Just query) (Just filter)
1079 myTweet <- searchTweet search
1080 liftIO $
1081 myTweet `shouldBe` Right exampleTweet
1083 it "handles constant score queries" $ withTestEnv $ do
1084 _ <- insertData
1085 let query = TermsQuery "user" ("bitemyapp" :| [])
1086 let cfQuery = ConstantScoreQuery query (Boost 1.0)
1087 let filter = IdentityFilter
1088 let search = mkSearch (Just cfQuery) (Just filter)
1089 myTweet <- searchTweet search
1090 liftIO $
1091 myTweet `shouldBe` Right exampleTweet
1092 it "handles constant score filters" $ withTestEnv $ do
1093 _ <- insertData
1094 let query = TermsQuery "user" ("bitemyapp" :| [])
1095 let cfFilter = ConstantScoreFilter IdentityFilter (Boost 1.0)
1096 let boolQuery = mkBoolQuery [query, cfFilter] [] []
1097 let search = mkSearch (Just (QueryBoolQuery boolQuery)) Nothing
1098 myTweet <- searchTweet search
1099 liftIO $
1100 myTweet `shouldBe` Right exampleTweet
1103 it "returns document for terms query and identity filter" $ withTestEnv $ do
1104 _ <- insertData
1105 let query = TermsQuery "user" ("bitemyapp" :| [])
1106 let filter = IdentityFilter <&&> IdentityFilter
1107 let search = mkSearch (Just query) (Just filter)
1108 myTweet <- searchTweet search
1109 liftIO $
1110 myTweet `shouldBe` Right exampleTweet
1112 it "returns document for match query" $ withTestEnv $ do
1113 _ <- insertData
1114 let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1115 let search = mkSearch (Just query) Nothing
1116 myTweet <- searchTweet search
1117 liftIO $
1118 myTweet `shouldBe` Right exampleTweet
1120 it "returns document for multi-match query" $ withTestEnv $ do
1121 _ <- insertData
1122 let flds = [FieldName "user", FieldName "message"]
1123 let query = QueryMultiMatchQuery $ mkMultiMatchQuery flds (QueryString "bitemyapp")
1124 let search = mkSearch (Just query) Nothing
1125 myTweet <- searchTweet search
1126 liftIO $
1127 myTweet `shouldBe` Right exampleTweet
1129 it "returns document for multi-match query with a custom tiebreaker" $ withTestEnv $ do
1130 _ <- insertData
1131 let tiebreaker = Just $ Tiebreaker 0.3
1132 flds = [FieldName "user", FieldName "message"]
1133 multiQuery' = mkMultiMatchQuery flds (QueryString "bitemyapp")
1134 query = QueryMultiMatchQuery $ multiQuery' { multiMatchQueryTiebreaker = tiebreaker }
1135 search = mkSearch (Just query) Nothing
1136 myTweet <- searchTweet search
1137 liftIO $
1138 myTweet `shouldBe` Right exampleTweet
1140 it "returns document for bool query" $ withTestEnv $ do
1141 _ <- insertData
1142 let innerQuery = QueryMatchQuery $
1143 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1144 let query = QueryBoolQuery $
1145 mkBoolQuery [innerQuery] [] []
1146 let search = mkSearch (Just query) Nothing
1147 myTweet <- searchTweet search
1148 liftIO $
1149 myTweet `shouldBe` Right exampleTweet
1151 it "returns document for boosting query" $ withTestEnv $ do
1152 _ <- insertData
1153 let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1154 let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
1155 let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
1156 let search = mkSearch (Just query) Nothing
1157 myTweet <- searchTweet search
1158 liftIO $
1159 myTweet `shouldBe` Right exampleTweet
1161 it "returns document for common terms query" $ withTestEnv $ do
1162 _ <- insertData
1163 let query = QueryCommonTermsQuery $
1164 CommonTermsQuery (FieldName "user")
1165 (QueryString "bitemyapp")
1166 (CutoffFrequency 0.0001)
1167 Or Or Nothing Nothing Nothing Nothing
1168 let search = mkSearch (Just query) Nothing
1169 myTweet <- searchTweet search
1170 liftIO $
1171 myTweet `shouldBe` Right exampleTweet
1173 it "returns document for for inline template query" $ withTestEnv $ do
1174 _ <- insertData
1175 let innerQuery = QueryMatchQuery $
1176 mkMatchQuery (FieldName "{{userKey}}")
1177 (QueryString "{{bitemyappKey}}")
1178 templateParams = TemplateQueryKeyValuePairs $ HM.fromList
1179 [ ("userKey", "user")
1180 , ("bitemyappKey", "bitemyapp")
1182 templateQuery = QueryTemplateQueryInline $
1183 TemplateQueryInline innerQuery templateParams
1184 search = mkSearch (Just templateQuery) Nothing
1185 myTweet <- searchTweet search
1186 liftIO $ myTweet `shouldBe` Right exampleTweet
1189 describe "sorting" $ do
1190 it "returns documents in the right order" $ withTestEnv $ do
1191 _ <- insertData
1192 _ <- insertOther
1193 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
1194 let search = Search Nothing
1195 (Just IdentityFilter) (Just [sortSpec]) Nothing Nothing
1196 False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
1197 Nothing
1198 result <- searchTweets search
1199 let myTweet = grabFirst result
1200 liftIO $
1201 myTweet `shouldBe` Right otherTweet
1204 describe "filtering API" $ do
1205 it "returns document for composed boolmatch and identity" $ withTestEnv $ do
1206 _ <- insertData
1207 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
1208 <&&> IdentityFilter
1209 let search = mkSearch Nothing (Just queryFilter)
1210 myTweet <- searchTweet search
1211 liftIO $
1212 myTweet `shouldBe` Right exampleTweet
1214 it "returns document for term filter" $ withTestEnv $ do
1215 _ <- insertData
1216 let termFilter = TermFilter (Term "user" "bitemyapp") False
1217 let search = mkSearch Nothing (Just termFilter)
1218 myTweet <- searchTweet search
1219 liftIO $
1220 myTweet `shouldBe` Right exampleTweet
1222 it "returns document for existential filter" $ withTestEnv $ do
1223 _ <- insertData
1224 let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
1225 myTweet <- searchTweet search
1226 liftIO $
1227 myTweet `shouldBe` Right exampleTweet
1229 it "returns document for geo boundingbox filter" $ withTestEnv $ do
1230 _ <- insertData
1231 let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
1232 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
1233 let geoFilter = GeoBoundingBoxFilter bbConstraint
1234 let search = mkSearch Nothing (Just geoFilter)
1235 myTweet <- searchTweet search
1236 liftIO $
1237 myTweet `shouldBe` Right exampleTweet
1239 it "doesn't return document for nonsensical boundingbox filter" $ withTestEnv $ do
1240 _ <- insertData
1241 let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
1242 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
1243 let geoFilter = GeoBoundingBoxFilter bbConstraint
1244 let search = mkSearch Nothing (Just geoFilter)
1245 searchExpectNoResults search
1247 it "returns document for geo distance filter" $ withTestEnv $ do
1248 _ <- insertData
1249 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1250 let distance = Distance 10.0 Miles
1251 let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
1252 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
1253 let search = mkSearch Nothing (Just geoFilter)
1254 myTweet <- searchTweet search
1255 liftIO $
1256 myTweet `shouldBe` Right exampleTweet
1258 it "returns document for geo distance range filter" $ withTestEnv $ do
1259 _ <- insertData
1260 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1261 let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
1262 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
1263 let search = mkSearch Nothing (Just geoFilter)
1264 myTweet <- searchTweet search
1265 liftIO $
1266 myTweet `shouldBe` Right exampleTweet
1268 it "doesn't return document for wild geo distance range filter" $ withTestEnv $ do
1269 _ <- insertData
1270 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1271 let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
1272 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
1273 let search = mkSearch Nothing (Just geoFilter)
1274 searchExpectNoResults search
1276 it "returns document for geo polygon filter" $ withTestEnv $ do
1277 _ <- insertData
1278 let points = [LatLon 40.0 (-70.00),
1279 LatLon 40.0 (-72.00),
1280 LatLon 41.0 (-70.00),
1281 LatLon 41.0 (-72.00)]
1282 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
1283 let search = mkSearch Nothing (Just geoFilter)
1284 myTweet <- searchTweet search
1285 liftIO $
1286 myTweet `shouldBe` Right exampleTweet
1288 it "doesn't return document for bad geo polygon filter" $ withTestEnv $ do
1289 _ <- insertData
1290 let points = [LatLon 40.0 (-70.00),
1291 LatLon 40.0 (-71.00),
1292 LatLon 41.0 (-70.00),
1293 LatLon 41.0 (-71.00)]
1294 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
1295 let search = mkSearch Nothing (Just geoFilter)
1296 searchExpectNoResults search
1298 it "returns document for ids filter" $ withTestEnv $ do
1299 _ <- insertData
1300 let filter = IdsFilter (MappingName "tweet") [DocId "1"]
1301 let search = mkSearch Nothing (Just filter)
1302 myTweet <- searchTweet search
1303 liftIO $
1304 myTweet `shouldBe` Right exampleTweet
1306 it "returns document for Double range filter" $ withTestEnv $ do
1307 _ <- insertData
1308 let filter = RangeFilter (FieldName "age")
1309 (RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))
1310 RangeExecutionIndex False
1311 let search = mkSearch Nothing (Just filter)
1312 myTweet <- searchTweet search
1313 liftIO $
1314 myTweet `shouldBe` Right exampleTweet
1316 it "returns document for UTCTime date filter" $ withTestEnv $ do
1317 _ <- insertData
1318 let filter = RangeFilter (FieldName "postDate")
1319 (RangeDateGtLt
1320 (GreaterThanD (UTCTime
1321 (ModifiedJulianDay 54000)
1322 (secondsToDiffTime 0)))
1323 (LessThanD (UTCTime
1324 (ModifiedJulianDay 55000)
1325 (secondsToDiffTime 11))))
1326 RangeExecutionIndex False
1327 let search = mkSearch Nothing (Just filter)
1328 myTweet <- searchTweet search
1329 liftIO $
1330 myTweet `shouldBe` Right exampleTweet
1332 it "returns document for regexp filter" $ withTestEnv $ do
1333 _ <- insertData
1334 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
1335 AllRegexpFlags (CacheName "test") False (CacheKey "key")
1336 let search = mkSearch Nothing (Just filter)
1337 myTweet <- searchTweet search
1338 liftIO $
1339 myTweet `shouldBe` Right exampleTweet
1341 it "doesn't return document for non-matching regexp filter" $ withTestEnv $ do
1342 _ <- insertData
1343 let filter = RegexpFilter (FieldName "user")
1344 (Regexp "boy") AllRegexpFlags
1345 (CacheName "test") False (CacheKey "key")
1346 let search = mkSearch Nothing (Just filter)
1347 searchExpectNoResults search
1349 it "returns document for query filter, uncached" $ withTestEnv $ do
1350 _ <- insertData
1351 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) True
1352 search = mkSearch Nothing (Just filter)
1353 myTweet <- searchTweet search
1354 liftIO $ myTweet `shouldBe` Right exampleTweet
1356 it "returns document for query filter, cached" $ withTestEnv $ do
1357 _ <- insertData
1358 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) False
1359 search = mkSearch Nothing (Just filter)
1360 myTweet <- searchTweet search
1361 liftIO $ myTweet `shouldBe` Right exampleTweet
1363 describe "Aggregation API" $ do
1364 it "returns term aggregation results" $ withTestEnv $ do
1365 _ <- insertData
1366 let terms = TermsAgg $ mkTermsAggregation "user"
1367 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1368 searchExpectAggs search
1369 searchValidBucketAgg search "users" toTerms
1371 it "return sub-aggregation results" $ withTestEnv $ do
1372 _ <- insertData
1373 let subaggs = mkAggregations "age_agg" . TermsAgg $ mkTermsAggregation "age"
1374 agg = TermsAgg $ (mkTermsAggregation "user") { termAggs = Just subaggs}
1375 search = mkAggregateSearch Nothing $ mkAggregations "users" agg
1376 reply <- searchByIndex testIndex search
1377 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
1378 usersAggResults = result >>= aggregations >>= toTerms "users"
1379 subAggResults = usersAggResults >>= (listToMaybe . buckets) >>= termsAggs >>= toTerms "age_agg"
1380 subAddResultsExists = isJust subAggResults
1381 liftIO $ (subAddResultsExists) `shouldBe` True
1383 it "returns cardinality aggregation results" $ withTestEnv $ do
1384 _ <- insertData
1385 let cardinality = CardinalityAgg $ mkCardinalityAggregation $ FieldName "user"
1386 let search = mkAggregateSearch Nothing $ mkAggregations "users" cardinality
1387 let search' = search { Database.V1.Bloodhound.from = From 0, size = Size 0 }
1388 searchExpectAggs search'
1389 let docCountPair k n = (k, object ["value" .= Number n])
1390 res <- searchTweets search'
1391 liftIO $
1392 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "users" 1]))
1394 it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
1395 _ <- insertData
1396 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
1397 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1398 searchExpectAggs search
1399 searchValidBucketAgg search "users" toTerms
1401 -- One of these fails with 1.7.3
1402 it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
1403 _ <- insertData
1404 searchTermsAggHint [Map, Ordinals]
1406 it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do
1407 _ <- insertData
1408 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
1410 it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
1411 _ <- insertData
1412 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
1413 -- One of the above.
1415 it "can execute value_count aggregations" $ withTestEnv $ do
1416 _ <- insertData
1417 _ <- insertOther
1418 let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>
1419 mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))
1420 let search = mkAggregateSearch Nothing ags
1421 let docCountPair k n = (k, object ["value" .= Number n])
1422 res <- searchTweets search
1423 liftIO $
1424 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2
1425 , docCountPair "bogus_count" 0
1426 ]))
1428 it "can execute filter aggregations" $ withTestEnv $ do
1429 _ <- insertData
1430 _ <- insertOther
1431 let ags = mkAggregations "bitemyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "bitemyapp") defaultCache) Nothing)) <>
1432 mkAggregations "notmyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "notmyapp") defaultCache) Nothing))
1433 let search = mkAggregateSearch Nothing ags
1434 let docCountPair k n = (k, object ["doc_count" .= Number n])
1435 res <- searchTweets search
1436 liftIO $
1437 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "bitemyapps" 1
1438 , docCountPair "notmyapps" 1
1439 ]))
1440 it "can execute date_range aggregations" $ withTestEnv $ do
1441 let now = fromGregorian 2015 3 14
1442 let ltAMonthAgo = UTCTime (fromGregorian 2015 3 1) 0
1443 let ltAWeekAgo = UTCTime (fromGregorian 2015 3 10) 0
1444 let oldDoc = exampleTweet { postDate = ltAMonthAgo }
1445 let newDoc = exampleTweet { postDate = ltAWeekAgo }
1446 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings oldDoc (DocId "1")
1447 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings newDoc (DocId "2")
1448 _ <- refreshIndex testIndex
1449 let thisMonth = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMMonth])
1450 let thisWeek = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMWeek])
1451 let agg = DateRangeAggregation (FieldName "postDate") Nothing (thisMonth :| [thisWeek])
1452 let ags = mkAggregations "date_ranges" (DateRangeAgg agg)
1453 let search = mkAggregateSearch Nothing ags
1454 res <- searchTweets search
1455 liftIO $ hitsTotal . searchHits <$> res `shouldBe` Right 2
1456 let bucks = do magrs <- fmapL show (aggregations <$> res)
1457 agrs <- note "no aggregations returned" magrs
1458 rawBucks <- note "no date_ranges aggregation" $ M.lookup "date_ranges" agrs
1459 parseEither parseJSON rawBucks
1460 let fromMonthT = UTCTime (fromGregorian 2015 2 14) 0
1461 let fromWeekT = UTCTime (fromGregorian 2015 3 7) 0
1462 liftIO $ buckets <$> bucks `shouldBe` Right [ DateRangeResult "2015-02-14T00:00:00.000Z-*"
1463 (Just fromMonthT)
1464 (Just "2015-02-14T00:00:00.000Z")
1465 Nothing
1466 Nothing
1468 Nothing
1469 , DateRangeResult "2015-03-07T00:00:00.000Z-*"
1470 (Just fromWeekT)
1471 (Just "2015-03-07T00:00:00.000Z")
1472 Nothing
1473 Nothing
1475 Nothing
1478 it "returns date histogram aggregation results" $ withTestEnv $ do
1479 _ <- insertData
1480 let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
1481 let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
1482 searchExpectAggs search
1483 searchValidBucketAgg search "byDate" toDateHistogram
1485 it "returns date histogram using fractional date" $ withTestEnv $ do
1486 _ <- insertData
1487 let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]
1488 let fractionals = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]
1489 let intervals = periods ++ fractionals
1490 let histogram = mkDateHistogram (FieldName "postDate")
1491 let search interval = mkAggregateSearch Nothing $ mkAggregations "byDate" $ DateHistogramAgg (histogram interval)
1492 let expect interval = searchExpectAggs (search interval)
1493 let valid interval = searchValidBucketAgg (search interval) "byDate" toDateHistogram
1494 forM_ intervals expect
1495 forM_ intervals valid
1497 it "can execute missing aggregations" $ withTestEnv $ do
1498 _ <- insertData
1499 _ <- insertExtra
1500 let ags = mkAggregations "missing_agg" (MissingAgg (MissingAggregation "extra"))
1501 let search = mkAggregateSearch Nothing ags
1502 let docCountPair k n = (k, object ["doc_count" .= Number n])
1503 res <- searchTweets search
1504 liftIO $
1505 fmap aggregations res `shouldBe` Right (Just (M.fromList [docCountPair "missing_agg" 1]))
1507 describe "Highlights API" $ do
1509 it "returns highlight from query when there should be one" $ withTestEnv $ do
1510 _ <- insertData
1511 _ <- insertOther
1512 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1513 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
1515 let search = mkHighlightSearch (Just query) testHighlight
1516 myHighlight <- searchTweetHighlight search
1517 liftIO $
1518 myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
1520 it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
1521 _ <- insertData
1522 _ <- insertOther
1523 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1524 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "user") Nothing]
1526 let search = mkHighlightSearch (Just query) testHighlight
1527 myHighlight <- searchTweetHighlight search
1528 liftIO $
1529 myHighlight `shouldBe` Right Nothing
1531 describe "Source filtering" $ do
1533 it "doesn't include source when sources are disabled" $ withTestEnv $ do
1534 searchExpectSource
1535 NoSource
1536 (Left (EsError 500 "Source was missing"))
1538 it "includes a source" $ withTestEnv $ do
1539 searchExpectSource
1540 (SourcePatterns (PopPattern (Pattern "message")))
1541 (Right (Object (HM.fromList [("message", String "Use haskell!")])))
1543 it "includes sources" $ withTestEnv $ do
1544 searchExpectSource
1545 (SourcePatterns (PopPatterns [Pattern "user", Pattern "message"]))
1546 (Right (Object (HM.fromList [("user",String "bitemyapp"),("message", String "Use haskell!")])))
1548 it "includes source patterns" $ withTestEnv $ do
1549 searchExpectSource
1550 (SourcePatterns (PopPattern (Pattern "*ge")))
1551 (Right (Object (HM.fromList [("age", Number 10000),("message", String "Use haskell!")])))
1553 it "excludes source patterns" $ withTestEnv $ do
1554 searchExpectSource
1555 (SourceIncludeExclude (Include [])
1556 (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate", Pattern "extra"]))
1557 (Right (Object (HM.fromList [("user",String "bitemyapp")])))
1559 describe "ToJSON RegexpFlags" $ do
1560 it "generates the correct JSON for AllRegexpFlags" $
1561 toJSON AllRegexpFlags `shouldBe` String "ALL"
1563 it "generates the correct JSON for NoRegexpFlags" $
1564 toJSON NoRegexpFlags `shouldBe` String "NONE"
1566 it "generates the correct JSON for SomeRegexpFlags" $
1567 let flags = AnyString :| [ Automaton
1568 , Complement
1569 , Empty
1570 , Intersection
1571 , Interval ]
1572 in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
1574 prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
1575 let String str = toJSON flags
1576 flagStrs = T.splitOn "|" str
1577 in noDuplicates flagStrs
1579 describe "omitNulls" $ do
1580 it "checks that omitNulls drops list elements when it should" $
1581 let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))
1582 , "test2" .= (toJSON ("some value" :: Text))]
1583 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1585 it "checks that omitNulls doesn't drop list elements when it shouldn't" $
1586 let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))
1587 , "test2" .= (toJSON ("some value" :: Text))]
1588 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))
1589 , ("test2", String "some value")])
1590 it "checks that omitNulls drops non list elements when it should" $
1591 let dropped = omitNulls $ [ "test1" .= (toJSON Null)
1592 , "test2" .= (toJSON ("some value" :: Text))]
1593 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1594 it "checks that omitNulls doesn't drop non list elements when it shouldn't" $
1595 let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
1596 , "test2" .= (toJSON ("some value" :: Text))]
1597 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
1598 , ("test2", String "some value")])
1599 describe "Monoid (SearchHits a)" $ do
1600 prop "abides the monoid laws" $ eq $
1601 prop_Monoid (T :: T (SearchHits ()))
1603 describe "mkDocVersion" $ do
1604 prop "can never construct an out of range docVersion" $ \i ->
1605 let res = mkDocVersion i
1606 in case res of
1607 Nothing -> property True
1608 Just dv -> (dv >= minBound) .&&.
1609 (dv <= maxBound) .&&.
1610 docVersionNumber dv === i
1612 describe "FsSnapshotRepo" $ do
1613 prop "SnapshotRepo laws" $ \fsr ->
1614 fromGSnapshotRepo (toGSnapshotRepo fsr) === Right (fsr :: FsSnapshotRepo)
1616 describe "snapshot repos" $ do
1617 it "always parses all snapshot repos API" $ when' canSnapshot $ withTestEnv $ do
1618 res <- getSnapshotRepos AllSnapshotRepos
1619 liftIO $ case res of
1620 Left e -> expectationFailure ("Expected a right but got Left " <> show e)
1621 Right _ -> return ()
1623 it "finds an existing list of repos" $ when' canSnapshot $ withTestEnv $ do
1624 let r1n = SnapshotRepoName "bloodhound-repo1"
1625 let r2n = SnapshotRepoName "bloodhound-repo2"
1626 withSnapshotRepo r1n $ \r1 ->
1627 withSnapshotRepo r2n $ \r2 -> do
1628 repos <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| [ExactRepo r2n]))
1629 liftIO $ case repos of
1630 Right xs -> do
1631 let srt = L.sortBy (comparing gSnapshotRepoName)
1632 srt xs `shouldBe` srt [r1, r2]
1633 Left e -> expectationFailure (show e)
1635 it "creates and updates with updateSnapshotRepo" $ when' canSnapshot $ withTestEnv $ do
1636 let r1n = SnapshotRepoName "bloodhound-repo1"
1637 withSnapshotRepo r1n $ \r1 -> do
1638 let Just (String dir) = HM.lookup "location" (gSnapshotRepoSettingsObject (gSnapshotRepoSettings r1))
1639 let noCompression = FsSnapshotRepo r1n (T.unpack dir) False Nothing Nothing Nothing
1640 resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings noCompression
1641 liftIO (validateStatus resp 200)
1642 Right [roundtrippedNoCompression] <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| []))
1643 liftIO (roundtrippedNoCompression `shouldBe` toGSnapshotRepo noCompression)
1645 -- verify came around in 1.4 it seems
1646 it "can verify existing repos" $ when' canSnapshot $ when' (atleast es14) $ withTestEnv $ do
1647 let r1n = SnapshotRepoName "bloodhound-repo1"
1648 withSnapshotRepo r1n $ \_ -> do
1649 res <- verifySnapshotRepo r1n
1650 liftIO $ case res of
1651 Right (SnapshotVerification vs)
1652 | null vs -> expectationFailure "Expected nonempty set of verifying nodes"
1653 | otherwise -> return ()
1654 Left e -> expectationFailure (show e)
1656 describe "snapshots" $ do
1657 it "always parses all snapshots API" $ when' canSnapshot $ withTestEnv $ do
1658 let r1n = SnapshotRepoName "bloodhound-repo1"
1659 withSnapshotRepo r1n $ \_ -> do
1660 res <- getSnapshots r1n AllSnapshots
1661 liftIO $ case res of
1662 Left e -> expectationFailure ("Expected a right but got Left " <> show e)
1663 Right _ -> return ()
1665 it "can parse a snapshot that it created" $ when' canSnapshot $ withTestEnv $ do
1666 let r1n = SnapshotRepoName "bloodhound-repo1"
1667 withSnapshotRepo r1n $ \_ -> do
1668 let s1n = SnapshotName "example-snapshot"
1669 withSnapshot r1n s1n $ do
1670 res <- getSnapshots r1n (SnapshotList (ExactSnap s1n :| []))
1671 liftIO $ case res of
1672 Right [snap]
1673 | snapInfoState snap == SnapshotSuccess &&
1674 snapInfoName snap == s1n -> return ()
1675 | otherwise -> expectationFailure (show snap)
1676 Right [] -> expectationFailure "There were no snapshots"
1677 Right snaps -> expectationFailure ("Expected 1 snapshot but got" <> show (length snaps))
1678 Left e -> expectationFailure (show e)
1680 describe "snapshot restore" $ do
1681 it "can restore a snapshot that we create" $ when' canSnapshot $ withTestEnv $ do
1682 let r1n = SnapshotRepoName "bloodhound-repo1"
1683 withSnapshotRepo r1n $ \_ -> do
1684 let s1n = SnapshotName "example-snapshot"
1685 withSnapshot r1n s1n $ do
1686 let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True }
1687 -- have to close an index to restore it
1688 resp1 <- closeIndex testIndex
1689 liftIO (validateStatus resp1 200)
1690 resp2 <- restoreSnapshot r1n s1n settings
1691 liftIO (validateStatus resp2 200)
1693 it "can restore and rename" $ when' canSnapshot $ withTestEnv $ do
1694 let r1n = SnapshotRepoName "bloodhound-repo1"
1695 withSnapshotRepo r1n $ \_ -> do
1696 let s1n = SnapshotName "example-snapshot"
1697 withSnapshot r1n s1n $ do
1698 let pat = RestoreRenamePattern "bloodhound-tests-twitter-(\\d+)"
1699 let replace = RRTLit "restored-" :| [RRSubWholeMatch]
1700 let expectedIndex = IndexName "restored-bloodhound-tests-twitter-1"
1701 oldEnoughForOverrides <- liftIO (atleast es15)
1702 let overrides = RestoreIndexSettings { restoreOverrideReplicas = Just (ReplicaCount 0) }
1703 let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True
1704 , snapRestoreRenamePattern = Just pat
1705 , snapRestoreRenameReplacement = Just replace
1706 , snapRestoreIndexSettingsOverrides = if oldEnoughForOverrides
1707 then Just overrides
1708 else Nothing
1710 -- have to close an index to restore it
1711 let go = do
1712 resp <- restoreSnapshot r1n s1n settings
1713 liftIO (validateStatus resp 200)
1714 exists <- indexExists expectedIndex
1715 liftIO (exists `shouldBe` True)
1716 go `finally` deleteIndex expectedIndex
1718 describe "getNodesInfo" $ do
1719 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
1720 res <- getNodesInfo LocalNode
1721 liftIO $ case res of
1722 -- This is really just a smoke test for response
1723 -- parsing. Node info is so variable, there's not much I can
1724 -- assert here.
1725 Right NodesInfo {..} -> length nodesInfo `shouldBe` 1
1726 Left e -> expectationFailure ("Expected NodesInfo but got " <> show e)
1728 describe "getNodesStats" $ do
1729 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
1730 res <- getNodesStats LocalNode
1731 liftIO $ case res of
1732 -- This is really just a smoke test for response
1733 -- parsing. Node stats is so variable, there's not much I can
1734 -- assert here.
1735 Right NodesStats {..} -> length nodesStats `shouldBe` 1
1736 Left e -> expectationFailure ("Expected NodesStats but got " <> show e)
1738 describe "Enum DocVersion" $ do
1739 it "follows the laws of Enum, Bounded" $ do
1740 evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall
1741 evaluate (pred minBound :: DocVersion) `shouldThrow` anyErrorCall
1742 evaluate (toEnum 0 :: DocVersion) `shouldThrow` anyErrorCall
1743 evaluate (toEnum 9200000000000000001 :: DocVersion) `shouldThrow` anyErrorCall
1744 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1745 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1746 enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]
1748 describe "scan&scroll API" $ do
1749 it "returns documents using the scan&scroll API" $ withTestEnv $ do
1750 _ <- insertData
1751 _ <- insertOther
1752 let search = (mkSearch (Just $ MatchAllQuery Nothing) Nothing) { size = (Size 1) }
1753 regular_search <- searchTweet search
1754 scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet]
1755 let scan_search = map hitSource scan_search'
1756 liftIO $
1757 regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored
1758 liftIO $
1759 scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]
1761 describe "index aliases" $ do
1762 it "handles the simple case of aliasing an existing index" $ do
1763 let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1764 let create = IndexAliasCreate Nothing Nothing
1765 let action = AddAlias alias create
1767 withTestEnv $ do
1768 resetIndex
1769 resp <- updateIndexAliases (action :| [])
1770 liftIO $ validateStatus resp 200
1771 let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1772 (do aliases <- withTestEnv getIndexAliases
1773 let expected = IndexAliasSummary alias create
1774 case aliases of
1775 Right (IndexAliasesSummary summs) ->
1776 L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1777 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1779 it "handles an alias with routing and a filter" $ do
1780 let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1781 let sar = SearchAliasRouting (RoutingValue "search val" :| [])
1782 let iar = IndexAliasRouting (RoutingValue "index val")
1783 let routing = GranularAliasRouting (Just sar) (Just iar)
1784 let filter = LimitFilter 42
1785 let create = IndexAliasCreate (Just routing) (Just filter)
1786 let action = AddAlias alias create
1788 withTestEnv $ do
1789 resetIndex
1790 resp <- updateIndexAliases (action :| [])
1791 liftIO $ validateStatus resp 200
1792 let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1793 (do aliases <- withTestEnv getIndexAliases
1794 let expected = IndexAliasSummary alias create
1795 case aliases of
1796 Right (IndexAliasesSummary summs) ->
1797 L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1798 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1800 describe "Index Listing" $ do
1801 it "returns a list of index names" $ withTestEnv $ do
1802 _ <- createExampleIndex
1803 ixns <- listIndices
1804 liftIO (ixns `shouldContain` [testIndex])
1806 describe "Index Settings" $ do
1807 it "persists settings" $ withTestEnv $ do
1808 _ <- deleteExampleIndex
1809 _ <- createExampleIndex
1810 let updates = BlocksWrite False :| []
1811 updateResp <- updateIndexSettings updates testIndex
1812 liftIO $ validateStatus updateResp 200
1813 getResp <- getIndexSettings testIndex
1814 liftIO $
1815 getResp `shouldBe` Right (IndexSettingsSummary
1816 testIndex
1817 (IndexSettings (ShardCount 1) (ReplicaCount 0))
1818 (NE.toList updates))
1820 describe "Index Optimization" $ do
1821 it "returns a successful response upon completion" $ withTestEnv $ do
1822 _ <- createExampleIndex
1823 resp <- optimizeIndex (IndexList (testIndex :| [])) defaultIndexOptimizationSettings
1824 liftIO $ validateStatus resp 200
1826 describe "Suggest" $ do
1827 it "returns a search suggestion using the phrase suggester" $ withTestEnv $ do
1828 _ <- insertData
1829 let {- query = QueryMatchNoneQuery
1830 query = TermQuery (Term "user" "bitemyapp") Nothing -}
1831 let phraseSuggester = mkPhraseSuggester (FieldName "message")
1832 namedSuggester = Suggest "Use haskel" "suggest_name" (SuggestTypePhraseSuggester phraseSuggester)
1833 search' = mkSearch Nothing Nothing
1834 search = search' { suggestBody = Just namedSuggester }
1835 expectedText = Just "use haskell"
1836 resp <- searchByIndex testIndex search
1837 parsed <- parseEsResponse resp :: BH IO (Either EsError (SearchResult Tweet))
1838 case parsed of
1839 Left e -> liftIO $ expectationFailure ("Expected an search suggestion but got " <> show e)
1840 Right sr -> liftIO $ (suggestOptionsText . head . suggestResponseOptions . head . nsrResponses <$> suggest sr) `shouldBe` expectedText
1842 describe "JSON instances" $ do
1843 propJSON (Proxy :: Proxy Version)
1844 propJSON (Proxy :: Proxy IndexName)
1845 propJSON (Proxy :: Proxy MappingName)
1846 propJSON (Proxy :: Proxy DocId)
1847 propJSON (Proxy :: Proxy IndexAliasRouting)
1848 propJSON (Proxy :: Proxy RoutingValue)
1849 propJSON (Proxy :: Proxy ShardCount)
1850 propJSON (Proxy :: Proxy ReplicaCount)
1851 propJSON (Proxy :: Proxy TemplateName)
1852 propJSON (Proxy :: Proxy TemplatePattern)
1853 propJSON (Proxy :: Proxy QueryString)
1854 propJSON (Proxy :: Proxy FieldName)
1855 propJSON (Proxy :: Proxy CacheName)
1856 propJSON (Proxy :: Proxy CacheKey)
1857 propJSON (Proxy :: Proxy Existence)
1858 propJSON (Proxy :: Proxy CutoffFrequency)
1859 propJSON (Proxy :: Proxy Analyzer)
1860 propJSON (Proxy :: Proxy MaxExpansions)
1861 propJSON (Proxy :: Proxy Lenient)
1862 propJSON (Proxy :: Proxy Tiebreaker)
1863 propJSON (Proxy :: Proxy Boost)
1864 propJSON (Proxy :: Proxy BoostTerms)
1865 propJSON (Proxy :: Proxy MinimumMatch)
1866 propJSON (Proxy :: Proxy DisableCoord)
1867 propJSON (Proxy :: Proxy IgnoreTermFrequency)
1868 propJSON (Proxy :: Proxy MinimumTermFrequency)
1869 propJSON (Proxy :: Proxy MaxQueryTerms)
1870 propJSON (Proxy :: Proxy Fuzziness)
1871 propJSON (Proxy :: Proxy PrefixLength)
1872 propJSON (Proxy :: Proxy TypeName)
1873 propJSON (Proxy :: Proxy PercentMatch)
1874 propJSON (Proxy :: Proxy StopWord)
1875 propJSON (Proxy :: Proxy QueryPath)
1876 propJSON (Proxy :: Proxy AllowLeadingWildcard)
1877 propJSON (Proxy :: Proxy LowercaseExpanded)
1878 propJSON (Proxy :: Proxy EnablePositionIncrements)
1879 propJSON (Proxy :: Proxy AnalyzeWildcard)
1880 propJSON (Proxy :: Proxy GeneratePhraseQueries)
1881 propJSON (Proxy :: Proxy Locale)
1882 propJSON (Proxy :: Proxy MaxWordLength)
1883 propJSON (Proxy :: Proxy MinWordLength)
1884 propJSON (Proxy :: Proxy PhraseSlop)
1885 propJSON (Proxy :: Proxy MinDocFrequency)
1886 propJSON (Proxy :: Proxy MaxDocFrequency)
1887 propJSON (Proxy :: Proxy Filter)
1888 propJSON (Proxy :: Proxy Query)
1889 propJSON (Proxy :: Proxy SimpleQueryStringQuery)
1890 propJSON (Proxy :: Proxy FieldOrFields)
1891 propJSON (Proxy :: Proxy SimpleQueryFlag)
1892 propJSON (Proxy :: Proxy RegexpQuery)
1893 propJSON (Proxy :: Proxy QueryStringQuery)
1894 propJSON (Proxy :: Proxy RangeQuery)
1895 propJSON (Proxy :: Proxy PrefixQuery)
1896 propJSON (Proxy :: Proxy NestedQuery)
1897 propJSON (Proxy :: Proxy MoreLikeThisFieldQuery)
1898 propJSON (Proxy :: Proxy MoreLikeThisQuery)
1899 propJSON (Proxy :: Proxy IndicesQuery)
1900 propJSON (Proxy :: Proxy HasParentQuery)
1901 propJSON (Proxy :: Proxy HasChildQuery)
1902 propJSON (Proxy :: Proxy FuzzyQuery)
1903 propJSON (Proxy :: Proxy FuzzyLikeFieldQuery)
1904 propJSON (Proxy :: Proxy FuzzyLikeThisQuery)
1905 propJSON (Proxy :: Proxy FilteredQuery)
1906 propJSON (Proxy :: Proxy DisMaxQuery)
1907 propJSON (Proxy :: Proxy CommonTermsQuery)
1908 propJSON (Proxy :: Proxy CommonMinimumMatch)
1909 propJSON (Proxy :: Proxy BoostingQuery)
1910 propJSON (Proxy :: Proxy BoolQuery)
1911 propJSON (Proxy :: Proxy MatchQuery)
1912 propJSON (Proxy :: Proxy MultiMatchQueryType)
1913 propJSON (Proxy :: Proxy BooleanOperator)
1914 propJSON (Proxy :: Proxy ZeroTermsQuery)
1915 propJSON (Proxy :: Proxy MatchQueryType)
1916 propJSON (Proxy :: Proxy AliasRouting)
1917 propJSON (Proxy :: Proxy IndexAliasCreate)
1918 propJSON (Proxy :: Proxy SearchAliasRouting)
1919 propJSON (Proxy :: Proxy ScoreType)
1920 propJSON (Proxy :: Proxy Distance)
1921 propJSON (Proxy :: Proxy DistanceUnit)
1922 propJSON (Proxy :: Proxy DistanceType)
1923 propJSON (Proxy :: Proxy OptimizeBbox)
1924 propJSON (Proxy :: Proxy GeoBoundingBoxConstraint)
1925 propJSON (Proxy :: Proxy GeoFilterType)
1926 propJSON (Proxy :: Proxy GeoBoundingBox)
1927 propJSON (Proxy :: Proxy LatLon)
1928 propJSON (Proxy :: Proxy RangeExecution)
1929 prop "RegexpFlags FromJSON/ToJSON roundtrips, removing dups " $ \rfs ->
1930 let expected = case rfs of
1931 SomeRegexpFlags fs -> SomeRegexpFlags (NE.fromList (nub (NE.toList fs)))
1932 x -> x
1933 in parseEither parseJSON (toJSON rfs) === Right expected
1934 propJSON (Proxy :: Proxy BoolMatch)
1935 propJSON (Proxy :: Proxy Term)
1936 propJSON (Proxy :: Proxy MultiMatchQuery)
1937 propJSON (Proxy :: Proxy IndexSettings)
1938 propJSON (Proxy :: Proxy UpdatableIndexSetting')
1939 propJSON (Proxy :: Proxy ReplicaBounds)
1940 propJSON (Proxy :: Proxy Bytes)
1941 propJSON (Proxy :: Proxy AllocationPolicy)
1942 propJSON (Proxy :: Proxy InitialShardCount)
1943 propJSON (Proxy :: Proxy FSType)
1944 propJSON (Proxy :: Proxy CompoundFormat)
1945 propJSON (Proxy :: Proxy TemplateQueryInline)
1946 propJSON (Proxy :: Proxy Suggest)
1948-- Temporary solution for lacking of generic derivation of Arbitrary
1949-- We use generics-sop, as it's much more concise than directly using GHC.Generics
1951-- This will be unneeded after https://github.com/nick8325/quickcheck/pull/112
1952-- is merged and released
1953sopArbitrary :: forall a. (Generic a, SOP.GTo a, SOP.All SOP.SListI (SOP.GCode a), SOP.All2 Arbitrary (SOP.GCode a)) => Gen a
1954sopArbitrary = fmap SOP.gto sopArbitrary'
1956sopArbitrary' :: forall xss. (SOP.All SOP.SListI xss, SOP.All2 Arbitrary xss) => Gen (SOP.SOP SOP.I xss)
1957sopArbitrary' = SOP.hsequence =<< elements (SOP.apInjs_POP $ SOP.hcpure p arbitrary)
1958 where
1959 p :: Proxy Arbitrary
1960 p = Proxy