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 #-}
17import Control.Applicative
19import Control.Exception (evaluate)
21import Control.Monad.Catch
22import Control.Monad.Reader
24import Data.Aeson.Types (parseEither)
25import qualified Data.ByteString.Lazy.Char8 as BL8
26import qualified Data.HashMap.Strict as HM
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
33import Data.Ord (comparing)
35import Data.Text (Text)
36import qualified Data.Text as T
37import Data.Time.Calendar (Day (..), fromGregorian)
38import Data.Time.Clock (NominalDiffTime, UTCTime (..),
41import qualified Data.Vector as V
42import qualified Data.Version as Vers
43import Database.V1.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)
51import System.PosixCompat.Files
53import Test.QuickCheck.Property.Monoid (T (..), eq, prop_Monoid)
55import Test.Hspec.QuickCheck (prop)
58import qualified Generics.SOP as SOP
59import qualified Generics.SOP.GGP as SOP
62testServer = Server "http://localhost:9200"
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 =
75 else expectationFailure ("Expected " <> show expected <> " but got " <> show actual <> ": " <> show body)
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
86es13 = Vers.Version [1, 3, 0] []
89es12 = Vers.Version [1, 2, 0] []
92es11 = Vers.Version [1, 1, 0] []
95es14 = Vers.Version [1, 4, 0] []
98es15 = Vers.Version [1, 5, 0] []
101es16 = Vers.Version [1, 6, 0] []
104es20 = Vers.Version [2, 0, 0] []
106getServerVersion :: IO (Maybe Vers.Version)
107getServerVersion = fmap extractVersion <$> withTestEnv getStatus
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
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
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
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)]
194data ChildMapping = ChildMapping deriving (Eq, Show)
196instance ToJSON ChildMapping where
197 toJSON ChildMapping =
198 object ["_parent" .= object ["type" .= ("parent" :: Text)]
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)]
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)]
224exampleTweet = Tweet { user = "bitemyapp"
226 (ModifiedJulianDay 55000)
227 (secondsToDiffTime 10)
228 , message = "Use haskell!"
230 , location = Location 40.12 (-71.34)
233tweetWithExtra :: Tweet
234tweetWithExtra = Tweet { user = "bitemyapp"
236 (ModifiedJulianDay 55000)
237 (secondsToDiffTime 10)
238 , message = "Use haskell!"
240 , location = Location 40.12 (-71.34)
241 , extra = Just "blah blah" }
247newUser = "someotherapp"
251 object [ "age" .= newAge
256patchedTweet = exampleTweet{age = newAge, user = newUser}
259otherTweet = Tweet { user = "notmyapp"
261 (ModifiedJulianDay 55000)
262 (secondsToDiffTime 11)
263 , message = "Use haskell!"
265 , location = Location 40.12 (-71.34)
268resetIndex :: BH IO ()
270 _ <- deleteExampleIndex
271 _ <- createExampleIndex
272 _ <- putMapping testIndex testMapping TweetMapping
275insertData :: BH IO Reply
278 insertData' defaultIndexDocumentSettings
280insertData' :: IndexDocumentSettings -> BH IO Reply
282 r <- indexDocument testIndex testMapping ids exampleTweet (DocId "1")
283 _ <- refreshIndex testIndex
286updateData :: BH IO Reply
288 r <- updateDocument testIndex testMapping defaultIndexDocumentSettings tweetPatch (DocId "1")
289 _ <- refreshIndex testIndex
292insertOther :: BH IO ()
294 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings otherTweet (DocId "2")
295 _ <- refreshIndex testIndex
298insertExtra :: BH IO ()
300 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings tweetWithExtra (DocId "4")
301 _ <- refreshIndex testIndex
304insertWithSpaceInId :: BH IO ()
305insertWithSpaceInId = do
306 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "Hello World")
307 _ <- refreshIndex testIndex
310searchTweet :: Search -> BH IO (Either EsError Tweet)
311searchTweet search = do
312 result <- searchTweets search
313 let myTweet :: Either EsError Tweet
314 myTweet = grabFirst result
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
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)
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)
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
358searchExpectSource :: Source -> Either EsError Value -> BH IO ()
359searchExpectSource src expected = do
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
367 value `shouldBe` expected
374 -> (GenericSnapshotRepo -> 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@.
382 (firstRepoPath:_) -> withTempDirectory firstRepoPath (T.unpack n) $ \dir -> bracket (alloc dir) free f
383 [] -> withSystemTempDirectory (T.unpack n) $ \dir -> bracket (alloc dir) free f
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)
405withSnapshot srn sn = bracket_ alloc free
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
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
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
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
585instance ApproxEq Vers.Version where
587instance (ApproxEq a, Show a) => ApproxEq [a] where
588 as =~ bs = and (zipWith (=~) as bs)
589instance (ApproxEq l, ApproxEq r) => ApproxEq (Either l r) where
590 Left a =~ Left b = a =~ b
591 Right a =~ Right b = a =~ b
593 showApproxEq (Left x) = "Left " <> showApproxEq x
594 showApproxEq (Right x) = "Right " <> showApproxEq x
595instance ApproxEq NodeAttrFilter
596instance ApproxEq NodeAttrName
597instance ApproxEq BuildHash
598instance ApproxEq TemplateQueryKeyValuePairs where
600instance ApproxEq TemplateQueryInline
601instance ApproxEq Size
602instance ApproxEq PhraseSuggesterHighlighter
603instance ApproxEq PhraseSuggesterCollate
604instance ApproxEq PhraseSuggester
605instance ApproxEq SuggestType
606instance ApproxEq Suggest
608-- | Due to the way nodeattrfilters get serialized here, they may come
609-- out in a different order, but they are morally equivalent
610instance ApproxEq UpdatableIndexSetting where
611 RoutingAllocationInclude a =~ RoutingAllocationInclude b =
612 NE.sort a =~ NE.sort b
613 RoutingAllocationExclude a =~ RoutingAllocationExclude b =
614 NE.sort a =~ NE.sort b
615 RoutingAllocationRequire a =~ RoutingAllocationRequire b =
616 NE.sort a =~ NE.sort b
618 showApproxEq (RoutingAllocationInclude xs) = show (RoutingAllocationInclude (NE.sort xs))
619 showApproxEq (RoutingAllocationExclude xs) = show (RoutingAllocationExclude (NE.sort xs))
620 showApproxEq (RoutingAllocationRequire xs) = show (RoutingAllocationRequire (NE.sort xs))
621 showApproxEq x = show x
624noDuplicates :: Eq a => [a] -> Bool
625noDuplicates xs = nub xs == xs
627instance Arbitrary NominalDiffTime where
628 arbitrary = fromInteger <$> arbitrary
630#if !MIN_VERSION_QuickCheck(2,8,0)
631instance (Arbitrary k, Ord k, Arbitrary v) => Arbitrary (M.Map k v) where
632 arbitrary = M.fromList <$> arbitrary
635instance Arbitrary Text where
636 arbitrary = T.pack <$> arbitrary
638instance Arbitrary UTCTime where
641 <*> (fromRational . toRational <$> choose (0::Double, 86400))
643instance Arbitrary Day where
644 arbitrary = ModifiedJulianDay <$> (2000 +) <$> arbitrary
645 shrink = (ModifiedJulianDay <$>) . shrink . toModifiedJulianDay
647#if !MIN_VERSION_QuickCheck(2,9,0)
648instance Arbitrary a => Arbitrary (NonEmpty a) where
649 arbitrary = liftA2 (:|) arbitrary arbitrary
652arbitraryScore :: Gen Score
653arbitraryScore = fmap getPositive <$> arbitrary
655instance (Arbitrary a, Typeable a) => Arbitrary (Hit a) where
656 arbitrary = Hit <$> arbitrary
662 shrink = genericShrink
665instance (Arbitrary a, Typeable a) => Arbitrary (SearchHits a) where
666 arbitrary = reduceSize $ do
667 tot <- getPositive <$> arbitrary
668 score <- arbitraryScore
670 return $ SearchHits tot score hs
671 shrink = genericShrink
673reduceSize :: Gen a -> Gen a
674reduceSize f = sized $ \n -> resize (n `div` 2) f
676getSource :: EsResult a -> Maybe a
677getSource = fmap _source . foundResult
679grabFirst :: Either EsError (SearchResult a) -> Either EsError a
681 case fmap (hitSource . head . hits . searchHits) r of
683 (Right Nothing) -> Left (EsError 500 "Source was missing")
684 (Right (Just x)) -> Right x
686-------------------------------------------------------------------------------
687arbitraryAlphaNum :: Gen Char
688arbitraryAlphaNum = oneof [choose ('a', 'z')
692instance Arbitrary RoutingValue where
693 arbitrary = RoutingValue . T.pack <$> listOf1 arbitraryAlphaNum
695instance Arbitrary AliasRouting where
696 arbitrary = oneof [allAlias
700 where one = GranularAliasRouting
701 <$> (Just <$> arbitrary)
703 theOther = GranularAliasRouting Nothing
704 <$> (Just <$> arbitrary)
705 both = GranularAliasRouting
706 <$> (Just <$> arbitrary)
707 <*> (Just <$> arbitrary)
708 allAlias = AllAliasRouting <$> arbitrary
709 shrink = genericShrink
712instance Arbitrary FieldName where
713 arbitrary = FieldName . T.pack <$> listOf1 arbitraryAlphaNum
714 shrink = genericShrink
717instance Arbitrary RegexpFlags where
718 arbitrary = oneof [ pure AllRegexpFlags
720 , SomeRegexpFlags <$> genUniqueFlags
722 where genUniqueFlags = NE.fromList . nub <$> listOf1 arbitrary
723 shrink = genericShrink
726instance Arbitrary IndexAliasCreate where
727 arbitrary = IndexAliasCreate <$> arbitrary <*> reduceSize arbitrary
728 shrink = genericShrink
730instance Arbitrary Query where
731 arbitrary = reduceSize $ oneof [ TermQuery <$> arbitrary <*> arbitrary
732 , TermsQuery <$> arbitrary <*> arbitrary
733 , QueryMatchQuery <$> arbitrary
734 , QueryMultiMatchQuery <$> arbitrary
735 , QueryBoolQuery <$> arbitrary
736 , QueryBoostingQuery <$> arbitrary
737 , QueryCommonTermsQuery <$> arbitrary
738 , ConstantScoreFilter <$> arbitrary <*> arbitrary
739 , ConstantScoreQuery <$> arbitrary <*> arbitrary
740 , QueryDisMaxQuery <$> arbitrary
741 , QueryFilteredQuery <$> arbitrary
742 , QueryFuzzyLikeThisQuery <$> arbitrary
743 , QueryFuzzyLikeFieldQuery <$> arbitrary
744 , QueryFuzzyQuery <$> arbitrary
745 , QueryHasChildQuery <$> arbitrary
746 , QueryHasParentQuery <$> arbitrary
747 , IdsQuery <$> arbitrary <*> arbitrary
748 , QueryIndicesQuery <$> arbitrary
749 , MatchAllQuery <$> arbitrary
750 , QueryMoreLikeThisQuery <$> arbitrary
751 , QueryMoreLikeThisFieldQuery <$> arbitrary
752 , QueryNestedQuery <$> arbitrary
753 , QueryPrefixQuery <$> arbitrary
754 , QueryQueryStringQuery <$> arbitrary
755 , QuerySimpleQueryStringQuery <$> arbitrary
756 , QueryRangeQuery <$> arbitrary
757 , QueryRegexpQuery <$> arbitrary
758 , QueryTemplateQueryInline <$> arbitrary
760 shrink = genericShrink
762instance Arbitrary Filter where
763 arbitrary = reduceSize $ oneof [ AndFilter <$> arbitrary <*> arbitrary
764 , OrFilter <$> arbitrary <*> arbitrary
765 , NotFilter <$> arbitrary <*> arbitrary
766 , pure IdentityFilter
767 , BoolFilter <$> arbitrary
768 , ExistsFilter <$> arbitrary
769 , GeoBoundingBoxFilter <$> arbitrary
770 , GeoDistanceFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
771 , GeoDistanceRangeFilter <$> arbitrary <*> arbitrary
772 , GeoPolygonFilter <$> arbitrary <*> arbitrary
773 , IdsFilter <$> arbitrary <*> arbitrary
774 , LimitFilter <$> arbitrary
775 , MissingFilter <$> arbitrary <*> arbitrary <*> arbitrary
776 , PrefixFilter <$> arbitrary <*> arbitrary <*> arbitrary
777 , QueryFilter <$> arbitrary <*> arbitrary
778 , RangeFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
779 , RegexpFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
780 , TermFilter <$> arbitrary <*> arbitrary]
781 shrink = genericShrink
783instance Arbitrary ReplicaBounds where
784 arbitrary = oneof [ replicasBounded
785 , replicasLowerBounded
786 , pure ReplicasUnbounded
788 where replicasBounded = do Positive a <- arbitrary
789 Positive b <- arbitrary
790 return (ReplicasBounded a b)
791 replicasLowerBounded = do Positive a <- arbitrary
792 return (ReplicasLowerBounded a)
794instance Arbitrary NodeAttrName where
795 arbitrary = NodeAttrName . T.pack <$> listOf1 arbitraryAlphaNum
798instance Arbitrary NodeAttrFilter where
801 s:ss <- listOf1 (listOf1 arbitraryAlphaNum)
802 let ts = T.pack <$> s :| ss
803 return (NodeAttrFilter n ts)
804 shrink = genericShrink
806instance Arbitrary VersionNumber where
807 arbitrary = mk . fmap getPositive . getNonEmpty <$> arbitrary
809 mk versions = VersionNumber (Vers.Version versions [])
811instance Arbitrary TemplateQueryKeyValuePairs where
812 arbitrary = TemplateQueryKeyValuePairs . HM.fromList <$> arbitrary
813 shrink (TemplateQueryKeyValuePairs x) = map (TemplateQueryKeyValuePairs . HM.fromList) . shrink $ HM.toList x
815instance Arbitrary IndexName where arbitrary = sopArbitrary; shrink = genericShrink
816instance Arbitrary MappingName where arbitrary = sopArbitrary; shrink = genericShrink
817instance Arbitrary DocId where arbitrary = sopArbitrary; shrink = genericShrink
818instance Arbitrary Version where arbitrary = sopArbitrary; shrink = genericShrink
819instance Arbitrary BuildHash where arbitrary = sopArbitrary; shrink = genericShrink
820instance Arbitrary IndexAliasRouting where arbitrary = sopArbitrary; shrink = genericShrink
821instance Arbitrary ShardCount where arbitrary = sopArbitrary; shrink = genericShrink
822instance Arbitrary ReplicaCount where arbitrary = sopArbitrary; shrink = genericShrink
823instance Arbitrary TemplateName where arbitrary = sopArbitrary; shrink = genericShrink
824instance Arbitrary TemplatePattern where arbitrary = sopArbitrary; shrink = genericShrink
825instance Arbitrary QueryString where arbitrary = sopArbitrary; shrink = genericShrink
826instance Arbitrary CacheName where arbitrary = sopArbitrary; shrink = genericShrink
827instance Arbitrary CacheKey where arbitrary = sopArbitrary; shrink = genericShrink
828instance Arbitrary Existence where arbitrary = sopArbitrary; shrink = genericShrink
829instance Arbitrary CutoffFrequency where arbitrary = sopArbitrary; shrink = genericShrink
830instance Arbitrary Analyzer where arbitrary = sopArbitrary; shrink = genericShrink
831instance Arbitrary MaxExpansions where arbitrary = sopArbitrary; shrink = genericShrink
832instance Arbitrary Lenient where arbitrary = sopArbitrary; shrink = genericShrink
833instance Arbitrary Tiebreaker where arbitrary = sopArbitrary; shrink = genericShrink
834instance Arbitrary Boost where arbitrary = sopArbitrary; shrink = genericShrink
835instance Arbitrary BoostTerms where arbitrary = sopArbitrary; shrink = genericShrink
836instance Arbitrary MinimumMatch where arbitrary = sopArbitrary; shrink = genericShrink
837instance Arbitrary DisableCoord where arbitrary = sopArbitrary; shrink = genericShrink
838instance Arbitrary IgnoreTermFrequency where arbitrary = sopArbitrary; shrink = genericShrink
839instance Arbitrary MinimumTermFrequency where arbitrary = sopArbitrary; shrink = genericShrink
840instance Arbitrary MaxQueryTerms where arbitrary = sopArbitrary; shrink = genericShrink
841instance Arbitrary Fuzziness where arbitrary = sopArbitrary; shrink = genericShrink
842instance Arbitrary PrefixLength where arbitrary = sopArbitrary; shrink = genericShrink
843instance Arbitrary TypeName where arbitrary = sopArbitrary; shrink = genericShrink
844instance Arbitrary PercentMatch where arbitrary = sopArbitrary; shrink = genericShrink
845instance Arbitrary StopWord where arbitrary = sopArbitrary; shrink = genericShrink
846instance Arbitrary QueryPath where arbitrary = sopArbitrary; shrink = genericShrink
847instance Arbitrary AllowLeadingWildcard where arbitrary = sopArbitrary; shrink = genericShrink
848instance Arbitrary LowercaseExpanded where arbitrary = sopArbitrary; shrink = genericShrink
849instance Arbitrary EnablePositionIncrements where arbitrary = sopArbitrary; shrink = genericShrink
850instance Arbitrary AnalyzeWildcard where arbitrary = sopArbitrary; shrink = genericShrink
851instance Arbitrary GeneratePhraseQueries where arbitrary = sopArbitrary; shrink = genericShrink
852instance Arbitrary Locale where arbitrary = sopArbitrary; shrink = genericShrink
853instance Arbitrary MaxWordLength where arbitrary = sopArbitrary; shrink = genericShrink
854instance Arbitrary MinWordLength where arbitrary = sopArbitrary; shrink = genericShrink
855instance Arbitrary PhraseSlop where arbitrary = sopArbitrary; shrink = genericShrink
856instance Arbitrary MinDocFrequency where arbitrary = sopArbitrary; shrink = genericShrink
857instance Arbitrary MaxDocFrequency where arbitrary = sopArbitrary; shrink = genericShrink
858instance Arbitrary Regexp where arbitrary = sopArbitrary; shrink = genericShrink
859instance Arbitrary SimpleQueryStringQuery where arbitrary = sopArbitrary; shrink = genericShrink
860instance Arbitrary FieldOrFields where arbitrary = sopArbitrary; shrink = genericShrink
861instance Arbitrary SimpleQueryFlag where arbitrary = sopArbitrary; shrink = genericShrink
862instance Arbitrary RegexpQuery where arbitrary = sopArbitrary; shrink = genericShrink
863instance Arbitrary QueryStringQuery where arbitrary = sopArbitrary; shrink = genericShrink
864instance Arbitrary RangeQuery where arbitrary = sopArbitrary; shrink = genericShrink
865instance Arbitrary RangeValue where arbitrary = sopArbitrary; shrink = genericShrink
866instance Arbitrary PrefixQuery where arbitrary = sopArbitrary; shrink = genericShrink
867instance Arbitrary NestedQuery where arbitrary = sopArbitrary; shrink = genericShrink
868instance Arbitrary MoreLikeThisFieldQuery where arbitrary = sopArbitrary; shrink = genericShrink
869instance Arbitrary MoreLikeThisQuery where arbitrary = sopArbitrary; shrink = genericShrink
870instance Arbitrary IndicesQuery where arbitrary = sopArbitrary; shrink = genericShrink
871instance Arbitrary HasParentQuery where arbitrary = sopArbitrary; shrink = genericShrink
872instance Arbitrary HasChildQuery where arbitrary = sopArbitrary; shrink = genericShrink
873instance Arbitrary FuzzyQuery where arbitrary = sopArbitrary; shrink = genericShrink
874instance Arbitrary FuzzyLikeFieldQuery where arbitrary = sopArbitrary; shrink = genericShrink
875instance Arbitrary FuzzyLikeThisQuery where arbitrary = sopArbitrary; shrink = genericShrink
876instance Arbitrary FilteredQuery where arbitrary = sopArbitrary; shrink = genericShrink
877instance Arbitrary DisMaxQuery where arbitrary = sopArbitrary; shrink = genericShrink
878instance Arbitrary CommonTermsQuery where arbitrary = sopArbitrary; shrink = genericShrink
879instance Arbitrary DistanceRange where arbitrary = sopArbitrary; shrink = genericShrink
880instance Arbitrary MultiMatchQuery where arbitrary = sopArbitrary; shrink = genericShrink
881instance Arbitrary LessThanD where arbitrary = sopArbitrary; shrink = genericShrink
882instance Arbitrary LessThanEqD where arbitrary = sopArbitrary; shrink = genericShrink
883instance Arbitrary GreaterThanD where arbitrary = sopArbitrary; shrink = genericShrink
884instance Arbitrary GreaterThanEqD where arbitrary = sopArbitrary; shrink = genericShrink
885instance Arbitrary LessThan where arbitrary = sopArbitrary; shrink = genericShrink
886instance Arbitrary LessThanEq where arbitrary = sopArbitrary; shrink = genericShrink
887instance Arbitrary GreaterThan where arbitrary = sopArbitrary; shrink = genericShrink
888instance Arbitrary GreaterThanEq where arbitrary = sopArbitrary; shrink = genericShrink
889instance Arbitrary GeoPoint where
890 arbitrary = GeoPoint <$> (arbitrary `suchThat` reasonableFieldName) <*> arbitrary
892 -- These are problematic for geopoint for obvious reasons
893 reasonableFieldName (FieldName "from") = False
894 reasonableFieldName (FieldName "to") = False
895 reasonableFieldName _ = True
896 shrink = genericShrink
897instance Arbitrary NullValue where arbitrary = sopArbitrary; shrink = genericShrink
898instance Arbitrary MinimumMatchHighLow where arbitrary = sopArbitrary; shrink = genericShrink
899instance Arbitrary CommonMinimumMatch where arbitrary = sopArbitrary; shrink = genericShrink
900instance Arbitrary BoostingQuery where arbitrary = sopArbitrary; shrink = genericShrink
901instance Arbitrary BoolQuery where arbitrary = sopArbitrary; shrink = genericShrink
902instance Arbitrary MatchQuery where arbitrary = sopArbitrary; shrink = genericShrink
903instance Arbitrary MultiMatchQueryType where arbitrary = sopArbitrary; shrink = genericShrink
904instance Arbitrary BooleanOperator where arbitrary = sopArbitrary; shrink = genericShrink
905instance Arbitrary ZeroTermsQuery where arbitrary = sopArbitrary; shrink = genericShrink
906instance Arbitrary MatchQueryType where arbitrary = sopArbitrary; shrink = genericShrink
907instance Arbitrary SearchAliasRouting where arbitrary = sopArbitrary; shrink = genericShrink
908instance Arbitrary ScoreType where arbitrary = sopArbitrary; shrink = genericShrink
909instance Arbitrary Distance where arbitrary = sopArbitrary; shrink = genericShrink
910instance Arbitrary DistanceUnit where arbitrary = sopArbitrary; shrink = genericShrink
911instance Arbitrary DistanceType where arbitrary = sopArbitrary; shrink = genericShrink
912instance Arbitrary OptimizeBbox where arbitrary = sopArbitrary; shrink = genericShrink
913instance Arbitrary GeoBoundingBoxConstraint where arbitrary = sopArbitrary; shrink = genericShrink
914instance Arbitrary GeoFilterType where arbitrary = sopArbitrary; shrink = genericShrink
915instance Arbitrary GeoBoundingBox where arbitrary = sopArbitrary; shrink = genericShrink
916instance Arbitrary LatLon where arbitrary = sopArbitrary; shrink = genericShrink
917instance Arbitrary RangeExecution where arbitrary = sopArbitrary; shrink = genericShrink
918instance Arbitrary RegexpFlag where arbitrary = sopArbitrary; shrink = genericShrink
919instance Arbitrary BoolMatch where arbitrary = sopArbitrary; shrink = genericShrink
920instance Arbitrary Term where arbitrary = sopArbitrary; shrink = genericShrink
921instance Arbitrary IndexSettings where arbitrary = sopArbitrary; shrink = genericShrink
922instance Arbitrary UpdatableIndexSetting where arbitrary = sopArbitrary; shrink = genericShrink
923instance Arbitrary Bytes where arbitrary = sopArbitrary; shrink = genericShrink
924instance Arbitrary AllocationPolicy where arbitrary = sopArbitrary; shrink = genericShrink
925instance Arbitrary InitialShardCount where arbitrary = sopArbitrary; shrink = genericShrink
926instance Arbitrary FSType where arbitrary = sopArbitrary; shrink = genericShrink
927instance Arbitrary CompoundFormat where arbitrary = sopArbitrary; shrink = genericShrink
928instance Arbitrary FsSnapshotRepo where arbitrary = sopArbitrary; shrink = genericShrink
929instance Arbitrary SnapshotRepoName where arbitrary = sopArbitrary; shrink = genericShrink
930instance Arbitrary TemplateQueryInline where arbitrary = sopArbitrary; shrink = genericShrink
931instance Arbitrary PhraseSuggesterCollate where arbitrary = sopArbitrary; shrink = genericShrink
932instance Arbitrary PhraseSuggesterHighlighter where arbitrary = sopArbitrary; shrink = genericShrink
933instance Arbitrary Size where arbitrary = sopArbitrary; shrink = genericShrink
934instance Arbitrary PhraseSuggester where arbitrary = sopArbitrary; shrink = genericShrink
935instance Arbitrary SuggestType where arbitrary = sopArbitrary; shrink = genericShrink
936instance Arbitrary Suggest where arbitrary = sopArbitrary; shrink = genericShrink
938newtype UpdatableIndexSetting' = UpdatableIndexSetting' UpdatableIndexSetting
939 deriving (Show, Eq, ToJSON, FromJSON, ApproxEq, Typeable)
941instance Arbitrary UpdatableIndexSetting' where
943 settings <- arbitrary
944 return $ UpdatableIndexSetting' $ case settings of
945 RoutingAllocationInclude xs -> RoutingAllocationInclude (dropDuplicateAttrNames xs)
946 RoutingAllocationExclude xs -> RoutingAllocationExclude (dropDuplicateAttrNames xs)
947 RoutingAllocationRequire xs -> RoutingAllocationRequire (dropDuplicateAttrNames xs)
950 dropDuplicateAttrNames = NE.fromList . L.nubBy sameAttrName . NE.toList
951 sameAttrName a b = nodeAttrFilterName a == nodeAttrFilterName b
956 describe "index create/delete API" $ do
957 it "creates and then deletes the requested index" $ withTestEnv $ do
959 _ <- deleteExampleIndex
960 resp <- createExampleIndex
961 deleteResp <- deleteExampleIndex
963 validateStatus resp 200
964 validateStatus deleteResp 200
966 describe "error parsing" $ do
967 it "can parse EsErrors for < 2.0" $ when' (atmost es16) $ withTestEnv $ do
968 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
969 let errorResp = eitherDecode (responseBody res)
970 liftIO (errorResp `shouldBe` Right (EsError 404 "IndexMissingException[[bogus] missing]"))
972 it "can parse EsErrors for >= 2.0" $ when' (atleast es20) $ withTestEnv $ do
973 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
974 let errorResp = eitherDecode (responseBody res)
975 liftIO (errorResp `shouldBe` Right (EsError 404 "no such index"))
977 describe "document API" $ do
978 it "indexes, updates, gets, and then deletes the generated document" $ withTestEnv $ do
981 docInserted <- getDocument testIndex testMapping (DocId "1")
982 let newTweet = eitherDecode
983 (responseBody docInserted) :: Either String (EsResult Tweet)
984 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just patchedTweet))
986 it "indexes, gets, and then deletes the generated document with a DocId containing a space" $ withTestEnv $ do
987 _ <- insertWithSpaceInId
988 docInserted <- getDocument testIndex testMapping (DocId "Hello World")
989 let newTweet = eitherDecode
990 (responseBody docInserted) :: Either String (EsResult Tweet)
991 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))
993 it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do
994 doc <- getDocument testIndex testMapping (DocId "bogus")
995 let noTweet = eitherDecode
996 (responseBody doc) :: Either String (EsResult Tweet)
997 liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing
999 it "can use optimistic concurrency control" $ withTestEnv $ do
1000 let ev = ExternalDocVersion minBound
1001 let cfg = defaultIndexDocumentSettings { idsVersionControl = ExternalGT ev }
1003 res <- insertData' cfg
1004 liftIO $ isCreated res `shouldBe` True
1005 res' <- insertData' cfg
1006 liftIO $ isVersionConflict res' `shouldBe` True
1008 it "indexes two documents in a parent/child relationship and checks that the child exists" $ withTestEnv $ do
1010 _ <- putMapping testIndex (MappingName "child") ChildMapping
1011 _ <- putMapping testIndex (MappingName "parent") ParentMapping
1012 _ <- indexDocument testIndex (MappingName "parent") defaultIndexDocumentSettings exampleTweet (DocId "1")
1013 let parent = (Just . DocumentParent . DocId) "1"
1014 ids = IndexDocumentSettings NoVersionControl parent
1015 _ <- indexDocument testIndex (MappingName "child") ids otherTweet (DocId "2")
1016 _ <- refreshIndex testIndex
1017 exists <- documentExists testIndex (MappingName "child") parent (DocId "2")
1018 liftIO $ exists `shouldBe` True
1020 describe "template API" $ do
1021 it "can create a template" $ withTestEnv $ do
1022 let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
1023 resp <- putTemplate idxTpl (TemplateName "tweet-tpl")
1024 liftIO $ validateStatus resp 200
1026 it "can detect if a template exists" $ withTestEnv $ do
1027 exists <- templateExists (TemplateName "tweet-tpl")
1028 liftIO $ exists `shouldBe` True
1030 it "can delete a template" $ withTestEnv $ do
1031 resp <- deleteTemplate (TemplateName "tweet-tpl")
1032 liftIO $ validateStatus resp 200
1034 it "can detect if a template doesn't exist" $ withTestEnv $ do
1035 exists <- templateExists (TemplateName "tweet-tpl")
1036 liftIO $ exists `shouldBe` False
1038 describe "bulk API" $ do
1039 it "inserts all documents we request" $ withTestEnv $ do
1041 let firstTest = BulkTest "blah"
1042 let secondTest = BulkTest "bloo"
1043 let firstDoc = BulkIndex testIndex
1044 testMapping (DocId "2") (toJSON firstTest)
1045 let secondDoc = BulkCreate testIndex
1046 testMapping (DocId "3") (toJSON secondTest)
1047 let stream = V.fromList [firstDoc, secondDoc]
1049 _ <- refreshIndex testIndex
1050 fDoc <- getDocument testIndex testMapping (DocId "2")
1051 sDoc <- getDocument testIndex testMapping (DocId "3")
1052 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
1053 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
1055 fmap getSource maybeFirst `shouldBe` Right (Just firstTest)
1056 fmap getSource maybeSecond `shouldBe` Right (Just secondTest)
1059 describe "query API" $ do
1060 it "returns document for term query and identity filter" $ withTestEnv $ do
1062 let query = TermQuery (Term "user" "bitemyapp") Nothing
1063 let filter = IdentityFilter <&&> IdentityFilter
1064 let search = mkSearch (Just query) (Just filter)
1065 myTweet <- searchTweet search
1067 myTweet `shouldBe` Right exampleTweet
1069 it "handles constant score queries" $ withTestEnv $ do
1071 let query = TermsQuery "user" ("bitemyapp" :| [])
1072 let cfQuery = ConstantScoreQuery query (Boost 1.0)
1073 let filter = IdentityFilter
1074 let search = mkSearch (Just cfQuery) (Just filter)
1075 myTweet <- searchTweet search
1077 myTweet `shouldBe` Right exampleTweet
1078 it "handles constant score filters" $ withTestEnv $ do
1080 let query = TermsQuery "user" ("bitemyapp" :| [])
1081 let cfFilter = ConstantScoreFilter IdentityFilter (Boost 1.0)
1082 let boolQuery = mkBoolQuery [query, cfFilter] [] []
1083 let search = mkSearch (Just (QueryBoolQuery boolQuery)) Nothing
1084 myTweet <- searchTweet search
1086 myTweet `shouldBe` Right exampleTweet
1089 it "returns document for terms query and identity filter" $ withTestEnv $ do
1091 let query = TermsQuery "user" ("bitemyapp" :| [])
1092 let filter = IdentityFilter <&&> IdentityFilter
1093 let search = mkSearch (Just query) (Just filter)
1094 myTweet <- searchTweet search
1096 myTweet `shouldBe` Right exampleTweet
1098 it "returns document for match query" $ withTestEnv $ do
1100 let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1101 let search = mkSearch (Just query) Nothing
1102 myTweet <- searchTweet search
1104 myTweet `shouldBe` Right exampleTweet
1106 it "returns document for multi-match query" $ withTestEnv $ do
1108 let flds = [FieldName "user", FieldName "message"]
1109 let query = QueryMultiMatchQuery $ mkMultiMatchQuery flds (QueryString "bitemyapp")
1110 let search = mkSearch (Just query) Nothing
1111 myTweet <- searchTweet search
1113 myTweet `shouldBe` Right exampleTweet
1115 it "returns document for multi-match query with a custom tiebreaker" $ withTestEnv $ do
1117 let tiebreaker = Just $ Tiebreaker 0.3
1118 flds = [FieldName "user", FieldName "message"]
1119 multiQuery' = mkMultiMatchQuery flds (QueryString "bitemyapp")
1120 query = QueryMultiMatchQuery $ multiQuery' { multiMatchQueryTiebreaker = tiebreaker }
1121 search = mkSearch (Just query) Nothing
1122 myTweet <- searchTweet search
1124 myTweet `shouldBe` Right exampleTweet
1126 it "returns document for bool query" $ withTestEnv $ do
1128 let innerQuery = QueryMatchQuery $
1129 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1130 let query = QueryBoolQuery $
1131 mkBoolQuery [innerQuery] [] []
1132 let search = mkSearch (Just query) Nothing
1133 myTweet <- searchTweet search
1135 myTweet `shouldBe` Right exampleTweet
1137 it "returns document for boosting query" $ withTestEnv $ do
1139 let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1140 let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
1141 let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
1142 let search = mkSearch (Just query) Nothing
1143 myTweet <- searchTweet search
1145 myTweet `shouldBe` Right exampleTweet
1147 it "returns document for common terms query" $ withTestEnv $ do
1149 let query = QueryCommonTermsQuery $
1150 CommonTermsQuery (FieldName "user")
1151 (QueryString "bitemyapp")
1152 (CutoffFrequency 0.0001)
1153 Or Or Nothing Nothing Nothing Nothing
1154 let search = mkSearch (Just query) Nothing
1155 myTweet <- searchTweet search
1157 myTweet `shouldBe` Right exampleTweet
1159 it "returns document for for inline template query" $ withTestEnv $ do
1161 let innerQuery = QueryMatchQuery $
1162 mkMatchQuery (FieldName "{{userKey}}")
1163 (QueryString "{{bitemyappKey}}")
1164 templateParams = TemplateQueryKeyValuePairs $ HM.fromList
1165 [ ("userKey", "user")
1166 , ("bitemyappKey", "bitemyapp")
1168 templateQuery = QueryTemplateQueryInline $
1169 TemplateQueryInline innerQuery templateParams
1170 search = mkSearch (Just templateQuery) Nothing
1171 myTweet <- searchTweet search
1172 liftIO $ myTweet `shouldBe` Right exampleTweet
1175 describe "sorting" $ do
1176 it "returns documents in the right order" $ withTestEnv $ do
1179 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
1180 let search = Search Nothing
1181 (Just IdentityFilter) (Just [sortSpec]) Nothing Nothing
1182 False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
1184 result <- searchTweets search
1185 let myTweet = grabFirst result
1187 myTweet `shouldBe` Right otherTweet
1190 describe "filtering API" $ do
1191 it "returns document for composed boolmatch and identity" $ withTestEnv $ do
1193 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
1195 let search = mkSearch Nothing (Just queryFilter)
1196 myTweet <- searchTweet search
1198 myTweet `shouldBe` Right exampleTweet
1200 it "returns document for term filter" $ withTestEnv $ do
1202 let termFilter = TermFilter (Term "user" "bitemyapp") False
1203 let search = mkSearch Nothing (Just termFilter)
1204 myTweet <- searchTweet search
1206 myTweet `shouldBe` Right exampleTweet
1208 it "returns document for existential filter" $ withTestEnv $ do
1210 let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
1211 myTweet <- searchTweet search
1213 myTweet `shouldBe` Right exampleTweet
1215 it "returns document for geo boundingbox filter" $ withTestEnv $ do
1217 let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
1218 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
1219 let geoFilter = GeoBoundingBoxFilter bbConstraint
1220 let search = mkSearch Nothing (Just geoFilter)
1221 myTweet <- searchTweet search
1223 myTweet `shouldBe` Right exampleTweet
1225 it "doesn't return document for nonsensical boundingbox filter" $ withTestEnv $ do
1227 let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
1228 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
1229 let geoFilter = GeoBoundingBoxFilter bbConstraint
1230 let search = mkSearch Nothing (Just geoFilter)
1231 searchExpectNoResults search
1233 it "returns document for geo distance filter" $ withTestEnv $ do
1235 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1236 let distance = Distance 10.0 Miles
1237 let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
1238 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
1239 let search = mkSearch Nothing (Just geoFilter)
1240 myTweet <- searchTweet search
1242 myTweet `shouldBe` Right exampleTweet
1244 it "returns document for geo distance range filter" $ withTestEnv $ do
1246 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1247 let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
1248 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
1249 let search = mkSearch Nothing (Just geoFilter)
1250 myTweet <- searchTweet search
1252 myTweet `shouldBe` Right exampleTweet
1254 it "doesn't return document for wild geo distance range filter" $ withTestEnv $ do
1256 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1257 let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
1258 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
1259 let search = mkSearch Nothing (Just geoFilter)
1260 searchExpectNoResults search
1262 it "returns document for geo polygon filter" $ withTestEnv $ do
1264 let points = [LatLon 40.0 (-70.00),
1265 LatLon 40.0 (-72.00),
1266 LatLon 41.0 (-70.00),
1267 LatLon 41.0 (-72.00)]
1268 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
1269 let search = mkSearch Nothing (Just geoFilter)
1270 myTweet <- searchTweet search
1272 myTweet `shouldBe` Right exampleTweet
1274 it "doesn't return document for bad geo polygon filter" $ withTestEnv $ do
1276 let points = [LatLon 40.0 (-70.00),
1277 LatLon 40.0 (-71.00),
1278 LatLon 41.0 (-70.00),
1279 LatLon 41.0 (-71.00)]
1280 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
1281 let search = mkSearch Nothing (Just geoFilter)
1282 searchExpectNoResults search
1284 it "returns document for ids filter" $ withTestEnv $ do
1286 let filter = IdsFilter (MappingName "tweet") [DocId "1"]
1287 let search = mkSearch Nothing (Just filter)
1288 myTweet <- searchTweet search
1290 myTweet `shouldBe` Right exampleTweet
1292 it "returns document for Double range filter" $ withTestEnv $ do
1294 let filter = RangeFilter (FieldName "age")
1295 (RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))
1296 RangeExecutionIndex False
1297 let search = mkSearch Nothing (Just filter)
1298 myTweet <- searchTweet search
1300 myTweet `shouldBe` Right exampleTweet
1302 it "returns document for UTCTime date filter" $ withTestEnv $ do
1304 let filter = RangeFilter (FieldName "postDate")
1306 (GreaterThanD (UTCTime
1307 (ModifiedJulianDay 54000)
1308 (secondsToDiffTime 0)))
1310 (ModifiedJulianDay 55000)
1311 (secondsToDiffTime 11))))
1312 RangeExecutionIndex False
1313 let search = mkSearch Nothing (Just filter)
1314 myTweet <- searchTweet search
1316 myTweet `shouldBe` Right exampleTweet
1318 it "returns document for regexp filter" $ withTestEnv $ do
1320 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
1321 AllRegexpFlags (CacheName "test") False (CacheKey "key")
1322 let search = mkSearch Nothing (Just filter)
1323 myTweet <- searchTweet search
1325 myTweet `shouldBe` Right exampleTweet
1327 it "doesn't return document for non-matching regexp filter" $ withTestEnv $ do
1329 let filter = RegexpFilter (FieldName "user")
1330 (Regexp "boy") AllRegexpFlags
1331 (CacheName "test") False (CacheKey "key")
1332 let search = mkSearch Nothing (Just filter)
1333 searchExpectNoResults search
1335 it "returns document for query filter, uncached" $ withTestEnv $ do
1337 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) True
1338 search = mkSearch Nothing (Just filter)
1339 myTweet <- searchTweet search
1340 liftIO $ myTweet `shouldBe` Right exampleTweet
1342 it "returns document for query filter, cached" $ withTestEnv $ do
1344 let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) False
1345 search = mkSearch Nothing (Just filter)
1346 myTweet <- searchTweet search
1347 liftIO $ myTweet `shouldBe` Right exampleTweet
1349 describe "Aggregation API" $ do
1350 it "returns term aggregation results" $ withTestEnv $ do
1352 let terms = TermsAgg $ mkTermsAggregation "user"
1353 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1354 searchExpectAggs search
1355 searchValidBucketAgg search "users" toTerms
1357 it "return sub-aggregation results" $ withTestEnv $ do
1359 let subaggs = mkAggregations "age_agg" . TermsAgg $ mkTermsAggregation "age"
1360 agg = TermsAgg $ (mkTermsAggregation "user") { termAggs = Just subaggs}
1361 search = mkAggregateSearch Nothing $ mkAggregations "users" agg
1362 reply <- searchByIndex testIndex search
1363 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
1364 usersAggResults = result >>= aggregations >>= toTerms "users"
1365 subAggResults = usersAggResults >>= (listToMaybe . buckets) >>= termsAggs >>= toTerms "age_agg"
1366 subAddResultsExists = isJust subAggResults
1367 liftIO $ (subAddResultsExists) `shouldBe` True
1369 it "returns cardinality aggregation results" $ withTestEnv $ do
1371 let cardinality = CardinalityAgg $ mkCardinalityAggregation $ FieldName "user"
1372 let search = mkAggregateSearch Nothing $ mkAggregations "users" cardinality
1373 let search' = search { Database.V1.Bloodhound.from = From 0, size = Size 0 }
1374 searchExpectAggs search'
1375 let docCountPair k n = (k, object ["value" .= Number n])
1376 res <- searchTweets search'
1378 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "users" 1]))
1380 it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
1382 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
1383 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1384 searchExpectAggs search
1385 searchValidBucketAgg search "users" toTerms
1387 -- One of these fails with 1.7.3
1388 it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
1390 searchTermsAggHint [Map, Ordinals]
1392 it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do
1394 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
1396 it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
1398 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
1399 -- One of the above.
1401 it "can execute value_count aggregations" $ withTestEnv $ do
1404 let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>
1405 mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))
1406 let search = mkAggregateSearch Nothing ags
1407 let docCountPair k n = (k, object ["value" .= Number n])
1408 res <- searchTweets search
1410 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2
1411 , docCountPair "bogus_count" 0
1414 it "can execute filter aggregations" $ withTestEnv $ do
1417 let ags = mkAggregations "bitemyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "bitemyapp") defaultCache) Nothing)) <>
1418 mkAggregations "notmyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "notmyapp") defaultCache) Nothing))
1419 let search = mkAggregateSearch Nothing ags
1420 let docCountPair k n = (k, object ["doc_count" .= Number n])
1421 res <- searchTweets search
1423 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "bitemyapps" 1
1424 , docCountPair "notmyapps" 1
1426 it "can execute date_range aggregations" $ withTestEnv $ do
1427 let now = fromGregorian 2015 3 14
1428 let ltAMonthAgo = UTCTime (fromGregorian 2015 3 1) 0
1429 let ltAWeekAgo = UTCTime (fromGregorian 2015 3 10) 0
1430 let oldDoc = exampleTweet { postDate = ltAMonthAgo }
1431 let newDoc = exampleTweet { postDate = ltAWeekAgo }
1432 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings oldDoc (DocId "1")
1433 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings newDoc (DocId "2")
1434 _ <- refreshIndex testIndex
1435 let thisMonth = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMMonth])
1436 let thisWeek = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMWeek])
1437 let agg = DateRangeAggregation (FieldName "postDate") Nothing (thisMonth :| [thisWeek])
1438 let ags = mkAggregations "date_ranges" (DateRangeAgg agg)
1439 let search = mkAggregateSearch Nothing ags
1440 res <- searchTweets search
1441 liftIO $ hitsTotal . searchHits <$> res `shouldBe` Right 2
1442 let bucks = do magrs <- fmapL show (aggregations <$> res)
1443 agrs <- note "no aggregations returned" magrs
1444 rawBucks <- note "no date_ranges aggregation" $ M.lookup "date_ranges" agrs
1445 parseEither parseJSON rawBucks
1446 let fromMonthT = UTCTime (fromGregorian 2015 2 14) 0
1447 let fromWeekT = UTCTime (fromGregorian 2015 3 7) 0
1448 liftIO $ buckets <$> bucks `shouldBe` Right [ DateRangeResult "2015-02-14T00:00:00.000Z-*"
1450 (Just "2015-02-14T00:00:00.000Z")
1455 , DateRangeResult "2015-03-07T00:00:00.000Z-*"
1457 (Just "2015-03-07T00:00:00.000Z")
1464 it "returns date histogram aggregation results" $ withTestEnv $ do
1466 let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
1467 let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
1468 searchExpectAggs search
1469 searchValidBucketAgg search "byDate" toDateHistogram
1471 it "returns date histogram using fractional date" $ withTestEnv $ do
1473 let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]
1474 let fractionals = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]
1475 let intervals = periods ++ fractionals
1476 let histogram = mkDateHistogram (FieldName "postDate")
1477 let search interval = mkAggregateSearch Nothing $ mkAggregations "byDate" $ DateHistogramAgg (histogram interval)
1478 let expect interval = searchExpectAggs (search interval)
1479 let valid interval = searchValidBucketAgg (search interval) "byDate" toDateHistogram
1480 forM_ intervals expect
1481 forM_ intervals valid
1483 it "can execute missing aggregations" $ withTestEnv $ do
1486 let ags = mkAggregations "missing_agg" (MissingAgg (MissingAggregation "extra"))
1487 let search = mkAggregateSearch Nothing ags
1488 let docCountPair k n = (k, object ["doc_count" .= Number n])
1489 res <- searchTweets search
1491 fmap aggregations res `shouldBe` Right (Just (M.fromList [docCountPair "missing_agg" 1]))
1493 describe "Highlights API" $ do
1495 it "returns highlight from query when there should be one" $ withTestEnv $ do
1498 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1499 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
1501 let search = mkHighlightSearch (Just query) testHighlight
1502 myHighlight <- searchTweetHighlight search
1504 myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
1506 it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
1509 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1510 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "user") Nothing]
1512 let search = mkHighlightSearch (Just query) testHighlight
1513 myHighlight <- searchTweetHighlight search
1515 myHighlight `shouldBe` Right Nothing
1517 describe "Source filtering" $ do
1519 it "doesn't include source when sources are disabled" $ withTestEnv $ do
1522 (Left (EsError 500 "Source was missing"))
1524 it "includes a source" $ withTestEnv $ do
1526 (SourcePatterns (PopPattern (Pattern "message")))
1527 (Right (Object (HM.fromList [("message", String "Use haskell!")])))
1529 it "includes sources" $ withTestEnv $ do
1531 (SourcePatterns (PopPatterns [Pattern "user", Pattern "message"]))
1532 (Right (Object (HM.fromList [("user",String "bitemyapp"),("message", String "Use haskell!")])))
1534 it "includes source patterns" $ withTestEnv $ do
1536 (SourcePatterns (PopPattern (Pattern "*ge")))
1537 (Right (Object (HM.fromList [("age", Number 10000),("message", String "Use haskell!")])))
1539 it "excludes source patterns" $ withTestEnv $ do
1541 (SourceIncludeExclude (Include [])
1542 (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate", Pattern "extra"]))
1543 (Right (Object (HM.fromList [("user",String "bitemyapp")])))
1545 describe "ToJSON RegexpFlags" $ do
1546 it "generates the correct JSON for AllRegexpFlags" $
1547 toJSON AllRegexpFlags `shouldBe` String "ALL"
1549 it "generates the correct JSON for NoRegexpFlags" $
1550 toJSON NoRegexpFlags `shouldBe` String "NONE"
1552 it "generates the correct JSON for SomeRegexpFlags" $
1553 let flags = AnyString :| [ Automaton
1558 in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
1560 prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
1561 let String str = toJSON flags
1562 flagStrs = T.splitOn "|" str
1563 in noDuplicates flagStrs
1565 describe "omitNulls" $ do
1566 it "checks that omitNulls drops list elements when it should" $
1567 let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))
1568 , "test2" .= (toJSON ("some value" :: Text))]
1569 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1571 it "checks that omitNulls doesn't drop list elements when it shouldn't" $
1572 let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))
1573 , "test2" .= (toJSON ("some value" :: Text))]
1574 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))
1575 , ("test2", String "some value")])
1576 it "checks that omitNulls drops non list elements when it should" $
1577 let dropped = omitNulls $ [ "test1" .= (toJSON Null)
1578 , "test2" .= (toJSON ("some value" :: Text))]
1579 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1580 it "checks that omitNulls doesn't drop non list elements when it shouldn't" $
1581 let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
1582 , "test2" .= (toJSON ("some value" :: Text))]
1583 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
1584 , ("test2", String "some value")])
1585 describe "Monoid (SearchHits a)" $ do
1586 prop "abides the monoid laws" $ eq $
1587 prop_Monoid (T :: T (SearchHits ()))
1589 describe "mkDocVersion" $ do
1590 prop "can never construct an out of range docVersion" $ \i ->
1591 let res = mkDocVersion i
1593 Nothing -> property True
1594 Just dv -> (dv >= minBound) .&&.
1595 (dv <= maxBound) .&&.
1596 docVersionNumber dv === i
1598 describe "FsSnapshotRepo" $ do
1599 prop "SnapshotRepo laws" $ \fsr ->
1600 fromGSnapshotRepo (toGSnapshotRepo fsr) === Right (fsr :: FsSnapshotRepo)
1602 describe "snapshot repos" $ do
1603 it "always parses all snapshot repos API" $ when' canSnapshot $ withTestEnv $ do
1604 res <- getSnapshotRepos AllSnapshotRepos
1605 liftIO $ case res of
1606 Left e -> expectationFailure ("Expected a right but got Left " <> show e)
1607 Right _ -> return ()
1609 it "finds an existing list of repos" $ when' canSnapshot $ withTestEnv $ do
1610 let r1n = SnapshotRepoName "bloodhound-repo1"
1611 let r2n = SnapshotRepoName "bloodhound-repo2"
1612 withSnapshotRepo r1n $ \r1 ->
1613 withSnapshotRepo r2n $ \r2 -> do
1614 repos <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| [ExactRepo r2n]))
1615 liftIO $ case repos of
1617 let srt = L.sortBy (comparing gSnapshotRepoName)
1618 srt xs `shouldBe` srt [r1, r2]
1619 Left e -> expectationFailure (show e)
1621 it "creates and updates with updateSnapshotRepo" $ when' canSnapshot $ withTestEnv $ do
1622 let r1n = SnapshotRepoName "bloodhound-repo1"
1623 withSnapshotRepo r1n $ \r1 -> do
1624 let Just (String dir) = HM.lookup "location" (gSnapshotRepoSettingsObject (gSnapshotRepoSettings r1))
1625 let noCompression = FsSnapshotRepo r1n (T.unpack dir) False Nothing Nothing Nothing
1626 resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings noCompression
1627 liftIO (validateStatus resp 200)
1628 Right [roundtrippedNoCompression] <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| []))
1629 liftIO (roundtrippedNoCompression `shouldBe` toGSnapshotRepo noCompression)
1631 -- verify came around in 1.4 it seems
1632 it "can verify existing repos" $ when' canSnapshot $ when' (atleast es14) $ withTestEnv $ do
1633 let r1n = SnapshotRepoName "bloodhound-repo1"
1634 withSnapshotRepo r1n $ \_ -> do
1635 res <- verifySnapshotRepo r1n
1636 liftIO $ case res of
1637 Right (SnapshotVerification vs)
1638 | null vs -> expectationFailure "Expected nonempty set of verifying nodes"
1639 | otherwise -> return ()
1640 Left e -> expectationFailure (show e)
1642 describe "snapshots" $ do
1643 it "always parses all snapshots API" $ when' canSnapshot $ withTestEnv $ do
1644 let r1n = SnapshotRepoName "bloodhound-repo1"
1645 withSnapshotRepo r1n $ \_ -> do
1646 res <- getSnapshots r1n AllSnapshots
1647 liftIO $ case res of
1648 Left e -> expectationFailure ("Expected a right but got Left " <> show e)
1649 Right _ -> return ()
1651 it "can parse a snapshot that it created" $ when' canSnapshot $ withTestEnv $ do
1652 let r1n = SnapshotRepoName "bloodhound-repo1"
1653 withSnapshotRepo r1n $ \_ -> do
1654 let s1n = SnapshotName "example-snapshot"
1655 withSnapshot r1n s1n $ do
1656 res <- getSnapshots r1n (SnapshotList (ExactSnap s1n :| []))
1657 liftIO $ case res of
1659 | snapInfoState snap == SnapshotSuccess &&
1660 snapInfoName snap == s1n -> return ()
1661 | otherwise -> expectationFailure (show snap)
1662 Right [] -> expectationFailure "There were no snapshots"
1663 Right snaps -> expectationFailure ("Expected 1 snapshot but got" <> show (length snaps))
1664 Left e -> expectationFailure (show e)
1666 describe "snapshot restore" $ do
1667 it "can restore a snapshot that we create" $ when' canSnapshot $ withTestEnv $ do
1668 let r1n = SnapshotRepoName "bloodhound-repo1"
1669 withSnapshotRepo r1n $ \_ -> do
1670 let s1n = SnapshotName "example-snapshot"
1671 withSnapshot r1n s1n $ do
1672 let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True }
1673 -- have to close an index to restore it
1674 resp1 <- closeIndex testIndex
1675 liftIO (validateStatus resp1 200)
1676 resp2 <- restoreSnapshot r1n s1n settings
1677 liftIO (validateStatus resp2 200)
1679 it "can restore and rename" $ when' canSnapshot $ withTestEnv $ do
1680 let r1n = SnapshotRepoName "bloodhound-repo1"
1681 withSnapshotRepo r1n $ \_ -> do
1682 let s1n = SnapshotName "example-snapshot"
1683 withSnapshot r1n s1n $ do
1684 let pat = RestoreRenamePattern "bloodhound-tests-twitter-(\\d+)"
1685 let replace = RRTLit "restored-" :| [RRSubWholeMatch]
1686 let expectedIndex = IndexName "restored-bloodhound-tests-twitter-1"
1687 oldEnoughForOverrides <- liftIO (atleast es15)
1688 let overrides = RestoreIndexSettings { restoreOverrideReplicas = Just (ReplicaCount 0) }
1689 let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True
1690 , snapRestoreRenamePattern = Just pat
1691 , snapRestoreRenameReplacement = Just replace
1692 , snapRestoreIndexSettingsOverrides = if oldEnoughForOverrides
1696 -- have to close an index to restore it
1698 resp <- restoreSnapshot r1n s1n settings
1699 liftIO (validateStatus resp 200)
1700 exists <- indexExists expectedIndex
1701 liftIO (exists `shouldBe` True)
1702 go `finally` deleteIndex expectedIndex
1704 describe "getNodesInfo" $ do
1705 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
1706 res <- getNodesInfo LocalNode
1707 liftIO $ case res of
1708 -- This is really just a smoke test for response
1709 -- parsing. Node info is so variable, there's not much I can
1711 Right NodesInfo {..} -> length nodesInfo `shouldBe` 1
1712 Left e -> expectationFailure ("Expected NodesInfo but got " <> show e)
1714 describe "getNodesStats" $ do
1715 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
1716 res <- getNodesStats LocalNode
1717 liftIO $ case res of
1718 -- This is really just a smoke test for response
1719 -- parsing. Node stats is so variable, there's not much I can
1721 Right NodesStats {..} -> length nodesStats `shouldBe` 1
1722 Left e -> expectationFailure ("Expected NodesStats but got " <> show e)
1724 describe "Enum DocVersion" $ do
1725 it "follows the laws of Enum, Bounded" $ do
1726 evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall
1727 evaluate (pred minBound :: DocVersion) `shouldThrow` anyErrorCall
1728 evaluate (toEnum 0 :: DocVersion) `shouldThrow` anyErrorCall
1729 evaluate (toEnum 9200000000000000001 :: DocVersion) `shouldThrow` anyErrorCall
1730 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1731 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1732 enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]
1734 describe "scan&scroll API" $ do
1735 it "returns documents using the scan&scroll API" $ withTestEnv $ do
1738 let search = (mkSearch (Just $ MatchAllQuery Nothing) Nothing) { size = (Size 1) }
1739 regular_search <- searchTweet search
1740 scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet]
1741 let scan_search = map hitSource scan_search'
1743 regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored
1745 scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]
1747 describe "index aliases" $ do
1748 it "handles the simple case of aliasing an existing index" $ do
1749 let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1750 let create = IndexAliasCreate Nothing Nothing
1751 let action = AddAlias alias create
1755 resp <- updateIndexAliases (action :| [])
1756 liftIO $ validateStatus resp 200
1757 let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1758 (do aliases <- withTestEnv getIndexAliases
1759 let expected = IndexAliasSummary alias create
1761 Right (IndexAliasesSummary summs) ->
1762 L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1763 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1765 it "handles an alias with routing and a filter" $ do
1766 let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1767 let sar = SearchAliasRouting (RoutingValue "search val" :| [])
1768 let iar = IndexAliasRouting (RoutingValue "index val")
1769 let routing = GranularAliasRouting (Just sar) (Just iar)
1770 let filter = LimitFilter 42
1771 let create = IndexAliasCreate (Just routing) (Just filter)
1772 let action = AddAlias alias create
1776 resp <- updateIndexAliases (action :| [])
1777 liftIO $ validateStatus resp 200
1778 let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1779 (do aliases <- withTestEnv getIndexAliases
1780 let expected = IndexAliasSummary alias create
1782 Right (IndexAliasesSummary summs) ->
1783 L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1784 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1786 describe "Index Listing" $ do
1787 it "returns a list of index names" $ withTestEnv $ do
1788 _ <- createExampleIndex
1790 liftIO (ixns `shouldContain` [testIndex])
1792 describe "Index Settings" $ do
1793 it "persists settings" $ withTestEnv $ do
1794 _ <- deleteExampleIndex
1795 _ <- createExampleIndex
1796 let updates = BlocksWrite False :| []
1797 updateResp <- updateIndexSettings updates testIndex
1798 liftIO $ validateStatus updateResp 200
1799 getResp <- getIndexSettings testIndex
1801 getResp `shouldBe` Right (IndexSettingsSummary
1803 (IndexSettings (ShardCount 1) (ReplicaCount 0))
1804 (NE.toList updates))
1806 describe "Index Optimization" $ do
1807 it "returns a successful response upon completion" $ withTestEnv $ do
1808 _ <- createExampleIndex
1809 resp <- optimizeIndex (IndexList (testIndex :| [])) defaultIndexOptimizationSettings
1810 liftIO $ validateStatus resp 200
1812 describe "Suggest" $ do
1813 it "returns a search suggestion using the phrase suggester" $ withTestEnv $ do
1815 let {- query = QueryMatchNoneQuery
1816 query = TermQuery (Term "user" "bitemyapp") Nothing -}
1817 let phraseSuggester = mkPhraseSuggester (FieldName "message")
1818 namedSuggester = Suggest "Use haskel" "suggest_name" (SuggestTypePhraseSuggester phraseSuggester)
1819 search' = mkSearch Nothing Nothing
1820 search = search' { suggestBody = Just namedSuggester }
1821 expectedText = Just "use haskell"
1822 resp <- searchByIndex testIndex search
1823 parsed <- parseEsResponse resp :: BH IO (Either EsError (SearchResult Tweet))
1825 Left e -> liftIO $ expectationFailure ("Expected an search suggestion but got " <> show e)
1826 Right sr -> liftIO $ (suggestOptionsText . head . suggestResponseOptions . head . nsrResponses <$> suggest sr) `shouldBe` expectedText
1828 describe "JSON instances" $ do
1829 propJSON (Proxy :: Proxy Version)
1830 propJSON (Proxy :: Proxy IndexName)
1831 propJSON (Proxy :: Proxy MappingName)
1832 propJSON (Proxy :: Proxy DocId)
1833 propJSON (Proxy :: Proxy IndexAliasRouting)
1834 propJSON (Proxy :: Proxy RoutingValue)
1835 propJSON (Proxy :: Proxy ShardCount)
1836 propJSON (Proxy :: Proxy ReplicaCount)
1837 propJSON (Proxy :: Proxy TemplateName)
1838 propJSON (Proxy :: Proxy TemplatePattern)
1839 propJSON (Proxy :: Proxy QueryString)
1840 propJSON (Proxy :: Proxy FieldName)
1841 propJSON (Proxy :: Proxy CacheName)
1842 propJSON (Proxy :: Proxy CacheKey)
1843 propJSON (Proxy :: Proxy Existence)
1844 propJSON (Proxy :: Proxy CutoffFrequency)
1845 propJSON (Proxy :: Proxy Analyzer)
1846 propJSON (Proxy :: Proxy MaxExpansions)
1847 propJSON (Proxy :: Proxy Lenient)
1848 propJSON (Proxy :: Proxy Tiebreaker)
1849 propJSON (Proxy :: Proxy Boost)
1850 propJSON (Proxy :: Proxy BoostTerms)
1851 propJSON (Proxy :: Proxy MinimumMatch)
1852 propJSON (Proxy :: Proxy DisableCoord)
1853 propJSON (Proxy :: Proxy IgnoreTermFrequency)
1854 propJSON (Proxy :: Proxy MinimumTermFrequency)
1855 propJSON (Proxy :: Proxy MaxQueryTerms)
1856 propJSON (Proxy :: Proxy Fuzziness)
1857 propJSON (Proxy :: Proxy PrefixLength)
1858 propJSON (Proxy :: Proxy TypeName)
1859 propJSON (Proxy :: Proxy PercentMatch)
1860 propJSON (Proxy :: Proxy StopWord)
1861 propJSON (Proxy :: Proxy QueryPath)
1862 propJSON (Proxy :: Proxy AllowLeadingWildcard)
1863 propJSON (Proxy :: Proxy LowercaseExpanded)
1864 propJSON (Proxy :: Proxy EnablePositionIncrements)
1865 propJSON (Proxy :: Proxy AnalyzeWildcard)
1866 propJSON (Proxy :: Proxy GeneratePhraseQueries)
1867 propJSON (Proxy :: Proxy Locale)
1868 propJSON (Proxy :: Proxy MaxWordLength)
1869 propJSON (Proxy :: Proxy MinWordLength)
1870 propJSON (Proxy :: Proxy PhraseSlop)
1871 propJSON (Proxy :: Proxy MinDocFrequency)
1872 propJSON (Proxy :: Proxy MaxDocFrequency)
1873 propJSON (Proxy :: Proxy Filter)
1874 propJSON (Proxy :: Proxy Query)
1875 propJSON (Proxy :: Proxy SimpleQueryStringQuery)
1876 propJSON (Proxy :: Proxy FieldOrFields)
1877 propJSON (Proxy :: Proxy SimpleQueryFlag)
1878 propJSON (Proxy :: Proxy RegexpQuery)
1879 propJSON (Proxy :: Proxy QueryStringQuery)
1880 propJSON (Proxy :: Proxy RangeQuery)
1881 propJSON (Proxy :: Proxy PrefixQuery)
1882 propJSON (Proxy :: Proxy NestedQuery)
1883 propJSON (Proxy :: Proxy MoreLikeThisFieldQuery)
1884 propJSON (Proxy :: Proxy MoreLikeThisQuery)
1885 propJSON (Proxy :: Proxy IndicesQuery)
1886 propJSON (Proxy :: Proxy HasParentQuery)
1887 propJSON (Proxy :: Proxy HasChildQuery)
1888 propJSON (Proxy :: Proxy FuzzyQuery)
1889 propJSON (Proxy :: Proxy FuzzyLikeFieldQuery)
1890 propJSON (Proxy :: Proxy FuzzyLikeThisQuery)
1891 propJSON (Proxy :: Proxy FilteredQuery)
1892 propJSON (Proxy :: Proxy DisMaxQuery)
1893 propJSON (Proxy :: Proxy CommonTermsQuery)
1894 propJSON (Proxy :: Proxy CommonMinimumMatch)
1895 propJSON (Proxy :: Proxy BoostingQuery)
1896 propJSON (Proxy :: Proxy BoolQuery)
1897 propJSON (Proxy :: Proxy MatchQuery)
1898 propJSON (Proxy :: Proxy MultiMatchQueryType)
1899 propJSON (Proxy :: Proxy BooleanOperator)
1900 propJSON (Proxy :: Proxy ZeroTermsQuery)
1901 propJSON (Proxy :: Proxy MatchQueryType)
1902 propJSON (Proxy :: Proxy AliasRouting)
1903 propJSON (Proxy :: Proxy IndexAliasCreate)
1904 propJSON (Proxy :: Proxy SearchAliasRouting)
1905 propJSON (Proxy :: Proxy ScoreType)
1906 propJSON (Proxy :: Proxy Distance)
1907 propJSON (Proxy :: Proxy DistanceUnit)
1908 propJSON (Proxy :: Proxy DistanceType)
1909 propJSON (Proxy :: Proxy OptimizeBbox)
1910 propJSON (Proxy :: Proxy GeoBoundingBoxConstraint)
1911 propJSON (Proxy :: Proxy GeoFilterType)
1912 propJSON (Proxy :: Proxy GeoBoundingBox)
1913 propJSON (Proxy :: Proxy LatLon)
1914 propJSON (Proxy :: Proxy RangeExecution)
1915 prop "RegexpFlags FromJSON/ToJSON roundtrips, removing dups " $ \rfs ->
1916 let expected = case rfs of
1917 SomeRegexpFlags fs -> SomeRegexpFlags (NE.fromList (nub (NE.toList fs)))
1919 in parseEither parseJSON (toJSON rfs) === Right expected
1920 propJSON (Proxy :: Proxy BoolMatch)
1921 propJSON (Proxy :: Proxy Term)
1922 propJSON (Proxy :: Proxy MultiMatchQuery)
1923 propJSON (Proxy :: Proxy IndexSettings)
1924 propJSON (Proxy :: Proxy UpdatableIndexSetting')
1925 propJSON (Proxy :: Proxy ReplicaBounds)
1926 propJSON (Proxy :: Proxy Bytes)
1927 propJSON (Proxy :: Proxy AllocationPolicy)
1928 propJSON (Proxy :: Proxy InitialShardCount)
1929 propJSON (Proxy :: Proxy FSType)
1930 propJSON (Proxy :: Proxy CompoundFormat)
1931 propJSON (Proxy :: Proxy TemplateQueryInline)
1932 propJSON (Proxy :: Proxy Suggest)
1934-- Temporary solution for lacking of generic derivation of Arbitrary
1935-- We use generics-sop, as it's much more concise than directly using GHC.Generics
1937-- This will be unneeded after https://github.com/nick8325/quickcheck/pull/112
1938-- is merged and released
1939sopArbitrary :: forall a. (Generic a, SOP.GTo a, SOP.All SOP.SListI (SOP.GCode a), SOP.All2 Arbitrary (SOP.GCode a)) => Gen a
1940sopArbitrary = fmap SOP.gto sopArbitrary'
1942sopArbitrary' :: forall xss. (SOP.All SOP.SListI xss, SOP.All2 Arbitrary xss) => Gen (SOP.SOP SOP.I xss)
1943sopArbitrary' = SOP.hsequence =<< elements (SOP.apInjs_POP $ SOP.hcpure p arbitrary)
1945 p :: Proxy Arbitrary
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list