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