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