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