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