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