git.iko.soy/typeable/bloodhound
on faster-compile-script-merge help sign in
typeable/bloodhound/tests/V5/tests.hs
1935 lines 85 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 TemplateHaskell #-}
11{-# LANGUAGE TypeOperators #-}
12{-# OPTIONS_GHC -fno-warn-orphans #-}
13#if __GLASGOW_HASKELL__ < 800
14{-# OPTIONS_GHC -fcontext-stack=100 #-}
15#endif
16#if __GLASGOW_HASKELL__ >= 802
17{-# LANGUAGE MonoLocalBinds #-}
18#endif
19module Main where
21import Control.Applicative
22import Control.Error hiding (Script)
23import Control.Exception (evaluate)
24import Control.Monad
25import Control.Monad.Catch
26import Control.Monad.Reader
27import Data.Aeson
28import Data.Aeson.TH
29import Data.Aeson.Types (parseEither)
30import qualified Data.ByteString.Lazy.Char8 as BL8
31import qualified Data.HashMap.Strict as HM
32import Data.List (nub)
33import qualified Data.List as L
34import Data.List.NonEmpty (NonEmpty (..))
35import qualified Data.List.NonEmpty as NE
36import qualified Data.Map.Strict as M
37import Data.Monoid
38import Data.Ord (comparing)
39import Data.Proxy
40import Data.Text (Text)
41import qualified Data.Text as T
42import Data.Time.Calendar (Day (..), fromGregorian)
43import Data.Time.Clock (NominalDiffTime, UTCTime (..),
44 secondsToDiffTime)
45import Data.Typeable
46import qualified Data.Vector as V
47import qualified Data.Version as Vers
48import Database.V5.Bloodhound
49import Network.HTTP.Client hiding (Proxy)
50import qualified Network.HTTP.Types.Method as NHTM
51import qualified Network.HTTP.Types.Status as NHTS
52import qualified Network.URI as URI
53import Prelude hiding (filter)
54import System.IO.Temp
55import System.PosixCompat.Files
56import Test.Hspec
57import Test.QuickCheck.Property.Monoid (T (..), eq, prop_Monoid)
59import Test.Hspec.QuickCheck (prop)
60import Test.QuickCheck
61import Test.QuickCheck.TH.Generators
62import Text.Pretty.Simple (pPrint)
64testServer :: Server
65testServer = Server "http://localhost:9200"
66testIndex :: IndexName
67testIndex = IndexName "bloodhound-tests-twitter-1"
68testMapping :: MappingName
69testMapping = MappingName "tweet"
71withTestEnv :: BH IO a -> IO a
72withTestEnv = withBH defaultManagerSettings testServer
74validateStatus :: Show body => Response body -> Int -> Expectation
75validateStatus resp expected =
76 if actual == expected
77 then return ()
78 else expectationFailure ("Expected " <> show expected <> " but got " <> show actual <> ": " <> show body)
79 where
80 actual = NHTS.statusCode (responseStatus resp)
81 body = responseBody resp
83createExampleIndex :: (MonadBH m) => m Reply
84createExampleIndex = createIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) testIndex
85deleteExampleIndex :: (MonadBH m) => m Reply
86deleteExampleIndex = deleteIndex testIndex
88es13 :: Vers.Version
89es13 = Vers.Version [1, 3, 0] []
91es12 :: Vers.Version
92es12 = Vers.Version [1, 2, 0] []
94es11 :: Vers.Version
95es11 = Vers.Version [1, 1, 0] []
97es14 :: Vers.Version
98es14 = Vers.Version [1, 4, 0] []
100es15 :: Vers.Version
101es15 = Vers.Version [1, 5, 0] []
103es16 :: Vers.Version
104es16 = Vers.Version [1, 6, 0] []
106es20 :: Vers.Version
107es20 = Vers.Version [2, 0, 0] []
109es50 :: Vers.Version
110es50 = Vers.Version [5, 0, 0] []
112getServerVersion :: IO (Maybe Vers.Version)
113getServerVersion = fmap extractVersion <$> withTestEnv getStatus
114 where
115 extractVersion = versionNumber . number . version
117-- | Get configured repo paths for snapshotting. Note that by default
118-- this is not enabled and if we are over es 1.5, we won't be able to
119-- test snapshotting. Note that this can and should be part of the
120-- client functionality in a much less ad-hoc incarnation.
121getRepoPaths :: IO [FilePath]
122getRepoPaths = withTestEnv $ do
123 bhe <- getBHEnv
124 let Server s = bhServer bhe
125 let tUrl = s <> "/" <> "_nodes"
126 initReq <- parseRequest (URI.escapeURIString URI.isAllowedInURI (T.unpack tUrl))
127 let req = setRequestIgnoreStatus $ initReq { method = NHTM.methodGet }
128 Right (Object o) <- parseEsResponse =<< liftIO (httpLbs req (bhManager bhe))
129 return $ fromMaybe mempty $ do
130 Object nodes <- HM.lookup "nodes" o
131 Object firstNode <- snd <$> headMay (HM.toList nodes)
132 Object settings <- HM.lookup "settings" firstNode
133 Object path <- HM.lookup "path" settings
134 Array repo <- HM.lookup "repo" path
135 return [ T.unpack t | String t <- V.toList repo]
137-- | 1.5 and earlier don't care about repo paths
138canSnapshot :: IO Bool
139canSnapshot = do
140 caresAboutRepos <- atleast es16
141 repoPaths <- getRepoPaths
142 return (not caresAboutRepos || not (null (repoPaths)))
144atleast :: Vers.Version -> IO Bool
145atleast v = getServerVersion >>= \x -> return $ x >= Just v
147atmost :: Vers.Version -> IO Bool
148atmost v = getServerVersion >>= \x -> return $ x <= Just v
150is :: Vers.Version -> IO Bool
151is v = getServerVersion >>= \x -> return $ x == Just v
153when' :: Monad m => m Bool -> m () -> m ()
154when' b f = b >>= \x -> when x f
156propJSON :: forall a
157 . ( Arbitrary a
158 , ToJSON a
159 , FromJSON a
160 , Show a
161 , Eq a
162 , Typeable a
163 )
164 => Proxy a -> Spec
165propJSON _ = prop testName $ \(a :: a) ->
166 let jsonStr = "via " <> BL8.unpack (encode a)
167 in counterexample jsonStr (parseEither parseJSON (toJSON a)
168 === Right a)
169 where testName = show ty <> " FromJSON/ToJSON roundtrips"
170 ty = typeOf (undefined :: a)
172data Location = Location { lat :: Double
173 , lon :: Double } deriving (Eq, Show)
175data Tweet = Tweet { user :: Text
176 , postDate :: UTCTime
177 , message :: Text
178 , age :: Int
179 , location :: Location
180 , extra :: Maybe Text }
181 deriving (Eq, Show)
183$(deriveJSON defaultOptions ''Location)
184$(deriveJSON defaultOptions ''Tweet)
186data ParentMapping = ParentMapping deriving (Eq, Show)
188instance ToJSON ParentMapping where
189 toJSON ParentMapping =
190 object ["properties" .=
191 object [ "user" .= object ["type" .= ("string" :: Text)
192 , "fielddata" .= True
193 ]
194 -- Serializing the date as a date is breaking other tests, mysteriously.
195 -- , "postDate" .= object [ "type" .= ("date" :: Text)
196 -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
197 , "message" .= object ["type" .= ("string" :: Text)]
198 , "age" .= object ["type" .= ("integer" :: Text)]
199 , "location" .= object ["type" .= ("geo_point" :: Text)]
200 , "extra" .= object ["type" .= ("keyword" :: Text)]
201 ]]
203data ChildMapping = ChildMapping deriving (Eq, Show)
205instance ToJSON ChildMapping where
206 toJSON ChildMapping =
207 object ["_parent" .= object ["type" .= ("parent" :: Text)]
208 , "properties" .=
209 object [ "user" .= object ["type" .= ("string" :: Text)
210 , "fielddata" .= True
211 ]
212 -- Serializing the date as a date is breaking other tests, mysteriously.
213 -- , "postDate" .= object [ "type" .= ("date" :: Text)
214 -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
215 , "message" .= object ["type" .= ("string" :: Text)]
216 , "age" .= object ["type" .= ("integer" :: Text)]
217 , "location" .= object ["type" .= ("geo_point" :: Text)]
218 , "extra" .= object ["type" .= ("keyword" :: Text)]
219 ]]
221data TweetMapping = TweetMapping deriving (Eq, Show)
223instance ToJSON TweetMapping where
224 toJSON TweetMapping =
225 object ["tweet" .=
226 object ["properties" .=
227 object [ "user" .= object [ "type" .= ("string" :: Text)
228 , "fielddata" .= True
229 ]
230 -- Serializing the date as a date is breaking other tests, mysteriously.
231 -- , "postDate" .= object [ "type" .= ("date" :: Text)
232 -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
233 , "message" .= object ["type" .= ("string" :: Text)]
234 , "age" .= object ["type" .= ("integer" :: Text)]
235 , "location" .= object ["type" .= ("geo_point" :: Text)]
236 , "extra" .= object ["type" .= ("keyword" :: Text)]
237 ]]]
239exampleTweet :: Tweet
240exampleTweet = Tweet { user = "bitemyapp"
241 , postDate = UTCTime
242 (ModifiedJulianDay 55000)
243 (secondsToDiffTime 10)
244 , message = "Use haskell!"
245 , age = 10000
246 , location = Location 40.12 (-71.34)
247 , extra = Nothing }
249tweetWithExtra :: Tweet
250tweetWithExtra = Tweet { user = "bitemyapp"
251 , postDate = UTCTime
252 (ModifiedJulianDay 55000)
253 (secondsToDiffTime 10)
254 , message = "Use haskell!"
255 , age = 10000
256 , location = Location 40.12 (-71.34)
257 , extra = Just "blah blah" }
259newAge :: Int
260newAge = 31337
262newUser :: Text
263newUser = "someotherapp"
265tweetPatch :: Value
266tweetPatch =
267 object [ "age" .= newAge
268 , "user" .= newUser
269 ]
271patchedTweet :: Tweet
272patchedTweet = exampleTweet{age = newAge, user = newUser}
274otherTweet :: Tweet
275otherTweet = Tweet { user = "notmyapp"
276 , postDate = UTCTime
277 (ModifiedJulianDay 55000)
278 (secondsToDiffTime 11)
279 , message = "Use haskell!"
280 , age = 1000
281 , location = Location 40.12 (-71.34)
282 , extra = Nothing }
284resetIndex :: BH IO ()
285resetIndex = do
286 _ <- deleteExampleIndex
287 _ <- createExampleIndex
288 _ <- putMapping testIndex testMapping TweetMapping
289 return ()
291insertData :: BH IO Reply
292insertData = do
293 resetIndex
294 insertData' defaultIndexDocumentSettings
296insertData' :: IndexDocumentSettings -> BH IO Reply
297insertData' ids = do
298 r <- indexDocument testIndex testMapping ids exampleTweet (DocId "1")
299 _ <- refreshIndex testIndex
300 return r
302updateData :: BH IO Reply
303updateData = do
304 r <- updateDocument testIndex testMapping defaultIndexDocumentSettings tweetPatch (DocId "1")
305 _ <- refreshIndex testIndex
306 return r
308insertOther :: BH IO ()
309insertOther = do
310 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings otherTweet (DocId "2")
311 _ <- refreshIndex testIndex
312 return ()
314insertExtra :: BH IO ()
315insertExtra = do
316 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings tweetWithExtra (DocId "4")
317 _ <- refreshIndex testIndex
318 return ()
320insertWithSpaceInId :: BH IO ()
321insertWithSpaceInId = do
322 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "Hello World")
323 _ <- refreshIndex testIndex
324 return ()
326searchTweet :: Search -> BH IO (Either EsError Tweet)
327searchTweet search = do
328 result <- searchTweets search
329 let myTweet :: Either EsError Tweet
330 myTweet = grabFirst result
331 return myTweet
333searchTweets :: Search -> BH IO (Either EsError (SearchResult Tweet))
334searchTweets search = parseEsResponse =<< searchByIndex testIndex search
336searchExpectNoResults :: Search -> BH IO ()
337searchExpectNoResults search = do
338 result <- searchTweets search
339 let emptyHits = fmap (hits . searchHits) result
340 liftIO $
341 emptyHits `shouldBe` Right []
343searchExpectAggs :: Search -> BH IO ()
344searchExpectAggs search = do
345 reply <- searchByIndex testIndex search
346 let isEmpty x = return (M.null x)
347 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
348 liftIO $
349 (result >>= aggregations >>= isEmpty) `shouldBe` Just False
351searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) =>
352 Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> BH IO ()
353searchValidBucketAgg search aggKey extractor = do
354 reply <- searchByIndex testIndex search
355 let bucketDocs = docCount . head . buckets
356 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
357 let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)
358 liftIO $
359 count `shouldBe` Just 1
361searchTermsAggHint :: [ExecutionHint] -> BH IO ()
362searchTermsAggHint hints = do
363 let terms hint = TermsAgg $ (mkTermsAggregation "user") { termExecutionHint = Just hint }
364 let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint
365 forM_ hints $ searchExpectAggs . search
366 forM_ hints (\x -> searchValidBucketAgg (search x) "users" toTerms)
368searchTweetHighlight :: Search -> BH IO (Either EsError (Maybe HitHighlight))
369searchTweetHighlight search = do
370 result <- searchTweets search
371 let myHighlight = fmap (hitHighlight . head . hits . searchHits) result
372 return myHighlight
374searchExpectSource :: Source -> Either EsError Value -> BH IO ()
375searchExpectSource src expected = do
376 _ <- insertData
377 let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
378 let search = (mkSearch (Just query) Nothing) { source = Just src }
379 reply <- searchByIndex testIndex search
380 result <- parseEsResponse reply
381 let value = grabFirst result
382 liftIO $
383 value `shouldBe` expected
385withSnapshotRepo
386 :: ( MonadMask m
387 , MonadBH m
388 )
389 => SnapshotRepoName
390 -> (GenericSnapshotRepo -> m a)
391 -> m a
392withSnapshotRepo srn@(SnapshotRepoName n) f = do
393 repoPaths <- liftIO getRepoPaths
394 -- we'll use the first repo path if available, otherwise system temp
395 -- dir. Note that this will fail on ES > 1.6, so be sure you use
396 -- @when' canSnapshot@.
397 case repoPaths of
398 (firstRepoPath:_) -> withTempDirectory firstRepoPath (T.unpack n) $ \dir -> bracket (alloc dir) free f
399 [] -> withSystemTempDirectory (T.unpack n) $ \dir -> bracket (alloc dir) free f
400 where
401 alloc dir = do
402 liftIO (setFileMode dir mode)
403 let repo = FsSnapshotRepo srn "bloodhound-tests-backups" True Nothing Nothing Nothing
404 resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings repo
405 liftIO (validateStatus resp 200)
406 return (toGSnapshotRepo repo)
407 mode = ownerModes `unionFileModes` groupModes `unionFileModes` otherModes
408 free GenericSnapshotRepo {..} = do
409 resp <- deleteSnapshotRepo gSnapshotRepoName
410 liftIO (validateStatus resp 200)
413withSnapshot
414 :: ( MonadMask m
415 , MonadBH m
416 )
417 => SnapshotRepoName
418 -> SnapshotName
419 -> m a
420 -> m a
421withSnapshot srn sn = bracket_ alloc free
422 where
423 alloc = do
424 resp <- createSnapshot srn sn createSettings
425 liftIO (validateStatus resp 200)
426 -- We'll make this synchronous for testing purposes
427 createSettings = defaultSnapshotCreateSettings { snapWaitForCompletion = True
428 , snapIndices = Just (IndexList (testIndex :| []))
429 -- We don't actually need to back up any data
430 }
431 free = do
432 deleteSnapshot srn sn
436newtype BulkTest =
437 BulkTest { name :: Text }
438 deriving (Eq, Show)
440instance ToJSON BulkTest where
441 toJSON (BulkTest name) =
442 object ["name" .= name]
444instance FromJSON BulkTest where
445 parseJSON = withObject "BulkTest" parse
446 where
447 parse o = do
448 t <- o .: "name"
449 BulkTest <$> parseJSON t
451-- | Typeclass for "equal where it matters". Use this to specify
452-- less-strict equivalence for things such as lists that can wind up
453-- in an unpredictable order
454class ApproxEq a where
455 (=~) :: a -> a -> Bool
457 showApproxEq :: a -> String
458 default showApproxEq :: (Show a) => a -> String
459 showApproxEq = show
461(==~) :: (ApproxEq a) => a -> a -> Property
462a ==~ b = counterexample (showApproxEq a ++ " !=~ " ++ showApproxEq b) (a =~ b)
464propApproxJSON :: forall a
465 . ( Arbitrary a
466 , ToJSON a
467 , FromJSON a
468 , Show a
469 , ApproxEq a
470 , Typeable a
471 )
472 => Proxy a -> Spec
473propApproxJSON _ = prop testName $ \(a :: a) ->
474 let jsonStr = "via " <> BL8.unpack (encode a)
475 in counterexample jsonStr (parseEither parseJSON (toJSON a)
476 ==~ Right a)
477 where testName = show ty <> " FromJSON/ToJSON roundtrips"
478 ty = typeOf (undefined :: a)
480instance ApproxEq NominalDiffTime where (=~) = (==)
481instance ApproxEq Bool where (=~) = (==)
482instance ApproxEq Int where (=~) = (==)
483instance (Eq a, Show a) => ApproxEq (Maybe a) where (=~) = (==)
484instance ApproxEq Char where
485 (=~) = (==)
487instance ApproxEq NodeAttrFilter where (=~) = (==)
488instance ApproxEq NodeAttrName where (=~) = (==)
489instance (Eq a, Show a) => ApproxEq (NonEmpty a) where (=~) = (==)
490instance (ApproxEq l, Show l, ApproxEq r, Show r) => ApproxEq (Either l r) where
491 Left a =~ Left b = a =~ b
492 Right a =~ Right b = a =~ b
493 _ =~ _ = False
494 showApproxEq (Left x) = "Left " <> showApproxEq x
495 showApproxEq (Right x) = "Right " <> showApproxEq x
496instance (ApproxEq a, Show a) => ApproxEq [a] where
497 as =~ bs = and (zipWith (=~) as bs)
498instance ApproxEq ReplicaCount where (=~) = (==)
499instance ApproxEq ReplicaBounds where (=~) = (==)
500instance ApproxEq Bytes where (=~) = (==)
501instance ApproxEq AllocationPolicy where (=~) = (==)
502instance ApproxEq InitialShardCount where (=~) = (==)
503instance ApproxEq FSType where (=~) = (==)
505noDuplicates :: Eq a => [a] -> Bool
506noDuplicates xs = nub xs == xs
508instance Arbitrary NominalDiffTime where
509 arbitrary = fromInteger <$> arbitrary
511#if !MIN_VERSION_QuickCheck(2,8,0)
512instance (Arbitrary k, Ord k, Arbitrary v) => Arbitrary (M.Map k v) where
513 arbitrary = M.fromList <$> arbitrary
514#endif
516instance Arbitrary Text where
517 arbitrary = T.pack <$> arbitrary
519instance Arbitrary UTCTime where
520 arbitrary = UTCTime
521 <$> arbitrary
522 <*> (fromRational . toRational <$> choose (0::Double, 86400))
524instance Arbitrary Day where
525 arbitrary = ModifiedJulianDay <$> (2000 +) <$> arbitrary
526 shrink = (ModifiedJulianDay <$>) . shrink . toModifiedJulianDay
528#if !MIN_VERSION_QuickCheck(2,9,0)
529instance Arbitrary a => Arbitrary (NonEmpty a) where
530 arbitrary = liftA2 (:|) arbitrary arbitrary
531#endif
533arbitraryScore :: Gen Score
534arbitraryScore = fmap getPositive <$> arbitrary
536instance (Arbitrary a, Typeable a) => Arbitrary (Hit a) where
537 arbitrary = Hit <$> arbitrary
538 <*> arbitrary
539 <*> arbitrary
540 <*> arbitraryScore
541 <*> arbitrary
542 <*> arbitrary
543 <*> arbitrary
545instance Arbitrary HitFields where
546 arbitrary = pure (HitFields M.empty)
547 shrink = const []
549instance (Arbitrary a, Typeable a) => Arbitrary (SearchHits a) where
550 arbitrary = reduceSize $ do
551 tot <- getPositive <$> arbitrary
552 score <- arbitraryScore
553 hs <- arbitrary
554 return $ SearchHits tot score hs
557reduceSize :: Gen a -> Gen a
558reduceSize f = sized $ \n -> resize (n `div` 2) f
560getSource :: EsResult a -> Maybe a
561getSource = fmap _source . foundResult
563grabFirst :: Either EsError (SearchResult a) -> Either EsError a
564grabFirst r =
565 case fmap (hitSource . head . hits . searchHits) r of
566 (Left e) -> Left e
567 (Right Nothing) -> Left (EsError 500 "Source was missing")
568 (Right (Just x)) -> Right x
570-------------------------------------------------------------------------------
571arbitraryAlphaNum :: Gen Char
572arbitraryAlphaNum = oneof [choose ('a', 'z')
573 ,choose ('A','Z')
574 , choose ('0', '9')]
576instance Arbitrary RoutingValue where
577 arbitrary = RoutingValue . T.pack <$> listOf1 arbitraryAlphaNum
579instance Arbitrary AliasRouting where
580 arbitrary = oneof [allAlias
581 ,one
582 ,theOther
583 ,both]
584 where one = GranularAliasRouting
585 <$> (Just <$> arbitrary)
586 <*> pure Nothing
587 theOther = GranularAliasRouting Nothing
588 <$> (Just <$> arbitrary)
589 both = GranularAliasRouting
590 <$> (Just <$> arbitrary)
591 <*> (Just <$> arbitrary)
592 allAlias = AllAliasRouting <$> arbitrary
596instance Arbitrary FieldName where
597 arbitrary =
598 FieldName
599 . T.pack
600 <$> listOf1 arbitraryAlphaNum
603#if MIN_VERSION_base(4,10,0)
604-- Test.QuickCheck.Modifiers
606qcNonEmptyToNonEmpty :: NonEmptyList a -> NonEmpty a
607qcNonEmptyToNonEmpty (NonEmpty (a : xs)) = (a :| xs)
608qcNonEmptyToNonEmpty (NonEmpty []) = error "NonEmpty was empty!"
610instance Arbitrary a => Arbitrary (NonEmpty a) where
611 arbitrary =
612 qcNonEmptyToNonEmpty
613 <$> arbitrary
614#endif
615instance Arbitrary ScriptFields where
616 arbitrary =
617 pure $ ScriptFields $
618 HM.fromList []
620 shrink = const []
622instance Arbitrary ScriptParams where
623 arbitrary =
624 pure $ ScriptParams $
625 HM.fromList [ ("a", Number 42)
626 , ("b", String "forty two")
627 ]
629 shrink = const []
631instance Arbitrary RegexpFlags where
632 arbitrary = oneof [ pure AllRegexpFlags
633 , pure NoRegexpFlags
634 , SomeRegexpFlags <$> genUniqueFlags
635 ]
636 where genUniqueFlags =
637 NE.fromList . nub
638 <$> listOf1 arbitrary
640instance Arbitrary IndexAliasCreate where
641 arbitrary =
642 IndexAliasCreate
643 <$> arbitrary
644 <*> reduceSize arbitrary
646instance Arbitrary Query where
647 arbitrary =
648 reduceSize
649 $ oneof [ TermQuery <$> arbitrary <*> arbitrary
650 , TermsQuery <$> arbitrary <*> arbitrary
651 , QueryMatchQuery <$> arbitrary
652 , QueryMultiMatchQuery <$> arbitrary
653 , QueryBoolQuery <$> arbitrary
654 , QueryBoostingQuery <$> arbitrary
655 , QueryCommonTermsQuery <$> arbitrary
656 , ConstantScoreQuery <$> arbitrary <*> arbitrary
657 , QueryDisMaxQuery <$> arbitrary
658 , QueryFuzzyLikeThisQuery <$> arbitrary
659 , QueryFuzzyLikeFieldQuery <$> arbitrary
660 , QueryFuzzyQuery <$> arbitrary
661 , QueryHasChildQuery <$> arbitrary
662 , QueryHasParentQuery <$> arbitrary
663 , IdsQuery <$> arbitrary <*> arbitrary
664 , QueryIndicesQuery <$> arbitrary
665 , MatchAllQuery <$> arbitrary
666 , QueryMoreLikeThisQuery <$> arbitrary
667 , QueryMoreLikeThisFieldQuery <$> arbitrary
668 , QueryNestedQuery <$> arbitrary
669 , QueryPrefixQuery <$> arbitrary
670 , QueryQueryStringQuery <$> arbitrary
671 , QuerySimpleQueryStringQuery <$> arbitrary
672 , QueryRangeQuery <$> arbitrary
673 , QueryRegexpQuery <$> arbitrary
674 , QueryTemplateQueryInline <$> arbitrary
675 ]
676 -- TODO: Implement shrink
677 -- shrink = genericShrink
679instance Arbitrary Filter where
680 arbitrary =
681 Filter <$> arbitrary
682 shrink (Filter q) =
683 Filter <$> shrink q
685instance Arbitrary ReplicaBounds where
686 arbitrary = oneof [ replicasBounded
687 , replicasLowerBounded
688 , pure ReplicasUnbounded
689 ]
690 where replicasBounded = do
691 Positive a <- arbitrary
692 Positive b <- arbitrary
693 return (ReplicasBounded a b)
694 replicasLowerBounded = do
695 Positive a <- arbitrary
696 return (ReplicasLowerBounded a)
698instance Arbitrary NodeAttrName where
699 arbitrary =
700 NodeAttrName
701 . T.pack
702 <$> listOf1 arbitraryAlphaNum
705instance Arbitrary NodeAttrFilter where
706 arbitrary = do
707 n <- arbitrary
708 s:ss <- listOf1 (listOf1 arbitraryAlphaNum)
709 let ts = T.pack <$> s :| ss
710 return (NodeAttrFilter n ts)
712instance Arbitrary VersionNumber where
713 arbitrary = mk . fmap getPositive . getNonEmpty <$> arbitrary
714 where
715 mk versions = VersionNumber (Vers.Version versions [])
717instance Arbitrary TemplateQueryKeyValuePairs where
718 arbitrary = TemplateQueryKeyValuePairs . HM.fromList <$> arbitrary
719 shrink (TemplateQueryKeyValuePairs x) = map (TemplateQueryKeyValuePairs . HM.fromList) . shrink $ HM.toList x
721makeArbitrary ''IndexName
722instance Arbitrary IndexName where arbitrary = arbitraryIndexName
723makeArbitrary ''MappingName
724instance Arbitrary MappingName where arbitrary = arbitraryMappingName
725makeArbitrary ''DocId
726instance Arbitrary DocId where arbitrary = arbitraryDocId
727makeArbitrary ''Version
728instance Arbitrary Version where arbitrary = arbitraryVersion
729makeArbitrary ''BuildHash
730instance Arbitrary BuildHash where arbitrary = arbitraryBuildHash
731makeArbitrary ''IndexAliasRouting
732instance Arbitrary IndexAliasRouting where arbitrary = arbitraryIndexAliasRouting
733makeArbitrary ''ShardCount
734instance Arbitrary ShardCount where arbitrary = arbitraryShardCount
735makeArbitrary ''ReplicaCount
736instance Arbitrary ReplicaCount where arbitrary = arbitraryReplicaCount
737makeArbitrary ''TemplateName
738instance Arbitrary TemplateName where arbitrary = arbitraryTemplateName
739makeArbitrary ''TemplatePattern
740instance Arbitrary TemplatePattern where arbitrary = arbitraryTemplatePattern
741makeArbitrary ''QueryString
742instance Arbitrary QueryString where arbitrary = arbitraryQueryString
743makeArbitrary ''CacheName
744instance Arbitrary CacheName where arbitrary = arbitraryCacheName
745makeArbitrary ''CacheKey
746instance Arbitrary CacheKey where arbitrary = arbitraryCacheKey
747makeArbitrary ''Existence
748instance Arbitrary Existence where arbitrary = arbitraryExistence
749makeArbitrary ''CutoffFrequency
750instance Arbitrary CutoffFrequency where arbitrary = arbitraryCutoffFrequency
751makeArbitrary ''Analyzer
752instance Arbitrary Analyzer where arbitrary = arbitraryAnalyzer
753makeArbitrary ''MaxExpansions
754instance Arbitrary MaxExpansions where arbitrary = arbitraryMaxExpansions
755makeArbitrary ''Lenient
756instance Arbitrary Lenient where arbitrary = arbitraryLenient
757makeArbitrary ''Tiebreaker
758instance Arbitrary Tiebreaker where arbitrary = arbitraryTiebreaker
759makeArbitrary ''Boost
760instance Arbitrary Boost where arbitrary = arbitraryBoost
761makeArbitrary ''BoostTerms
762instance Arbitrary BoostTerms where arbitrary = arbitraryBoostTerms
763makeArbitrary ''MinimumMatch
764instance Arbitrary MinimumMatch where arbitrary = arbitraryMinimumMatch
765makeArbitrary ''DisableCoord
766instance Arbitrary DisableCoord where arbitrary = arbitraryDisableCoord
767makeArbitrary ''IgnoreTermFrequency
768instance Arbitrary IgnoreTermFrequency where arbitrary = arbitraryIgnoreTermFrequency
769makeArbitrary ''MinimumTermFrequency
770instance Arbitrary MinimumTermFrequency where arbitrary = arbitraryMinimumTermFrequency
771makeArbitrary ''MaxQueryTerms
772instance Arbitrary MaxQueryTerms where arbitrary = arbitraryMaxQueryTerms
773makeArbitrary ''Fuzziness
774instance Arbitrary Fuzziness where arbitrary = arbitraryFuzziness
775makeArbitrary ''PrefixLength
776instance Arbitrary PrefixLength where arbitrary = arbitraryPrefixLength
777makeArbitrary ''TypeName
778instance Arbitrary TypeName where arbitrary = arbitraryTypeName
779makeArbitrary ''PercentMatch
780instance Arbitrary PercentMatch where arbitrary = arbitraryPercentMatch
781makeArbitrary ''StopWord
782instance Arbitrary StopWord where arbitrary = arbitraryStopWord
783makeArbitrary ''QueryPath
784instance Arbitrary QueryPath where arbitrary = arbitraryQueryPath
785makeArbitrary ''AllowLeadingWildcard
786instance Arbitrary AllowLeadingWildcard where arbitrary = arbitraryAllowLeadingWildcard
787makeArbitrary ''LowercaseExpanded
788instance Arbitrary LowercaseExpanded where arbitrary = arbitraryLowercaseExpanded
789makeArbitrary ''EnablePositionIncrements
790instance Arbitrary EnablePositionIncrements where arbitrary = arbitraryEnablePositionIncrements
791makeArbitrary ''AnalyzeWildcard
792instance Arbitrary AnalyzeWildcard where arbitrary = arbitraryAnalyzeWildcard
793makeArbitrary ''GeneratePhraseQueries
794instance Arbitrary GeneratePhraseQueries where arbitrary = arbitraryGeneratePhraseQueries
795makeArbitrary ''Locale
796instance Arbitrary Locale where arbitrary = arbitraryLocale
797makeArbitrary ''MaxWordLength
798instance Arbitrary MaxWordLength where arbitrary = arbitraryMaxWordLength
799makeArbitrary ''MinWordLength
800instance Arbitrary MinWordLength where arbitrary = arbitraryMinWordLength
801makeArbitrary ''PhraseSlop
802instance Arbitrary PhraseSlop where arbitrary = arbitraryPhraseSlop
803makeArbitrary ''MinDocFrequency
804instance Arbitrary MinDocFrequency where arbitrary = arbitraryMinDocFrequency
805makeArbitrary ''MaxDocFrequency
806instance Arbitrary MaxDocFrequency where arbitrary = arbitraryMaxDocFrequency
807makeArbitrary ''Regexp
808instance Arbitrary Regexp where arbitrary = arbitraryRegexp
809makeArbitrary ''SimpleQueryStringQuery
810instance Arbitrary SimpleQueryStringQuery where arbitrary = arbitrarySimpleQueryStringQuery
811makeArbitrary ''FieldOrFields
812instance Arbitrary FieldOrFields where arbitrary = arbitraryFieldOrFields
813makeArbitrary ''SimpleQueryFlag
814instance Arbitrary SimpleQueryFlag where arbitrary = arbitrarySimpleQueryFlag
815makeArbitrary ''RegexpQuery
816instance Arbitrary RegexpQuery where arbitrary = arbitraryRegexpQuery
817makeArbitrary ''QueryStringQuery
818instance Arbitrary QueryStringQuery where arbitrary = arbitraryQueryStringQuery
819makeArbitrary ''RangeQuery
820instance Arbitrary RangeQuery where arbitrary = arbitraryRangeQuery
821makeArbitrary ''RangeValue
822instance Arbitrary RangeValue where arbitrary = arbitraryRangeValue
823makeArbitrary ''PrefixQuery
824instance Arbitrary PrefixQuery where arbitrary = arbitraryPrefixQuery
825makeArbitrary ''NestedQuery
826instance Arbitrary NestedQuery where arbitrary = arbitraryNestedQuery
827makeArbitrary ''MoreLikeThisFieldQuery
828instance Arbitrary MoreLikeThisFieldQuery where arbitrary = arbitraryMoreLikeThisFieldQuery
829makeArbitrary ''MoreLikeThisQuery
830instance Arbitrary MoreLikeThisQuery where arbitrary = arbitraryMoreLikeThisQuery
831makeArbitrary ''IndicesQuery
832instance Arbitrary IndicesQuery where arbitrary = arbitraryIndicesQuery
833makeArbitrary ''HasParentQuery
834instance Arbitrary HasParentQuery where arbitrary = arbitraryHasParentQuery
835makeArbitrary ''HasChildQuery
836instance Arbitrary HasChildQuery where arbitrary = arbitraryHasChildQuery
837makeArbitrary ''FuzzyQuery
838instance Arbitrary FuzzyQuery where arbitrary = arbitraryFuzzyQuery
839makeArbitrary ''FuzzyLikeFieldQuery
840instance Arbitrary FuzzyLikeFieldQuery where arbitrary = arbitraryFuzzyLikeFieldQuery
841makeArbitrary ''FuzzyLikeThisQuery
842instance Arbitrary FuzzyLikeThisQuery where arbitrary = arbitraryFuzzyLikeThisQuery
843makeArbitrary ''DisMaxQuery
844instance Arbitrary DisMaxQuery where arbitrary = arbitraryDisMaxQuery
845makeArbitrary ''CommonTermsQuery
846instance Arbitrary CommonTermsQuery where arbitrary = arbitraryCommonTermsQuery
847makeArbitrary ''DistanceRange
848instance Arbitrary DistanceRange where arbitrary = arbitraryDistanceRange
849makeArbitrary ''MultiMatchQuery
850instance Arbitrary MultiMatchQuery where arbitrary = arbitraryMultiMatchQuery
851makeArbitrary ''LessThanD
852instance Arbitrary LessThanD where arbitrary = arbitraryLessThanD
853makeArbitrary ''LessThanEqD
854instance Arbitrary LessThanEqD where arbitrary = arbitraryLessThanEqD
855makeArbitrary ''GreaterThanD
856instance Arbitrary GreaterThanD where arbitrary = arbitraryGreaterThanD
857makeArbitrary ''GreaterThanEqD
858instance Arbitrary GreaterThanEqD where arbitrary = arbitraryGreaterThanEqD
859makeArbitrary ''LessThan
860instance Arbitrary LessThan where arbitrary = arbitraryLessThan
861makeArbitrary ''LessThanEq
862instance Arbitrary LessThanEq where arbitrary = arbitraryLessThanEq
863makeArbitrary ''GreaterThan
864instance Arbitrary GreaterThan where arbitrary = arbitraryGreaterThan
865makeArbitrary ''GreaterThanEq
866instance Arbitrary GreaterThanEq where arbitrary = arbitraryGreaterThanEq
867makeArbitrary ''GeoPoint
868instance Arbitrary GeoPoint where arbitrary = arbitraryGeoPoint
869makeArbitrary ''NullValue
870instance Arbitrary NullValue where arbitrary = arbitraryNullValue
871makeArbitrary ''MinimumMatchHighLow
872instance Arbitrary MinimumMatchHighLow where arbitrary = arbitraryMinimumMatchHighLow
873makeArbitrary ''CommonMinimumMatch
874instance Arbitrary CommonMinimumMatch where arbitrary = arbitraryCommonMinimumMatch
875makeArbitrary ''BoostingQuery
876instance Arbitrary BoostingQuery where arbitrary = arbitraryBoostingQuery
877makeArbitrary ''BoolQuery
878instance Arbitrary BoolQuery where arbitrary = arbitraryBoolQuery
879makeArbitrary ''MatchQuery
880instance Arbitrary MatchQuery where arbitrary = arbitraryMatchQuery
881makeArbitrary ''MultiMatchQueryType
882instance Arbitrary MultiMatchQueryType where arbitrary = arbitraryMultiMatchQueryType
883makeArbitrary ''BooleanOperator
884instance Arbitrary BooleanOperator where arbitrary = arbitraryBooleanOperator
885makeArbitrary ''ZeroTermsQuery
886instance Arbitrary ZeroTermsQuery where arbitrary = arbitraryZeroTermsQuery
887makeArbitrary ''MatchQueryType
888instance Arbitrary MatchQueryType where arbitrary = arbitraryMatchQueryType
889makeArbitrary ''SearchAliasRouting
890instance Arbitrary SearchAliasRouting where arbitrary = arbitrarySearchAliasRouting
891makeArbitrary ''ScoreType
892instance Arbitrary ScoreType where arbitrary = arbitraryScoreType
893makeArbitrary ''Distance
894instance Arbitrary Distance where arbitrary = arbitraryDistance
895makeArbitrary ''DistanceUnit
896instance Arbitrary DistanceUnit where arbitrary = arbitraryDistanceUnit
897makeArbitrary ''DistanceType
898instance Arbitrary DistanceType where arbitrary = arbitraryDistanceType
899makeArbitrary ''OptimizeBbox
900instance Arbitrary OptimizeBbox where arbitrary = arbitraryOptimizeBbox
901makeArbitrary ''GeoBoundingBoxConstraint
902instance Arbitrary GeoBoundingBoxConstraint where arbitrary = arbitraryGeoBoundingBoxConstraint
903makeArbitrary ''GeoFilterType
904instance Arbitrary GeoFilterType where arbitrary = arbitraryGeoFilterType
905makeArbitrary ''GeoBoundingBox
906instance Arbitrary GeoBoundingBox where arbitrary = arbitraryGeoBoundingBox
907makeArbitrary ''LatLon
908instance Arbitrary LatLon where arbitrary = arbitraryLatLon
909makeArbitrary ''RangeExecution
910instance Arbitrary RangeExecution where arbitrary = arbitraryRangeExecution
911makeArbitrary ''RegexpFlag
912instance Arbitrary RegexpFlag where arbitrary = arbitraryRegexpFlag
913makeArbitrary ''BoolMatch
914instance Arbitrary BoolMatch where arbitrary = arbitraryBoolMatch
915makeArbitrary ''Term
916instance Arbitrary Term where arbitrary = arbitraryTerm
917makeArbitrary ''IndexSettings
918instance Arbitrary IndexSettings where arbitrary = arbitraryIndexSettings
919makeArbitrary ''TokenChar
920instance Arbitrary TokenChar where arbitrary = arbitraryTokenChar
921makeArbitrary ''Ngram
922instance Arbitrary Ngram where arbitrary = arbitraryNgram
923makeArbitrary ''TokenizerDefinition
924instance Arbitrary TokenizerDefinition where arbitrary = arbitraryTokenizerDefinition
925makeArbitrary ''AnalyzerDefinition
926instance Arbitrary AnalyzerDefinition where arbitrary = arbitraryAnalyzerDefinition
927makeArbitrary ''Analysis
928instance Arbitrary Analysis where arbitrary = arbitraryAnalysis
929makeArbitrary ''Tokenizer
930instance Arbitrary Tokenizer where arbitrary = arbitraryTokenizer
931makeArbitrary ''UpdatableIndexSetting
932instance Arbitrary UpdatableIndexSetting where
933 arbitrary = arbitraryUpdatableIndexSetting
934makeArbitrary ''Compression
935instance Arbitrary Compression where arbitrary = arbitraryCompression
936makeArbitrary ''Bytes
937instance Arbitrary Bytes where arbitrary = arbitraryBytes
938makeArbitrary ''AllocationPolicy
939instance Arbitrary AllocationPolicy where arbitrary = arbitraryAllocationPolicy
940makeArbitrary ''InitialShardCount
941instance Arbitrary InitialShardCount where arbitrary = arbitraryInitialShardCount
942makeArbitrary ''FSType
943instance Arbitrary FSType where arbitrary = arbitraryFSType
944makeArbitrary ''CompoundFormat
945instance Arbitrary CompoundFormat where arbitrary = arbitraryCompoundFormat
946makeArbitrary ''FsSnapshotRepo
947instance Arbitrary FsSnapshotRepo where arbitrary = arbitraryFsSnapshotRepo
948makeArbitrary ''SnapshotRepoName
949instance Arbitrary SnapshotRepoName where arbitrary = arbitrarySnapshotRepoName
950makeArbitrary ''TemplateQueryInline
951instance Arbitrary TemplateQueryInline where arbitrary = arbitraryTemplateQueryInline
952makeArbitrary ''PhraseSuggesterCollate
953instance Arbitrary PhraseSuggesterCollate where arbitrary = arbitraryPhraseSuggesterCollate
954makeArbitrary ''PhraseSuggesterHighlighter
955instance Arbitrary PhraseSuggesterHighlighter where arbitrary = arbitraryPhraseSuggesterHighlighter
956makeArbitrary ''Size
957instance Arbitrary Size where arbitrary = arbitrarySize
958makeArbitrary ''PhraseSuggester
959instance Arbitrary PhraseSuggester where arbitrary = arbitraryPhraseSuggester
960makeArbitrary ''SuggestType
961instance Arbitrary SuggestType where arbitrary = arbitrarySuggestType
962makeArbitrary ''Suggest
963instance Arbitrary Suggest where arbitrary = arbitrarySuggest
965makeArbitrary ''FunctionScoreQuery
966instance Arbitrary FunctionScoreQuery where arbitrary = arbitraryFunctionScoreQuery
968makeArbitrary ''FunctionScoreFunction
969instance Arbitrary FunctionScoreFunction where arbitrary = arbitraryFunctionScoreFunction
970makeArbitrary ''FunctionScoreFunctions
971instance Arbitrary FunctionScoreFunctions where arbitrary = arbitraryFunctionScoreFunctions
972makeArbitrary ''ComponentFunctionScoreFunction
973instance Arbitrary ComponentFunctionScoreFunction where arbitrary = arbitraryComponentFunctionScoreFunction
974makeArbitrary ''Script
975instance Arbitrary Script where arbitrary = arbitraryScript
976makeArbitrary ''ScriptLanguage
977instance Arbitrary ScriptLanguage where arbitrary = arbitraryScriptLanguage
978makeArbitrary ''ScriptInline
979instance Arbitrary ScriptInline where arbitrary = arbitraryScriptInline
980makeArbitrary ''ScriptId
981instance Arbitrary ScriptId where arbitrary = arbitraryScriptId
982makeArbitrary ''ScoreMode
983instance Arbitrary ScoreMode where arbitrary = arbitraryScoreMode
984makeArbitrary ''BoostMode
985instance Arbitrary BoostMode where arbitrary = arbitraryBoostMode
986makeArbitrary ''Seed
987instance Arbitrary Seed where arbitrary = arbitrarySeed
988makeArbitrary ''FieldValueFactor
989instance Arbitrary FieldValueFactor where arbitrary = arbitraryFieldValueFactor
990makeArbitrary ''Weight
991instance Arbitrary Weight where arbitrary = arbitraryWeight
992makeArbitrary ''Factor
993instance Arbitrary Factor where arbitrary = arbitraryFactor
994makeArbitrary ''FactorMissingFieldValue
995instance Arbitrary FactorMissingFieldValue where arbitrary = arbitraryFactorMissingFieldValue
996makeArbitrary ''FactorModifier
997instance Arbitrary FactorModifier where arbitrary = arbitraryFactorModifier
999newtype UpdatableIndexSetting' =
1000 UpdatableIndexSetting' UpdatableIndexSetting
1001 deriving (Show, Eq, ToJSON, FromJSON, ApproxEq, Typeable)
1003instance Arbitrary UpdatableIndexSetting' where
1004 arbitrary = do
1005 settings <- arbitrary
1006 return $ UpdatableIndexSetting' $ case settings of
1007 RoutingAllocationInclude xs ->
1008 RoutingAllocationInclude (dropDuplicateAttrNames xs)
1009 RoutingAllocationExclude xs ->
1010 RoutingAllocationExclude (dropDuplicateAttrNames xs)
1011 RoutingAllocationRequire xs ->
1012 RoutingAllocationRequire (dropDuplicateAttrNames xs)
1013 x -> x
1014 where
1015 dropDuplicateAttrNames =
1016 NE.fromList . L.nubBy sameAttrName . NE.toList
1017 sameAttrName a b =
1018 nodeAttrFilterName a == nodeAttrFilterName b
1020-- | Due to the way nodeattrfilters get serialized here, they may come
1021-- out in a different order, but they are morally equivalent
1022instance ApproxEq UpdatableIndexSetting where
1023 RoutingAllocationInclude a =~ RoutingAllocationInclude b =
1024 NE.sort a =~ NE.sort b
1025 RoutingAllocationExclude a =~ RoutingAllocationExclude b =
1026 NE.sort a =~ NE.sort b
1027 RoutingAllocationRequire a =~ RoutingAllocationRequire b =
1028 NE.sort a =~ NE.sort b
1029 a =~ b = a == b
1030 showApproxEq (RoutingAllocationInclude xs) = show (RoutingAllocationInclude (NE.sort xs))
1031 showApproxEq (RoutingAllocationExclude xs) = show (RoutingAllocationExclude (NE.sort xs))
1032 showApproxEq (RoutingAllocationRequire xs) = show (RoutingAllocationRequire (NE.sort xs))
1033 showApproxEq x = show x
1035main :: IO ()
1036main = hspec $ do
1038 describe "index create/delete API" $ do
1039 it "creates and then deletes the requested index" $ withTestEnv $ do
1040 -- priming state.
1041 _ <- deleteExampleIndex
1042 resp <- createExampleIndex
1043 deleteResp <- deleteExampleIndex
1044 liftIO $ do
1045 validateStatus resp 200
1046 validateStatus deleteResp 200
1048 describe "error parsing" $ do
1049 it "can parse EsErrors for < 2.0" $ when' (atmost es16) $ withTestEnv $ do
1050 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
1051 let errorResp = eitherDecode (responseBody res)
1052 liftIO (errorResp `shouldBe` Right (EsError 404 "IndexMissingException[[bogus] missing]"))
1054 it "can parse EsErrors for >= 2.0" $ when' (atleast es20) $ withTestEnv $ do
1055 res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
1056 let errorResp = eitherDecode (responseBody res)
1057 liftIO (errorResp `shouldBe` Right (EsError 404 "no such index"))
1059 describe "document API" $ do
1060 it "indexes, updates, gets, and then deletes the generated document" $ withTestEnv $ do
1061 _ <- insertData
1062 _ <- updateData
1063 docInserted <- getDocument testIndex testMapping (DocId "1")
1064 let newTweet = eitherDecode
1065 (responseBody docInserted) :: Either String (EsResult Tweet)
1066 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just patchedTweet))
1068 it "indexes, gets, and then deletes the generated document with a DocId containing a space" $ withTestEnv $ do
1069 _ <- insertWithSpaceInId
1070 docInserted <- getDocument testIndex testMapping (DocId "Hello World")
1071 let newTweet = eitherDecode
1072 (responseBody docInserted) :: Either String (EsResult Tweet)
1073 liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))
1075 it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do
1076 doc <- getDocument testIndex testMapping (DocId "bogus")
1077 let noTweet = eitherDecode
1078 (responseBody doc) :: Either String (EsResult Tweet)
1079 liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing
1081 it "can use optimistic concurrency control" $ withTestEnv $ do
1082 let ev = ExternalDocVersion minBound
1083 let cfg = defaultIndexDocumentSettings { idsVersionControl = ExternalGT ev }
1084 resetIndex
1085 res <- insertData' cfg
1086 liftIO $ isCreated res `shouldBe` True
1087 res' <- insertData' cfg
1088 liftIO $ isVersionConflict res' `shouldBe` True
1090 it "indexes two documents in a parent/child relationship and checks that the child exists" $ withTestEnv $ do
1091 resetIndex
1092 _ <- putMapping testIndex (MappingName "child") ChildMapping
1093 _ <- putMapping testIndex (MappingName "parent") ParentMapping
1094 _ <- indexDocument testIndex (MappingName "parent") defaultIndexDocumentSettings exampleTweet (DocId "1")
1095 let parent = (Just . DocumentParent . DocId) "1"
1096 ids = IndexDocumentSettings NoVersionControl parent
1097 _ <- indexDocument testIndex (MappingName "child") ids otherTweet (DocId "2")
1098 _ <- refreshIndex testIndex
1099 exists <- documentExists testIndex (MappingName "child") parent (DocId "2")
1100 liftIO $ exists `shouldBe` True
1102 describe "template API" $ do
1103 it "can create a template" $ withTestEnv $ do
1104 let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
1105 resp <- putTemplate idxTpl (TemplateName "tweet-tpl")
1106 liftIO $ validateStatus resp 200
1108 it "can detect if a template exists" $ withTestEnv $ do
1109 exists <- templateExists (TemplateName "tweet-tpl")
1110 liftIO $ exists `shouldBe` True
1112 it "can delete a template" $ withTestEnv $ do
1113 resp <- deleteTemplate (TemplateName "tweet-tpl")
1114 liftIO $ validateStatus resp 200
1116 it "can detect if a template doesn't exist" $ withTestEnv $ do
1117 exists <- templateExists (TemplateName "tweet-tpl")
1118 liftIO $ exists `shouldBe` False
1120 describe "bulk API" $ do
1121 it "inserts all documents we request" $ withTestEnv $ do
1122 _ <- insertData
1123 let firstTest = BulkTest "blah"
1124 let secondTest = BulkTest "bloo"
1125 let thirdTest = BulkTest "graffle"
1126 let firstDoc = BulkIndex testIndex
1127 testMapping (DocId "2") (toJSON firstTest)
1128 let secondDoc = BulkCreate testIndex
1129 testMapping (DocId "3") (toJSON secondTest)
1130 let thirdDoc = BulkCreateEncoding testIndex
1131 testMapping (DocId "4") (toEncoding thirdTest)
1132 let stream = V.fromList [firstDoc, secondDoc, thirdDoc]
1133 bulkResp <- bulk stream
1134 liftIO $ pPrint bulkResp
1135 refreshResp <- refreshIndex testIndex
1136 liftIO $ pPrint refreshResp
1137 fDoc <- getDocument testIndex testMapping (DocId "2")
1138 sDoc <- getDocument testIndex testMapping (DocId "3")
1139 tDoc <- getDocument testIndex testMapping (DocId "4")
1140 let maybeFirst =
1141 eitherDecode
1142 $ responseBody fDoc
1143 :: Either String (EsResult BulkTest)
1144 let maybeSecond =
1145 eitherDecode
1146 $ responseBody sDoc
1147 :: Either String (EsResult BulkTest)
1148 let maybeThird =
1149 eitherDecode
1150 $ responseBody tDoc
1151 :: Either String (EsResult BulkTest)
1152 liftIO $ pPrint [maybeFirst, maybeSecond, maybeThird]
1153 liftIO $ do
1154 fmap getSource maybeFirst `shouldBe` Right (Just firstTest)
1155 fmap getSource maybeSecond `shouldBe` Right (Just secondTest)
1156 fmap getSource maybeThird `shouldBe` Right (Just thirdTest)
1159 describe "query API" $ do
1160 it "returns document for term query and identity filter" $ withTestEnv $ do
1161 _ <- insertData
1162 let query = TermQuery (Term "user" "bitemyapp") Nothing
1163 let filter = Filter $ MatchAllQuery Nothing
1164 let search = mkSearch (Just query) (Just filter)
1165 myTweet <- searchTweet search
1166 liftIO $
1167 myTweet `shouldBe` Right exampleTweet
1169 it "handles constant score queries" $ withTestEnv $ do
1170 _ <- insertData
1171 let query = TermsQuery "user" ("bitemyapp" :| [])
1172 let cfQuery = ConstantScoreQuery query (Boost 1.0)
1173 let filter = Filter $ MatchAllQuery Nothing
1174 let search = mkSearch (Just cfQuery) (Just filter)
1175 myTweet <- searchTweet search
1176 liftIO $
1177 myTweet `shouldBe` Right exampleTweet
1179 it "returns document for terms query and identity filter" $ withTestEnv $ do
1180 _ <- insertData
1181 let query = TermsQuery "user" ("bitemyapp" :| [])
1182 let filter = Filter $ MatchAllQuery Nothing
1183 let search = mkSearch (Just query) (Just filter)
1184 myTweet <- searchTweet search
1185 liftIO $
1186 myTweet `shouldBe` Right exampleTweet
1188 it "returns document for match query" $ withTestEnv $ do
1189 _ <- insertData
1190 let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1191 let search = mkSearch (Just query) Nothing
1192 myTweet <- searchTweet search
1193 liftIO $
1194 myTweet `shouldBe` Right exampleTweet
1196 it "returns document for multi-match query" $ withTestEnv $ do
1197 _ <- insertData
1198 let flds = [FieldName "user", FieldName "message"]
1199 let query = QueryMultiMatchQuery $ mkMultiMatchQuery flds (QueryString "bitemyapp")
1200 let search = mkSearch (Just query) Nothing
1201 myTweet <- searchTweet search
1202 liftIO $
1203 myTweet `shouldBe` Right exampleTweet
1205 it "returns document for multi-match query with a custom tiebreaker" $ withTestEnv $ do
1206 _ <- insertData
1207 let tiebreaker = Just $ Tiebreaker 0.3
1208 flds = [FieldName "user", FieldName "message"]
1209 multiQuery' = mkMultiMatchQuery flds (QueryString "bitemyapp")
1210 query = QueryMultiMatchQuery $ multiQuery' { multiMatchQueryTiebreaker = tiebreaker }
1211 search = mkSearch (Just query) Nothing
1212 myTweet <- searchTweet search
1213 liftIO $
1214 myTweet `shouldBe` Right exampleTweet
1216 it "returns document for bool query" $ withTestEnv $ do
1217 _ <- insertData
1218 let innerQuery = QueryMatchQuery $
1219 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1220 let query = QueryBoolQuery $
1221 mkBoolQuery [innerQuery] [] [] []
1222 let search = mkSearch (Just query) Nothing
1223 myTweet <- searchTweet search
1224 liftIO $
1225 myTweet `shouldBe` Right exampleTweet
1227 it "returns document for boosting query" $ withTestEnv $ do
1228 _ <- insertData
1229 let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1230 let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
1231 let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
1232 let search = mkSearch (Just query) Nothing
1233 myTweet <- searchTweet search
1234 liftIO $
1235 myTweet `shouldBe` Right exampleTweet
1237 it "returns document for common terms query" $ withTestEnv $ do
1238 _ <- insertData
1239 let query = QueryCommonTermsQuery $
1240 CommonTermsQuery (FieldName "user")
1241 (QueryString "bitemyapp")
1242 (CutoffFrequency 0.0001)
1243 Or Or Nothing Nothing Nothing Nothing
1244 let search = mkSearch (Just query) Nothing
1245 myTweet <- searchTweet search
1246 liftIO $
1247 myTweet `shouldBe` Right exampleTweet
1249 it "returns document for for inline template query" $ withTestEnv $ do
1250 _ <- insertData
1251 let innerQuery = QueryMatchQuery $
1252 mkMatchQuery (FieldName "{{userKey}}")
1253 (QueryString "{{bitemyappKey}}")
1254 templateParams = TemplateQueryKeyValuePairs $ HM.fromList
1255 [ ("userKey", "user")
1256 , ("bitemyappKey", "bitemyapp")
1258 templateQuery = QueryTemplateQueryInline $
1259 TemplateQueryInline innerQuery templateParams
1260 search = mkSearch (Just templateQuery) Nothing
1261 myTweet <- searchTweet search
1262 liftIO $ myTweet `shouldBe` Right exampleTweet
1265 describe "sorting" $ do
1266 it "returns documents in the right order" $ withTestEnv $ do
1267 _ <- insertData
1268 _ <- insertOther
1269 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
1270 let search = Search Nothing
1271 Nothing (Just [sortSpec]) Nothing Nothing
1272 False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
1273 Nothing Nothing
1274 result <- searchTweets search
1275 let myTweet = grabFirst result
1276 liftIO $
1277 myTweet `shouldBe` Right otherTweet
1279 describe "Aggregation API" $ do
1280 it "returns term aggregation results" $ withTestEnv $ do
1281 _ <- insertData
1282 let terms = TermsAgg $ mkTermsAggregation "user"
1283 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1284 searchExpectAggs search
1285 searchValidBucketAgg search "users" toTerms
1287 it "return sub-aggregation results" $ withTestEnv $ do
1288 _ <- insertData
1289 let subaggs = mkAggregations "age_agg" . TermsAgg $ mkTermsAggregation "age"
1290 agg = TermsAgg $ (mkTermsAggregation "user") { termAggs = Just subaggs}
1291 search = mkAggregateSearch Nothing $ mkAggregations "users" agg
1292 reply <- searchByIndex testIndex search
1293 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
1294 usersAggResults = result >>= aggregations >>= toTerms "users"
1295 subAggResults = usersAggResults >>= (listToMaybe . buckets) >>= termsAggs >>= toTerms "age_agg"
1296 subAddResultsExists = isJust subAggResults
1297 liftIO $ (subAddResultsExists) `shouldBe` True
1299 it "returns cardinality aggregation results" $ withTestEnv $ do
1300 _ <- insertData
1301 let cardinality = CardinalityAgg $ mkCardinalityAggregation $ FieldName "user"
1302 let search = mkAggregateSearch Nothing $ mkAggregations "users" cardinality
1303 let search' = search { Database.V5.Bloodhound.from = From 0, size = Size 0 }
1304 searchExpectAggs search'
1305 let docCountPair k n = (k, object ["value" .= Number n])
1306 res <- searchTweets search'
1307 liftIO $
1308 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "users" 1]))
1310 it "returns stats aggregation results" $ withTestEnv $ do
1311 _ <- insertData
1312 let stats = StatsAgg $ mkStatsAggregation $ FieldName "age"
1313 let search = mkAggregateSearch Nothing $ mkAggregations "users" stats
1314 let search' = search { Database.V5.Bloodhound.from = From 0, size = Size 0 }
1315 searchExpectAggs search'
1316 let statsAggRes k n = (k, object [ "max" .= Number n
1317 , "avg" .= Number n
1318 , "count" .= Number 1
1319 , "min" .= Number n
1320 , "sum" .= Number n])
1321 res <- searchTweets search'
1322 liftIO $
1323 fmap aggregations res `shouldBe` Right (Just (M.fromList [ statsAggRes "users" 10000]))
1325 it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
1326 _ <- insertData
1327 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
1328 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1329 searchExpectAggs search
1330 searchValidBucketAgg search "users" toTerms
1332 -- One of these fails with 1.7.3
1333 it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
1334 _ <- insertData
1335 searchTermsAggHint [Map, Ordinals]
1337 it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do
1338 _ <- insertData
1339 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
1341 it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
1342 _ <- insertData
1343 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
1344 -- One of the above.
1346 it "can execute value_count aggregations" $ withTestEnv $ do
1347 _ <- insertData
1348 _ <- insertOther
1349 let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>
1350 mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))
1351 let search = mkAggregateSearch Nothing ags
1352 let docCountPair k n = (k, object ["value" .= Number n])
1353 res <- searchTweets search
1354 liftIO $
1355 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2
1356 , docCountPair "bogus_count" 0
1357 ]))
1359 it "can execute date_range aggregations" $ withTestEnv $ do
1360 let now = fromGregorian 2015 3 14
1361 let ltAMonthAgo = UTCTime (fromGregorian 2015 3 1) 0
1362 let ltAWeekAgo = UTCTime (fromGregorian 2015 3 10) 0
1363 let oldDoc = exampleTweet { postDate = ltAMonthAgo }
1364 let newDoc = exampleTweet { postDate = ltAWeekAgo }
1365 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings oldDoc (DocId "1")
1366 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings newDoc (DocId "2")
1367 _ <- refreshIndex testIndex
1368 let thisMonth = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMMonth])
1369 let thisWeek = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMWeek])
1370 let agg = DateRangeAggregation (FieldName "postDate") Nothing (thisMonth :| [thisWeek])
1371 let ags = mkAggregations "date_ranges" (DateRangeAgg agg)
1372 let search = mkAggregateSearch Nothing ags
1373 res <- searchTweets search
1374 liftIO $ hitsTotal . searchHits <$> res `shouldBe` Right 2
1375 let bucks = do magrs <- fmapL show (aggregations <$> res)
1376 agrs <- note "no aggregations returned" magrs
1377 rawBucks <- note "no date_ranges aggregation" $ M.lookup "date_ranges" agrs
1378 parseEither parseJSON rawBucks
1379 let fromMonthT = UTCTime (fromGregorian 2015 2 14) 0
1380 let fromWeekT = UTCTime (fromGregorian 2015 3 7) 0
1381 liftIO $ buckets <$> bucks `shouldBe` Right [ DateRangeResult "2015-02-14T00:00:00.000Z-*"
1382 (Just fromMonthT)
1383 (Just "2015-02-14T00:00:00.000Z")
1384 Nothing
1385 Nothing
1387 Nothing
1388 , DateRangeResult "2015-03-07T00:00:00.000Z-*"
1389 (Just fromWeekT)
1390 (Just "2015-03-07T00:00:00.000Z")
1391 Nothing
1392 Nothing
1394 Nothing
1397 it "returns date histogram aggregation results" $ withTestEnv $ do
1398 _ <- insertData
1399 let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
1400 let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
1401 searchExpectAggs search
1402 searchValidBucketAgg search "byDate" toDateHistogram
1404 it "can execute missing aggregations" $ withTestEnv $ do
1405 _ <- insertData
1406 _ <- insertExtra
1407 let ags = mkAggregations "missing_agg" (MissingAgg (MissingAggregation "extra"))
1408 let search = mkAggregateSearch Nothing ags
1409 let docCountPair k n = (k, object ["doc_count" .= Number n])
1410 res <- searchTweets search
1411 liftIO $
1412 fmap aggregations res `shouldBe` Right (Just (M.fromList [docCountPair "missing_agg" 1]))
1414 describe "Highlights API" $ do
1416 it "returns highlight from query when there should be one" $ withTestEnv $ do
1417 _ <- insertData
1418 _ <- insertOther
1419 let query = QueryMatchQuery $ mkMatchQuery (FieldName "message") (QueryString "haskell")
1420 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
1422 let search = mkHighlightSearch (Just query) testHighlight
1423 myHighlight <- searchTweetHighlight search
1424 liftIO $
1425 myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
1427 it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
1428 _ <- insertData
1429 _ <- insertOther
1430 let query = QueryMatchQuery $ mkMatchQuery (FieldName "message") (QueryString "haskell")
1431 let testHighlight = Highlights Nothing [FieldHighlight (FieldName "user") Nothing]
1433 let search = mkHighlightSearch (Just query) testHighlight
1434 myHighlight <- searchTweetHighlight search
1435 liftIO $
1436 myHighlight `shouldBe` Right Nothing
1438 describe "Source filtering" $ do
1440 it "doesn't include source when sources are disabled" $ withTestEnv $ do
1441 searchExpectSource
1442 NoSource
1443 (Left (EsError 500 "Source was missing"))
1445 it "includes a source" $ withTestEnv $ do
1446 searchExpectSource
1447 (SourcePatterns (PopPattern (Pattern "message")))
1448 (Right (Object (HM.fromList [("message", String "Use haskell!")])))
1450 it "includes sources" $ withTestEnv $ do
1451 searchExpectSource
1452 (SourcePatterns (PopPatterns [Pattern "user", Pattern "message"]))
1453 (Right (Object (HM.fromList [("user",String "bitemyapp"),("message", String "Use haskell!")])))
1455 it "includes source patterns" $ withTestEnv $ do
1456 searchExpectSource
1457 (SourcePatterns (PopPattern (Pattern "*ge")))
1458 (Right (Object (HM.fromList [("age", Number 10000),("message", String "Use haskell!")])))
1460 it "excludes source patterns" $ withTestEnv $ do
1461 searchExpectSource
1462 (SourceIncludeExclude (Include [])
1463 (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate", Pattern "extra"]))
1464 (Right (Object (HM.fromList [("user",String "bitemyapp")])))
1466 describe "ToJSON RegexpFlags" $ do
1467 it "generates the correct JSON for AllRegexpFlags" $
1468 toJSON AllRegexpFlags `shouldBe` String "ALL"
1470 it "generates the correct JSON for NoRegexpFlags" $
1471 toJSON NoRegexpFlags `shouldBe` String "NONE"
1473 it "generates the correct JSON for SomeRegexpFlags" $
1474 let flags = AnyString :| [ Automaton
1475 , Complement
1476 , Empty
1477 , Intersection
1478 , Interval ]
1479 in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
1481 prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
1482 let String str = toJSON flags
1483 flagStrs = T.splitOn "|" str
1484 in noDuplicates flagStrs
1486 describe "omitNulls" $ do
1487 it "checks that omitNulls drops list elements when it should" $
1488 let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))
1489 , "test2" .= (toJSON ("some value" :: Text))]
1490 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1492 it "checks that omitNulls doesn't drop list elements when it shouldn't" $
1493 let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))
1494 , "test2" .= (toJSON ("some value" :: Text))]
1495 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))
1496 , ("test2", String "some value")])
1497 it "checks that omitNulls drops non list elements when it should" $
1498 let dropped = omitNulls $ [ "test1" .= (toJSON Null)
1499 , "test2" .= (toJSON ("some value" :: Text))]
1500 in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1501 it "checks that omitNulls doesn't drop non list elements when it shouldn't" $
1502 let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
1503 , "test2" .= (toJSON ("some value" :: Text))]
1504 in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
1505 , ("test2", String "some value")])
1506 describe "Monoid (SearchHits a)" $ do
1507 prop "abides the monoid laws" $ eq $
1508 prop_Monoid (T :: T (SearchHits ()))
1510 describe "mkDocVersion" $ do
1511 prop "can never construct an out of range docVersion" $ \i ->
1512 let res = mkDocVersion i
1513 in case res of
1514 Nothing -> property True
1515 Just dv -> (dv >= minBound) .&&.
1516 (dv <= maxBound) .&&.
1517 docVersionNumber dv === i
1519 describe "FsSnapshotRepo" $ do
1520 prop "SnapshotRepo laws" $ \fsr ->
1521 fromGSnapshotRepo (toGSnapshotRepo fsr) === Right (fsr :: FsSnapshotRepo)
1523 describe "snapshot repos" $ do
1524 it "always parses all snapshot repos API" $ when' canSnapshot $ withTestEnv $ do
1525 res <- getSnapshotRepos AllSnapshotRepos
1526 liftIO $ case res of
1527 Left e -> expectationFailure ("Expected a right but got Left " <> show e)
1528 Right _ -> return ()
1530 it "finds an existing list of repos" $ when' canSnapshot $ withTestEnv $ do
1531 let r1n = SnapshotRepoName "bloodhound-repo1"
1532 let r2n = SnapshotRepoName "bloodhound-repo2"
1533 withSnapshotRepo r1n $ \r1 ->
1534 withSnapshotRepo r2n $ \r2 -> do
1535 repos <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| [ExactRepo r2n]))
1536 liftIO $ case repos of
1537 Right xs -> do
1538 let srt = L.sortBy (comparing gSnapshotRepoName)
1539 srt xs `shouldBe` srt [r1, r2]
1540 Left e -> expectationFailure (show e)
1542 it "creates and updates with updateSnapshotRepo" $ when' canSnapshot $ withTestEnv $ do
1543 let r1n = SnapshotRepoName "bloodhound-repo1"
1544 withSnapshotRepo r1n $ \r1 -> do
1545 let Just (String dir) = HM.lookup "location" (gSnapshotRepoSettingsObject (gSnapshotRepoSettings r1))
1546 let noCompression = FsSnapshotRepo r1n (T.unpack dir) False Nothing Nothing Nothing
1547 resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings noCompression
1548 liftIO (validateStatus resp 200)
1549 Right [roundtrippedNoCompression] <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| []))
1550 liftIO (roundtrippedNoCompression `shouldBe` toGSnapshotRepo noCompression)
1552 -- verify came around in 1.4 it seems
1553 it "can verify existing repos" $ when' canSnapshot $ when' (atleast es14) $ withTestEnv $ do
1554 let r1n = SnapshotRepoName "bloodhound-repo1"
1555 withSnapshotRepo r1n $ \_ -> do
1556 res <- verifySnapshotRepo r1n
1557 liftIO $ case res of
1558 Right (SnapshotVerification vs)
1559 | null vs -> expectationFailure "Expected nonempty set of verifying nodes"
1560 | otherwise -> return ()
1561 Left e -> expectationFailure (show e)
1563 describe "snapshots" $ do
1564 it "always parses all snapshots API" $ when' canSnapshot $ withTestEnv $ do
1565 let r1n = SnapshotRepoName "bloodhound-repo1"
1566 withSnapshotRepo r1n $ \_ -> do
1567 res <- getSnapshots r1n AllSnapshots
1568 liftIO $ case res of
1569 Left e -> expectationFailure ("Expected a right but got Left " <> show e)
1570 Right _ -> return ()
1572 it "can parse a snapshot that it created" $ when' canSnapshot $ withTestEnv $ do
1573 let r1n = SnapshotRepoName "bloodhound-repo1"
1574 withSnapshotRepo r1n $ \_ -> do
1575 let s1n = SnapshotName "example-snapshot"
1576 withSnapshot r1n s1n $ do
1577 res <- getSnapshots r1n (SnapshotList (ExactSnap s1n :| []))
1578 liftIO $ case res of
1579 Right [snap]
1580 | snapInfoState snap == SnapshotSuccess &&
1581 snapInfoName snap == s1n -> return ()
1582 | otherwise -> expectationFailure (show snap)
1583 Right [] -> expectationFailure "There were no snapshots"
1584 Right snaps -> expectationFailure ("Expected 1 snapshot but got" <> show (length snaps))
1585 Left e -> expectationFailure (show e)
1587 describe "snapshot restore" $ do
1588 it "can restore a snapshot that we create" $ when' canSnapshot $ withTestEnv $ do
1589 let r1n = SnapshotRepoName "bloodhound-repo1"
1590 withSnapshotRepo r1n $ \_ -> do
1591 let s1n = SnapshotName "example-snapshot"
1592 withSnapshot r1n s1n $ do
1593 let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True }
1594 -- have to close an index to restore it
1595 resp1 <- closeIndex testIndex
1596 liftIO (validateStatus resp1 200)
1597 resp2 <- restoreSnapshot r1n s1n settings
1598 liftIO (validateStatus resp2 200)
1600 it "can restore and rename" $ when' canSnapshot $ withTestEnv $ do
1601 let r1n = SnapshotRepoName "bloodhound-repo1"
1602 withSnapshotRepo r1n $ \_ -> do
1603 let s1n = SnapshotName "example-snapshot"
1604 withSnapshot r1n s1n $ do
1605 let pat = RestoreRenamePattern "bloodhound-tests-twitter-(\\d+)"
1606 let replace = RRTLit "restored-" :| [RRSubWholeMatch]
1607 let expectedIndex = IndexName "restored-bloodhound-tests-twitter-1"
1608 oldEnoughForOverrides <- liftIO (atleast es15)
1609 let overrides = RestoreIndexSettings { restoreOverrideReplicas = Just (ReplicaCount 0) }
1610 let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True
1611 , snapRestoreRenamePattern = Just pat
1612 , snapRestoreRenameReplacement = Just replace
1613 , snapRestoreIndexSettingsOverrides = if oldEnoughForOverrides
1614 then Just overrides
1615 else Nothing
1617 -- have to close an index to restore it
1618 let go = do
1619 resp <- restoreSnapshot r1n s1n settings
1620 liftIO (validateStatus resp 200)
1621 exists <- indexExists expectedIndex
1622 liftIO (exists `shouldBe` True)
1623 go `finally` deleteIndex expectedIndex
1625 describe "getNodesInfo" $ do
1626 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
1627 res <- getNodesInfo LocalNode
1628 liftIO $ case res of
1629 -- This is really just a smoke test for response
1630 -- parsing. Node info is so variable, there's not much I can
1631 -- assert here.
1632 Right NodesInfo {..} -> length nodesInfo `shouldBe` 1
1633 Left e -> expectationFailure ("Expected NodesInfo but got " <> show e)
1635 describe "getNodesStats" $ do
1636 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
1637 res <- getNodesStats LocalNode
1638 liftIO $ case res of
1639 -- This is really just a smoke test for response
1640 -- parsing. Node stats is so variable, there's not much I can
1641 -- assert here.
1642 Right NodesStats {..} -> length nodesStats `shouldBe` 1
1643 Left e -> expectationFailure ("Expected NodesStats but got " <> show e)
1645 describe "Enum DocVersion" $ do
1646 it "follows the laws of Enum, Bounded" $ do
1647 evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall
1648 evaluate (pred minBound :: DocVersion) `shouldThrow` anyErrorCall
1649 evaluate (toEnum 0 :: DocVersion) `shouldThrow` anyErrorCall
1650 evaluate (toEnum 9200000000000000001 :: DocVersion) `shouldThrow` anyErrorCall
1651 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1652 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1653 enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]
1655 describe "scan&scroll API" $ do
1656 it "returns documents using the scan&scroll API" $ withTestEnv $ do
1657 _ <- insertData
1658 _ <- insertOther
1659 let search = (mkSearch (Just $ MatchAllQuery Nothing) Nothing) { size = (Size 1) }
1660 regular_search <- searchTweet search
1661 scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet]
1662 let scan_search = map hitSource scan_search'
1663 liftIO $
1664 regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored
1665 liftIO $
1666 scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]
1668 describe "index aliases" $ do
1669 let aname = IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias")
1670 let alias = IndexAlias (testIndex) aname
1671 let create = IndexAliasCreate Nothing Nothing
1672 let action = AddAlias alias create
1673 it "handles the simple case of aliasing an existing index" $ do
1674 withTestEnv $ do
1675 resetIndex
1676 resp <- updateIndexAliases (action :| [])
1677 liftIO $ validateStatus resp 200
1678 let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1679 (do aliases <- withTestEnv getIndexAliases
1680 let expected = IndexAliasSummary alias create
1681 case aliases of
1682 Right (IndexAliasesSummary summs) ->
1683 L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1684 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1685 it "allows alias deletion" $ do
1686 aliases <- withTestEnv $ do
1687 resetIndex
1688 resp <- updateIndexAliases (action :| [])
1689 liftIO $ validateStatus resp 200
1690 _ <- deleteIndexAlias aname
1691 getIndexAliases
1692 -- let expected = IndexAliasSummary alias create
1693 case aliases of
1694 Right (IndexAliasesSummary summs) ->
1695 L.find ( (== aname)
1696 . indexAlias
1697 . indexAliasSummaryAlias
1698 ) summs
1699 `shouldBe` Nothing
1700 Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)
1702 describe "Index Listing" $ do
1703 it "returns a list of index names" $ withTestEnv $ do
1704 _ <- createExampleIndex
1705 ixns <- listIndices
1706 liftIO (ixns `shouldContain` [testIndex])
1708 describe "Index Settings" $ do
1709 it "persists settings" $ withTestEnv $ do
1710 _ <- deleteExampleIndex
1711 _ <- createExampleIndex
1712 let updates = BlocksWrite False :| []
1713 updateResp <- updateIndexSettings updates testIndex
1714 liftIO $ validateStatus updateResp 200
1715 getResp <- getIndexSettings testIndex
1716 liftIO $
1717 getResp `shouldBe` Right (IndexSettingsSummary
1718 testIndex
1719 (IndexSettings (ShardCount 1) (ReplicaCount 0))
1720 (NE.toList updates))
1722 it "allows total fields to be set" $ when' (atleast es50) $ withTestEnv $ do
1723 _ <- deleteExampleIndex
1724 _ <- createExampleIndex
1725 let updates = MappingTotalFieldsLimit 2500 :| []
1726 updateResp <- updateIndexSettings updates testIndex
1727 liftIO $ validateStatus updateResp 200
1728 getResp <- getIndexSettings testIndex
1729 liftIO $
1730 getResp `shouldBe` Right (IndexSettingsSummary
1731 testIndex
1732 (IndexSettings (ShardCount 1) (ReplicaCount 0))
1733 (NE.toList updates))
1735 it "accepts customer analyzers" $ when' (atleast es50) $ withTestEnv $ do
1736 _ <- deleteExampleIndex
1737 let analysis = Analysis
1738 (M.singleton "ex_analyzer" (AnalyzerDefinition (Just (Tokenizer "ex_tokenizer"))))
1739 (M.singleton "ex_tokenizer"
1740 ( TokenizerDefinitionNgram
1741 ( Ngram 3 4 [TokenLetter,TokenDigit])
1744 updates = [AnalysisSetting analysis]
1745 createResp <- createIndexWith (updates ++ [NumberOfReplicas (ReplicaCount 0)]) 1 testIndex
1746 liftIO $ validateStatus createResp 200
1747 getResp <- getIndexSettings testIndex
1748 liftIO $
1749 getResp `shouldBe` Right (IndexSettingsSummary
1750 testIndex
1751 (IndexSettings (ShardCount 1) (ReplicaCount 0))
1752 updates
1755 it "accepts default compression codec" $ when' (atleast es50) $ withTestEnv $ do
1756 _ <- deleteExampleIndex
1757 let updates = [CompressionSetting CompressionDefault]
1758 createResp <- createIndexWith (updates ++ [NumberOfReplicas (ReplicaCount 0)]) 1 testIndex
1759 liftIO $ validateStatus createResp 200
1760 getResp <- getIndexSettings testIndex
1761 liftIO $ getResp `shouldBe` Right
1762 (IndexSettingsSummary testIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) updates)
1764 it "accepts best compression codec" $ when' (atleast es50) $ withTestEnv $ do
1765 _ <- deleteExampleIndex
1766 let updates = [CompressionSetting CompressionBest]
1767 createResp <- createIndexWith (updates ++ [NumberOfReplicas (ReplicaCount 0)]) 1 testIndex
1768 liftIO $ validateStatus createResp 200
1769 getResp <- getIndexSettings testIndex
1770 liftIO $ getResp `shouldBe` Right
1771 (IndexSettingsSummary testIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) updates)
1774 describe "Index Optimization" $ do
1775 it "returns a successful response upon completion" $ withTestEnv $ do
1776 _ <- createExampleIndex
1777 resp <- forceMergeIndex (IndexList (testIndex :| [])) defaultForceMergeIndexSettings
1778 liftIO $ validateStatus resp 200
1780 describe "Suggest" $ do
1781 it "returns a search suggestion using the phrase suggester" $ withTestEnv $ do
1782 _ <- insertData
1783 let query = QueryMatchNoneQuery
1784 phraseSuggester = mkPhraseSuggester (FieldName "message")
1785 namedSuggester = Suggest "Use haskel" "suggest_name" (SuggestTypePhraseSuggester phraseSuggester)
1786 search' = mkSearch (Just query) Nothing
1787 search = search' { suggestBody = Just namedSuggester }
1788 expectedText = Just "use haskell"
1789 resp <- searchByIndex testIndex search
1790 parsed <- parseEsResponse resp :: BH IO (Either EsError (SearchResult Tweet))
1791 case parsed of
1792 Left e -> liftIO $ expectationFailure ("Expected an search suggestion but got " <> show e)
1793 Right sr -> liftIO $ (suggestOptionsText . head . suggestResponseOptions . head . nsrResponses <$> suggest sr) `shouldBe` expectedText
1795 describe "Script" $ do
1796 it "returns a transformed document based on the script field" $ withTestEnv $ do
1797 _ <- insertData
1798 let query = MatchAllQuery Nothing
1799 sfv = toJSON $
1800 Script
1801 (Just (ScriptLanguage "painless"))
1802 (Just (ScriptInline "doc['age'].value * 2"))
1803 Nothing
1804 Nothing
1805 sf = ScriptFields $
1806 HM.fromList [("test1", sfv)]
1807 search' = mkSearch (Just query) Nothing
1808 search = search' { scriptFields = Just sf }
1809 resp <- searchByIndex testIndex search
1810 parsed <- parseEsResponse resp :: BH IO (Either EsError (SearchResult Value))
1811 case parsed of
1812 Left e ->
1813 liftIO $ expectationFailure ("Expected a script-transformed result but got: " <> show e)
1814 Right sr -> do
1815 let Just results =
1816 hitFields (head (hits (searchHits sr)))
1817 liftIO $ results `shouldBe` (HitFields (M.fromList [("test1", [Number 20000.0])]))
1819 describe "Exact isomorphism JSON instances" $ do
1820 propJSON (Proxy :: Proxy Version)
1821 propJSON (Proxy :: Proxy IndexName)
1822 propJSON (Proxy :: Proxy MappingName)
1823 propJSON (Proxy :: Proxy DocId)
1824 propJSON (Proxy :: Proxy IndexAliasRouting)
1825 propJSON (Proxy :: Proxy RoutingValue)
1826 propJSON (Proxy :: Proxy ShardCount)
1827 propJSON (Proxy :: Proxy ReplicaCount)
1828 propJSON (Proxy :: Proxy TemplateName)
1829 propJSON (Proxy :: Proxy TemplatePattern)
1830 propJSON (Proxy :: Proxy QueryString)
1831 propJSON (Proxy :: Proxy FieldName)
1832 propJSON (Proxy :: Proxy Script)
1833 propJSON (Proxy :: Proxy ScriptLanguage)
1834 propJSON (Proxy :: Proxy ScriptInline)
1835 propJSON (Proxy :: Proxy ScriptId)
1836 propJSON (Proxy :: Proxy ScriptParams)
1837 propJSON (Proxy :: Proxy CacheName)
1838 propJSON (Proxy :: Proxy CacheKey)
1839 propJSON (Proxy :: Proxy Existence)
1840 propJSON (Proxy :: Proxy CutoffFrequency)
1841 propJSON (Proxy :: Proxy Analyzer)
1842 propJSON (Proxy :: Proxy MaxExpansions)
1843 propJSON (Proxy :: Proxy Lenient)
1844 propJSON (Proxy :: Proxy Tiebreaker)
1845 propJSON (Proxy :: Proxy Boost)
1846 propJSON (Proxy :: Proxy BoostTerms)
1847 propJSON (Proxy :: Proxy MinimumMatch)
1848 propJSON (Proxy :: Proxy DisableCoord)
1849 propJSON (Proxy :: Proxy IgnoreTermFrequency)
1850 propJSON (Proxy :: Proxy MinimumTermFrequency)
1851 propJSON (Proxy :: Proxy MaxQueryTerms)
1852 propJSON (Proxy :: Proxy Fuzziness)
1853 propJSON (Proxy :: Proxy PrefixLength)
1854 propJSON (Proxy :: Proxy TypeName)
1855 propJSON (Proxy :: Proxy PercentMatch)
1856 propJSON (Proxy :: Proxy StopWord)
1857 propJSON (Proxy :: Proxy QueryPath)
1858 propJSON (Proxy :: Proxy AllowLeadingWildcard)
1859 propJSON (Proxy :: Proxy LowercaseExpanded)
1860 propJSON (Proxy :: Proxy EnablePositionIncrements)
1861 propJSON (Proxy :: Proxy AnalyzeWildcard)
1862 propJSON (Proxy :: Proxy GeneratePhraseQueries)
1863 propJSON (Proxy :: Proxy Locale)
1864 propJSON (Proxy :: Proxy MaxWordLength)
1865 propJSON (Proxy :: Proxy MinWordLength)
1866 propJSON (Proxy :: Proxy PhraseSlop)
1867 propJSON (Proxy :: Proxy MinDocFrequency)
1868 propJSON (Proxy :: Proxy MaxDocFrequency)
1869 propJSON (Proxy :: Proxy Filter)
1870 propJSON (Proxy :: Proxy Query)
1871 propJSON (Proxy :: Proxy SimpleQueryStringQuery)
1872 propJSON (Proxy :: Proxy FieldOrFields)
1873 propJSON (Proxy :: Proxy SimpleQueryFlag)
1874 propJSON (Proxy :: Proxy RegexpQuery)
1875 propJSON (Proxy :: Proxy QueryStringQuery)
1876 propJSON (Proxy :: Proxy RangeQuery)
1877 propJSON (Proxy :: Proxy PrefixQuery)
1878 propJSON (Proxy :: Proxy NestedQuery)
1879 propJSON (Proxy :: Proxy MoreLikeThisFieldQuery)
1880 propJSON (Proxy :: Proxy MoreLikeThisQuery)
1881 propJSON (Proxy :: Proxy IndicesQuery)
1882 propJSON (Proxy :: Proxy HasParentQuery)
1883 propJSON (Proxy :: Proxy HasChildQuery)
1884 propJSON (Proxy :: Proxy FuzzyQuery)
1885 propJSON (Proxy :: Proxy FuzzyLikeFieldQuery)
1886 propJSON (Proxy :: Proxy FuzzyLikeThisQuery)
1887 propJSON (Proxy :: Proxy FunctionScoreQuery)
1888 propJSON (Proxy :: Proxy BoostMode)
1889 propJSON (Proxy :: Proxy ScoreMode)
1890 propJSON (Proxy :: Proxy ComponentFunctionScoreFunction)
1891 propJSON (Proxy :: Proxy FieldValueFactor)
1892 propJSON (Proxy :: Proxy FactorModifier)
1893 propJSON (Proxy :: Proxy DisMaxQuery)
1894 propJSON (Proxy :: Proxy CommonTermsQuery)
1895 propJSON (Proxy :: Proxy CommonMinimumMatch)
1896 propJSON (Proxy :: Proxy BoostingQuery)
1897 propJSON (Proxy :: Proxy BoolQuery)
1898 propJSON (Proxy :: Proxy MatchQuery)
1899 propJSON (Proxy :: Proxy MultiMatchQueryType)
1900 propJSON (Proxy :: Proxy BooleanOperator)
1901 propJSON (Proxy :: Proxy ZeroTermsQuery)
1902 propJSON (Proxy :: Proxy MatchQueryType)
1903 propJSON (Proxy :: Proxy AliasRouting)
1904 propJSON (Proxy :: Proxy IndexAliasCreate)
1905 propJSON (Proxy :: Proxy SearchAliasRouting)
1906 propJSON (Proxy :: Proxy ScoreType)
1907 propJSON (Proxy :: Proxy Distance)
1908 propJSON (Proxy :: Proxy DistanceUnit)
1909 propJSON (Proxy :: Proxy DistanceType)
1910 propJSON (Proxy :: Proxy OptimizeBbox)
1911 propJSON (Proxy :: Proxy GeoBoundingBoxConstraint)
1912 propJSON (Proxy :: Proxy GeoFilterType)
1913 propJSON (Proxy :: Proxy GeoBoundingBox)
1914 propJSON (Proxy :: Proxy LatLon)
1915 propJSON (Proxy :: Proxy RangeExecution)
1916 prop "RegexpFlags FromJSON/ToJSON roundtrips, removing dups " $ \rfs ->
1917 let expected = case rfs of
1918 SomeRegexpFlags fs -> SomeRegexpFlags (NE.fromList (nub (NE.toList fs)))
1919 x -> x
1920 in parseEither parseJSON (toJSON rfs) === Right expected
1921 propJSON (Proxy :: Proxy BoolMatch)
1922 propJSON (Proxy :: Proxy Term)
1923 propJSON (Proxy :: Proxy MultiMatchQuery)
1924 propJSON (Proxy :: Proxy IndexSettings)
1925 propJSON (Proxy :: Proxy CompoundFormat)
1926 propJSON (Proxy :: Proxy TemplateQueryInline)
1927 propJSON (Proxy :: Proxy Suggest)
1928 describe "Approximate isomorphism JSON instances" $ do
1929 propApproxJSON (Proxy :: Proxy UpdatableIndexSetting')
1930 propApproxJSON (Proxy :: Proxy ReplicaCount)
1931 propApproxJSON (Proxy :: Proxy ReplicaBounds)
1932 propApproxJSON (Proxy :: Proxy Bytes)
1933 propApproxJSON (Proxy :: Proxy AllocationPolicy)
1934 propApproxJSON (Proxy :: Proxy InitialShardCount)
1935 propApproxJSON (Proxy :: Proxy FSType)